Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 315 lines (268 sloc) 11.699 kb
ff2f9de @sorear Prototype of the Array class
authored
1 # vim: ft=perl6
2 use Test;
9f1bf0e @sorear Implement &sort
authored
3 use MONKEY_TYPING;
ff2f9de @sorear Prototype of the Array class
authored
4
e7236a4 @sorear Fix ** state funkiness, add tests
authored
5 is (("ab" x 10) ~~ /[aba?] ** 10/).chars, 20, "**COUNT works with backtracking";
6
7 is ("a, d" ~~ /:s <alpha>+ % ','/), 'a, d', 'sigspace respected on %';
8 is ("a b c" ~~ /:s <alpha> ** 3/), 'a b c', 'sigspace respected on **';
9 is ("a, d" ~~ /:s <alpha>+%','/), 'a', 'no-sigspace respected on %';
10 is ("a b c def" ~~ /:s <alpha>**3/), ' def', 'no-sigspace respected on **';
11 is ("a,b,c," ~~ / <alpha>+ %% ','/), 'a,b,c,', '%% works';
12 is ("a,b,c" ~~ / <alpha>+ %% ','/), 'a,b,c', '%% works like %';
13 is ("a,b,c" ~~ / <alpha>* %% ','/), 'a,b,c', '% works on *';
14 is ("XX" ~~ / X <alpha>* %% ',' X/), 'XX', '% works on * (null string)';
45041d2 @sorear Implement $() @() %() special forms, make $/.ast default to undef
authored
15 "foo" ~~ / (<.alpha>) <alpha> /;
16 is $(), "fo", '$() gets the string';
17 ok !$/.ast.defined, '$/.ast not defined without make';
18 is @().join("|"), "f", '@() returns positional captures';
19 is %().kv.join("|"), "alpha|o", '%() returns named captures';
20 "bar" ~~ / { make 5 } /;
21 is $(), 5, '$() gets AST';
e7236a4 @sorear Fix ** state funkiness, add tests
authored
22
95e0703 @sorear Implement @var in regexes, incl. LTM and regex elements
authored
23 {
24 my $rx = /a+/;
25 is ("ooofaaabkkk" ~~ /f $rx b/), "faaab", '$var can call regexes';
26
27 my @a1 = ( 'fo', 'fooo', 'bar' );
28 is ("barxy" ~~ / @a1 /), "bar", '@var works';
29 is ("fooooooo" ~~ / @a1 /), 'fooo', '@var has longest-token semantics';
30
31 my @a2 = ( /fooo/, /fo+/ );
32 is ("fooooooo" ~~ / @a2 /), "fooooooo", '@var has longest-token semantics with regex elements';
c2f6274 @sorear Add <$foo> and <@foo>
authored
33
34 my $rxstr = 'a+';
35 is ("ooofaaabkkk" ~~ /f <$rx> b/), "faaab", '<$var> can call regexes';
36 is ("ooofaaabkkk" ~~ /f <$rxstr> b/), "faaab", '<$var> can compile regexes';
37
38 is ("fooooooo" ~~ / <@a2> /), "fooooooo", '<@var> has longest-token semantics with regex elements';
39
40 my @a3 = ( 'bar?', 'fooo', 'fo+' );
41 is ("barx" ~~ / <@a3> /), "bar", '<@var> works (compiling)';
42 is ("fooooooo" ~~ / <@a3> /), 'fooooooo', '<@var> has longest-token semantics (compiling)';
df250ea @sorear Implement dottyop regex assertions
authored
43
44 is ("foo" ~~ /<."alpha"()>/), "f", "dottyop assertions work";
bca1172 @sorear Implement <foo> calling my regex foo if in scope
authored
45
46 my regex sam { \d+ }
47 is ("fo23op" ~~ /<sam>/), "23", "lexical regexes can be used without &";
48 {
49 sub alpha() { }
50 is ("xyz" ~~ /<alpha>/), "x", "non-regex subs do not confuse";
51 }
52 {
53 my regex alpha { . }
54 is ("4e" ~~ /<.alpha>/), "e", "leading dot forces method interpretation";
55 }
b37bff8 @sorear Implement <&foo(ARGS)> syntax
authored
56
57 my regex two($x) { $x $x }
58 is ("xfoofoox" ~~ /<two("foo")>/), "foofoo", "calling lexical regexes like <two> with args works";
59 is ("xfoofoox" ~~ /<&two("foo")>/), "foofoo", "calling lexical regexes like <&two> with args works";
95e0703 @sorear Implement @var in regexes, incl. LTM and regex elements
authored
60 }
886540f @sorear Implement $var in regexes using Regex objects as subregexes (fixes #77)
authored
61
ca4d6f1 @sorear Implement use of submethod BUILD
authored
62 {
5b61026 @sorear Implement fancy proto regexes with stuff around {*}
authored
63 my proto regex foo { x {*} y }
64 my regex foo:sym<+> { <sym> }
65 my regex foo:sym<-> { <sym> }
66
67 is ("x+y" ~~ /<&foo>/), "x+y", "proto regexes can add stuff before and after";
68 #is ~$<foo><dispatch>, "+", "<dispatch> works"; #NIECZA
69
70 my grammar G {
71 proto token bar { c {*} d }
72 token bar:xyz { eee }
73
74 token TOP { ([<bar> | ceee]) .* }
75 }
76 is G.parse("ceeed")[0], 'ceeed', 'LTM works into dispatch nodes';
77 }
78
79 {
ac66b89 @sorear Implement <( and )>
authored
80 is ("fffoxxx" ~~ / f <( . )> x /), "o", '<( )> works basically';
81 is $/.from, 3, '$/.from set correctly';
82 is $/.to, 4, '$/.to set correctly';
83
84 my $var = 'one $16 two $9 three';
85 $var ~~ s:g[\$ <( \d+ )>] *= 2;
86 is $var, 'one $32 two $18 three', 's:g <( example from S05';
87
88 # because of anchoring behavior, leading context behaves differently
89 is "abcdef".comb(/<(.)>../).join('|'), 'a|b|c|d',
90 '.comb with overlapping context regions';
91 $var = 'abcdef';
92 $var ~~ s:g[<(.)>....] = $/.uc;
93 is $var, 'ABcdef', 's:g with overlapping context';
94
95 is ("foo" ~~ / f <( .. /), "oo", '<( does not need to be paired';
96 is ("foo" ~~ / f )> .. /), "f", ')> does not need to be paired';
97 }
98
99 {
ca4d6f1 @sorear Implement use of submethod BUILD
authored
100 my class Bt {
101 has $!pie;
102 method get_pie() { $!pie }
103 submethod BUILD(:$x) { $!pie = $x }
104 }
105 is Bt.new(x => 5).get_pie, 5, "BUILD basically works";
106 my class SubBT is Bt {
107 has $!pie2;
108 method get_pie2() { $!pie2 }
109 submethod BUILD(:$y) { $!pie2 = $y }
110 }
111 is SubBT.new(x => 5, y => 2).get_pie, 5, "superclass' BUILD in subclass";
112 is SubBT.new(x => 5, y => 2).get_pie2, 2, "subclass' BUILD in subclass";
904bb14 @sorear Fix binding to existing @vars
authored
113
114 my @l;
115 @l := [1,2,3];
116 is +[@l], 3, 'binding to existing list vars works';
ca4d6f1 @sorear Implement use of submethod BUILD
authored
117 }
118
40118ed @sorear Implement correct-style <{ }> assertion
authored
119 {
120 my $rxd = / (\d+) <{ "a ** $0" }> /;
121 is ("3aaa" ~~ $rxd), "3aaa", '<{}> works';
bf48f50 @sorear Respect context correctly on @0 and @<foo>
authored
122
123 "abcd" ~~ / $0=[.] $0=[.] $<x>=[.] $<x>=[.] /;
124 is join('|',@0), 'a|b', 'Context respected on @0';
125 is join('|',@<x>), 'c|d', 'Context respected on @<x>';
40118ed @sorear Implement correct-style <{ }> assertion
authored
126 }
127
bf48f50 @sorear Respect context correctly on @0 and @<foo>
authored
128 is [ 1,2,3 ... 10 ], [1..10], 'arithmetic sequence';
129 is [ 1,2,4 ... 256 ], [map 2 ** *, 0..8], 'geometric sequence';
130 is [ 1,1,*+* ...^ *>100 ], [1,1,2,3,5,8,13,21,34,55,89], 'callback sequence';
44f7995 @sorear Steal ... and ...^ from Rakudo
authored
131
e51f7a9 @sorear [remove-CURLEX] Reimplementation of STD is_name
authored
132 eval_lives_ok q[
133 class F2855::G7136 { ... }
134 class F2855::G7136 { }
135 ], "can stub then define nested classes";
136
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
137 {
21aca01 @sorear Make for-loops work in blasts
authored
138 my @l = gather for 1,2 { take $_ };
139 is ~@l, "1 2", "gather for works";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
140
2c21c29 @sorear Rewrite stash handling
authored
141 eval_dies_ok 'class { has $!foo; has $!foo; }',
142 "double attribute declaration caught";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
143
2c21c29 @sorear Rewrite stash handling
authored
144 eval_dies_ok 'class { method abar {}; method abar {}; }',
145 "double method declaration caught";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
146
147 # <chain> isn't tested here. It's not possible to do the same AST
148 # reconstruction tricks. However if <right> etc work, and chained
149 # comparisons work, it's pretty likely to work combinationally.
150 sub infix:<@a> { "a(@_.Str())" }
151 sub infix:<@b> is assoc<right> { "b(@_.Str())" }
152 sub infix:<@c> is assoc<list> { "c(@_.Str())" }
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored
153 sub infix:<@d> is assoc<list> { "d(@_.Str())" } #OK not used
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
154 sub infix:<@e> is assoc<non> { "e(@_.Str())" }
155 sub infix:<@f> is assoc<left> { "f(@_.Str())" }
156
157 is (1 @a 2), 'a(1 2)', 'basic operator function';
158 is (1 @a 2 @a 3), 'a(a(1 2) 3)', 'operators default to left assoc';
159 is (1 @f 2 @f 3), 'f(f(1 2) 3)', 'explicit assoc<left> works too';
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored
160 is (1 @f 2 @a 3), 'a(f(1 2) 3)', 'mixed <left> at same prec works (1)';
161 is (1 @a 2 @f 3), 'f(a(1 2) 3)', 'mixed <left> at same prec works (2)';
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
162 is (1 @b 2 @b 3), 'b(1 b(2 3))', 'assoc<right> overrides';
163 is (1 @c 2 @c 3), 'c(1 2 3)', 'assoc<list> takes all 3 at once';
164 eval_dies_ok q[1 @c 2 @d 3], 'mixed <list> at same prec dies';
165 eval_dies_ok q[1 @e 2 @e 3], '<non> dies with 3';
166 is (1 @e 2), 'e(1 2)', '<non> with 2 works';
167
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored
168 sub infix:<@g> is tighter<@a> { "g(@_.Str())" } #OK not used
169 sub infix:<@h> is looser<@a> { "h(@_.Str())" } #OK not used
170 sub infix:<@i> is tighter(&infix:<@a>) { "i(@_.Str())" } #OK not used
171 sub infix:<@j> is looser(&infix:<@a>) { "j(@_.Str())" } #OK not used
172 sub infix:<@k> is tighter<@h> { "k(@_.Str())" } #OK not used
173 sub infix:<@l> is looser<@g> { "l(@_.Str())" } #OK not used
174 sub infix:<@m> is equiv<@a> { "m(@_.Str())" } #OK not used
175 sub infix:<@n> is equiv(&infix:<@a>) { "n(@_.Str())" } #OK not used
176 sub infix:<@o> is equiv<@g> { "o(@_.Str())" } #OK not used
177 sub infix:<@p> is equiv<@h> { "p(@_.Str())" } #OK not used
178 sub infix:<@q> is equiv<@b> { "q(@_.Str())" } #OK not used
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
179
180 my @cmptests = (
181 'a', 'g', 1, 0, 'tighter<> works',
182 'h', 'a', 1, 0, 'looser<> works',
183 'a', 'i', 1, 0, 'tighter<> works with code object',
184 'j', 'a', 1, 0, 'looser<> works with code object',
185 'h', 'k', 1, 0, 'tighter of a looser works',
186 'l', 'g', 1, 0, 'looser of a tighter works',
187 'k', 'a', 1, 0, 'tighter of a looser is still looser',
188 'a', 'l', 1, 0, 'looser of a tighter is still tighter',
189 'm', 'a', 0, 0, 'equiv works',
190 'n', 'a', 0, 0, 'equiv works with code object',
191 'o', 'g', 0, 0, 'equiv of tighter works',
192 'p', 'h', 0, 0, 'equiv of looser works',
193 'q', 'q', 1, 1, 'equiv also copies associativity',
194 );
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored
195 sub ckb($res is copy) { #OK not used
196 $res ~~ s:g /<.alpha>//; #::
197 $res eq '((1 2) 3)' ?? 0 !! 1;
198 }
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
199 my @frags;
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored
200 for @cmptests -> $lt, $gt, $right_br_ord, $right_br_opp, $msg {
201 push @frags, "is ckb(1 @$lt 2 @$gt 3), $right_br_ord, '$msg (1)';\n";
202 push @frags, "is ckb(1 @$gt 2 @$lt 3), $right_br_opp, '$msg (2)';\n";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, as...
authored
203 }
204 eval @frags.join;
205 }
206
9fa31a8 @sorear my-variables default to Any but with Mu constraint
authored
207 {
208 lives_ok { my $x; $x = Mu },
209 "can assign Mu to default-typed variable (noninline)";
210 lives_ok { if 1 { my $x; $x = Mu } },
211 "can assign Mu to default-typed variable (inline)";
212 dies_ok { my Any $x; $x = Mu },
213 "cannot assign Mu to Any-typed variable (noninline)";
214 dies_ok { if 1 { my Any $x; $x = Mu } },
215 "cannot assign Mu to Any-typed variable (inline)";
216 ok { my $x; $x }.() === Any,
217 "default-typed variable receives Any (noninline)";
218 ok { if 1 { my $x; $x } }.() === Any,
219 "default-typed variable receives Any (inline)";
220
221 lives_ok { my @x; push @x, Mu }, "can push Mu";
222 lives_ok { my @x; push @x, 5; @x[0] = Mu }, "push creates Mu-ready vars";
223 lives_ok { my @x; unshift @x, Mu }, "can unshift Mu";
224 lives_ok { my @x; unshift @x, 5; @x[0] = Mu }, "unshift creates Mu-ready vars";
225 lives_ok { my $x; $x[0] = Mu }, "array creation autoviv supports Mu";
226 lives_ok { my @x; @x[0] = Mu }, "element creation autoviv supports Mu";
227 lives_ok { my $x; $x<a> = Mu }, "hash creation autoviv supports Mu";
228 lives_ok { my %x; %x<a> = Mu }, "hash element creation autoviv supports Mu";
229 }
230
ba002dd @sorear Fix heredoc interpolation space oddity (thou++)
authored
231 # regression test from thou
232 {
233 my $x = 'Bar';
234 my $in = qq:to [A] ;
4d02280 @sorear Fix heredoc despacing for real, now with a working test too
authored
235 $x Foo
236 A
237 is $in.substr(0,8), 'Bar Foo', "spaces preserved after heredoc interpolation";
ba002dd @sorear Fix heredoc interpolation space oddity (thou++)
authored
238 }
239
27122b4 @sorear Fix binding to package-scoped arrays (yet again), @*ARGS and %*ENV flatt...
authored
240 {
241 ok @*ARGS.flattens, '@*ARGS is a flatteny thing';
242 ok %*ENV.flattens, '%*ENV is a flatteny thing';
243 @Y8158::z := [1,2,3];
244 ok @Y8158::z.flattens, 'binding to @foo::bar works';
245 }
246
d6516ab @sorear Incorporate colomon's power tests
authored
247 # from colomon
248 {
249 isa_ok 1 ** 2, Int, "1 squared is an Int";
250 is 1 ** 2, 1, "1 squared is 1";
251
252 isa_ok 2 ** 3, Int, "2 ** 3 is an Int";
253 is 2 ** 3, 8, "2 ** 3 is 8";
254 isa_ok (2/3) ** 3, Rat, "(2/3) ** 3 is a Rat";
255 is (2/3) ** 3, 8 / 27, "(2/3) ** 3 is 8 / 27";
256 isa_ok FatRat.new(2, 3) ** 3, FatRat, "FatRat.new(2, 3) ** 3 is a FatRat";
257 is FatRat.new(2, 3) ** 3, 8 / 27, "FatRat.new(2, 3) ** 3 is 8 / 27";
258 isa_ok 2.54e0 ** 3, Num, "2.54e0 ** 3 is an Num";
259 is 2.54e0 ** 3, 16.387064e0, "2.54e0 ** 3 is 16.387064e0";
260
261 isa_ok 2 ** -3, Rat, "2 ** -3 is an Rat"; # spec?
262 is 2 ** -3, 1/8, "2 ** -3 is 1/8";
263 isa_ok (2/3) ** -3, Rat, "(2/3) ** -3 is a Rat";
264 is (2/3) ** -3, 27 / 8, "(2/3) ** -3 is 27 / 8";
265 isa_ok FatRat.new(2, 3) ** -3, FatRat, "FatRat.new(2, 3) ** -3 is a FatRat";
266 is FatRat.new(2, 3) ** -3, 27 / 8, "FatRat.new(2, 3) ** -3 is 27 / 8";
267 isa_ok 2.54e0 ** -3, Num, "2.54e0 ** -3 is an Num";
268 is_approx (2.54e0 ** -3), 0.0610237440947323, "2.54e0 ** -3 is 0.0610237440947323, more or less";
269
270 is_approx 1i ** 2, -1, "1i ** 2 is -1";
271 is_approx 1i ** 3, -1i, "1i ** 3 is -i";
272 is_approx 1i ** 4, 1, "1i ** 4 is 1";
273 }
274
bad54f1 @sorear Fix @x is copy for non-flatteny arguments
authored
275 {
276 "x" ~~ /./;
277 $/.perl; # regression; failure mode was infinite loop
278 my $x = 1;
279 2 R+= $x;
280 is $x, 3, 'R+= works';
281
282 sub foo(@y is copy) { +@y }
283 is foo([1,2,4]), 3, '@y is copy works with non-flatteny values';
284 }
285
212ba5b @sorear Fix ^2 X ^2 (Util)
authored
286 lives_ok { ^2 X ^2 }, 'X works on Ranges';
287
0fa6f23 @sorear Fix Foo::Bar regression
authored
288 #is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
289
290 # {
291 # {
292 # our $x = 5; #OK
293 # }
294 # ok $::x == 5, '$::x finds our variable';
295 #
296 # package Fao { our $y = 6; } #OK
297 # ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
298 #
299 # { class Mao { } }
300 # ok ::Mao.new.defined, 'can use classes via ::Mao';
301 # }
302 #
303 # {
304 # my $x = 7; #OK
305 # ok $::x == 7, '$::x can find lexicals';
306 # class A3 {
307 # method moo { 42 }
308 # class B4 {
309 # ok ::A3.moo, '::A3 can find outer classes';
310 # }
311 # }
312 # }
ae2e557 @sorear Implement control operators next, redo, last, return
authored
313
025e408 @pmurias [Test.pm6] remove &done-testing and &done_testing
pmurias authored
314 done;
Something went wrong with that request. Please try again.