-
Notifications
You must be signed in to change notification settings - Fork 15
/
test2.pl
175 lines (157 loc) · 5.79 KB
/
test2.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
# vim: ft=perl6
use Test;
ok '{}' ~~ / \{ <.ws> \} /, 'ws matches between \W';
{
ok ("a" ~~ /a/), "letter matches itself";
ok !("a" ~~ /b/), "letter does not match other";
ok ("xxa" ~~ /a/), "leading garbage ignored";
ok ("axx" ~~ /a/), "trailing garbage ignored";
ok ("ab" ~~ /ab/), "sequence matches sequence";
ok !("ab" ~~ /ba/), "sequence requires order";
ok ("abc" ~~ /ab?c/), "conditional can match";
ok ("ac" ~~ /ab?c/), "conditional can match nothing";
ok !("adc" ~~ /ab?c/), "conditional cannot match something else";
ok ("ac" ~~ /ab*c/), "kleene closure can match none";
ok ("abbc" ~~ /ab*c/), "kleene closure can match many";
ok !("adc" ~~ /ab*c/), "kleene closure cannot match other";
ok ("abc" ~~ /ab+c/), "plus can match one";
ok ("abbbc" ~~ /ab+c/), "plus can match many";
ok !("adc" ~~ /ab+c/), "plus cannot match other";
ok !("ac" ~~ /ab+c/), "plus cannot match none";
grammar Bob {
regex TOP {ab*c}
}
ok Bob.parse("abbc"), "grammars work (1)";
ok !Bob.parse("adc"), "grammars work (2)";
ok !Bob.parse("xac"), "grammars anchor (1)";
ok !Bob.parse("acx"), "grammars anchor (2)";
}
{
my grammar G1 {
regex TOP { <.foo> }
regex foo { x }
}
ok G1.parse("x"), "subrules work (positive)";
ok !G1.parse("y"), "subrules work (negative)";
my grammar G2 {
regex TOP { y <.foo> <.foo> y }
regex foo { x }
}
ok G2.parse("yxxy"), "subrule position tracking works";
ok !G2.parse("yxy"), "subrule position tracking works (2)";
my grammar G3 {
regex TOP { <moo> }
regex moo { x }
}
ok G3.parse("x"), "capturing subrules work (positive)";
ok !G3.parse("y"), "capturing subrules work (negative)";
}
{
ok ("aab" ~~ /a* ab/), "a*ab backtracks";
ok !("aab" ~~ /a*: ab/), "a*: ab doesn't";
ok ("aab" ~~ /a*! ab/), "a*! ab backtracks";
ok !("aab" ~~ /:r a* ab/), "ratcheting a* ab does not";
ok !("aab" ~~ /:r a*: ab/), "ratcheting a*: ab does not";
ok ("aab" ~~ /:r a*! ab/), "ratcheting a*! ab does";
ok !("aab" ~~ token { a* ab }), "a* ab in a token does not";
ok ("ab ab" ~~ / ab <.ws> ab /), "ws matches a space";
ok (q:to/end/ ~~ / ab <.ws> ab /), "ws matches a newline";
ab
ab
end
ok ("ab ab" ~~ / ab <.ws> ab /), "ws matches several spaces";
ok !("abab" ~~ / ab <.ws> ab /), "ws does not match nothing";
ok ("ab ab" ~~ rule { ab ab }), "rule gives space";
}
{
# # doing a more reasonable test will probably require embedded blocks
# ok "foobarx" ~~ / [ foo | foobar ]: x /, "LTM picks longest even if second";
# ok "foobarx" ~~ / [ foobar | foo ]: x /, "LTM picks longest even if first";
}
{
my $x = '';
ok !("a" ~~ / a { $x = 1; } b /), '{} does not terminate regex';
is $x, 1, '{} is run even if regex fails';
$x = '';
ok !("" ~~ / a { $x = 1; } b /), '{} does not affect regex that ends before it';
is $x, '', '{} is only run if reached';
$x = 0;
ok ("aab" ~~ / a* { $x++ } ab /), '{} does not block backtracking';
is $x, 2, '{} is run multiple times when backtracking';
#
# $x = '';
# ok ("foo" ~~ / foo { $x = $x ~ 1 } | foo { $x = $x ~ 2 } /),
# "foo ~~ foo|foo";
# is $x, 1, "with no other constraints, first item is used";
# $x = '';
# ok ("foo" ~~ / fo* { $x = $x ~ 1 } | foo { $x = $x ~ 2 } /),
# "foo ~~ fo*|foo";
# is $x, 2, "longer literal prefix wins over seniority";
# $x = '';
# ok ("fooo" ~~ / fo* { $x = $x ~ 1 } | foo { $x = $x ~ 2 } /),
# "foo ~~ fo*|foo";
# is $x, 1, "longer length wins over prefix";
# $x = '';
# ok !("fooo" ~~ / [ fo*: { $x = $x ~ 1 } | foo { $x = $x ~ 2 } ] x /),
# "foo !~~ [fo*:|foo]x";
# is $x, '12', "will backtrack into shorter token";
#
# my grammar G5 {
# token a { foo }
# token b { foobar }
# token c { <a> | <b> }
# token d { <c> x }
#
# token e { x <e> x | y }
#
# token TOP { A <d> | E <e> }
# }
#
# ok G5.parse('Afoobarx'), 'LTM works even through subrules';
# ok G5.parse('Exxyxx'), 'recursivity does not crash LTM';
#
# my grammar G6 {
# token a { fo* { $x = 1 } }
# token b { foo { $x = 2 } }
# token TOP { <a> | <b> }
# }
# G6.parse("foo");
# is $x, 2, "prefix length testing works in subrules";
}
# {
# my grammar G7 {
# proto token tok {*}
# token tok:sym<+> { <sym> }
# token tok:foo { <sym> }
#
# rule TOP { <tok> }
# }
#
# ok G7.parse('+'), "can parse :sym<> symbols";
# ok G7.parse('foo'), "can parse : symbols";
# }
#
# {
# ok 'xxy' ~~ /x { $a = $/.pos } /, "can match with \$/ stuff";
# is $a, 1, '$/.pos is the right sort of thing';
# 'xxy' ~~ /x { $a = ($¢ ~~ Cursor) }/;
# is $a, True, '$¢ isa Cursor';
# }
#rxtest /x.y/, "x.y", ("xay", "x y"), ("xy", "xaay");
#rxtest /<!>/, '<!>', Nil, ("", "x");
#rxtest /\s/, '\s', (" ", ("\n" => '\n'), ("\r" => '\r'), "\x3000"),
# ("x", "1", "+");
#rxtest /\S/, '\S', ("x", "1", "+"),
# (" ", ("\n" => '\n'), ("\r" => '\r'), ("\x3000" => 'id space'));
#rxtest /\w/, '\w', ("x", "1", "_", "\x4E00"), ("+", " ");
#rxtest /<[ y ]>/, '<[ y ]>', ("y"), (" ", "x", "z");
#rxtest /<[ i .. k ]>/, '<[ i .. k ]>', ("i", "j", "k"), ("h", "l");
#rxtest /<[ \W a..z ]>/, '<[\W a..z]>', ("a", "z", "+"), ("\x4E00");
rxtest /a || b/, 'a || b', ("a", "b"), ("c", "");
rxtest /x [a || aa]: c/, 'x[a||aa]:c', ("xac",), ("xaac",);
#ok "axy" ~~ / a <before x> \w y / , "before is zero-width";
#ok "axy" ~~ / a <?before x> \w y / , "?before is zero-width";
#ok "azy" ~~ / a <!before x> \w y / , "!before is zero-width";
#ok !("azy" ~~ / a <?before x> \w y /) , "?before x needs x";
#ok !("axy" ~~ / a <!before x> \w y /) , "!before x needs !x";
done-testing;