Skip to content
Newer
Older
100644 295 lines (252 sloc) 10.7 KB
ff2f9de @sorear Prototype of the Array class
authored Aug 4, 2010
1 # vim: ft=perl6
2 use Test;
9f1bf0e @sorear Implement &sort
authored Oct 13, 2010
3 use MONKEY_TYPING;
ff2f9de @sorear Prototype of the Array class
authored Aug 4, 2010
4
e7236a4 @sorear Fix ** state funkiness, add tests
authored Dec 14, 2011
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 Dec 14, 2011
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 Dec 14, 2011
22
95e0703 @sorear Implement @var in regexes, incl. LTM and regex elements
authored Dec 14, 2011
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 Dec 16, 2011
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 Dec 16, 2011
43
44 is ("foo" ~~ /<."alpha"()>/), "f", "dottyop assertions work";
bca1172 @sorear Implement <foo> calling my regex foo if in scope
authored Dec 16, 2011
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 Dec 16, 2011
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 Dec 15, 2011
60 }
886540f @sorear Implement $var in regexes using Regex objects as subregexes (fixes #77)
authored Dec 14, 2011
61
ca4d6f1 @sorear Implement use of submethod BUILD
authored Jun 7, 2011
62 {
5b61026 @sorear Implement fancy proto regexes with stuff around {*}
authored Dec 17, 2011
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 {
ca4d6f1 @sorear Implement use of submethod BUILD
authored Jun 8, 2011
80 my class Bt {
81 has $!pie;
82 method get_pie() { $!pie }
83 submethod BUILD(:$x) { $!pie = $x }
84 }
85 is Bt.new(x => 5).get_pie, 5, "BUILD basically works";
86 my class SubBT is Bt {
87 has $!pie2;
88 method get_pie2() { $!pie2 }
89 submethod BUILD(:$y) { $!pie2 = $y }
90 }
91 is SubBT.new(x => 5, y => 2).get_pie, 5, "superclass' BUILD in subclass";
92 is SubBT.new(x => 5, y => 2).get_pie2, 2, "subclass' BUILD in subclass";
904bb14 @sorear Fix binding to existing @vars
authored Jun 8, 2011
93
94 my @l;
95 @l := [1,2,3];
96 is +[@l], 3, 'binding to existing list vars works';
ca4d6f1 @sorear Implement use of submethod BUILD
authored Jun 8, 2011
97 }
98
40118ed @sorear Implement correct-style <{ }> assertion
authored Dec 16, 2011
99 {
100 my $rxd = / (\d+) <{ "a ** $0" }> /;
101 is ("3aaa" ~~ $rxd), "3aaa", '<{}> works';
bf48f50 @sorear Respect context correctly on @0 and @<foo>
authored Dec 16, 2011
102
103 "abcd" ~~ / $0=[.] $0=[.] $<x>=[.] $<x>=[.] /;
104 is join('|',@0), 'a|b', 'Context respected on @0';
105 is join('|',@<x>), 'c|d', 'Context respected on @<x>';
40118ed @sorear Implement correct-style <{ }> assertion
authored Dec 17, 2011
106 }
107
bf48f50 @sorear Respect context correctly on @0 and @<foo>
authored Dec 17, 2011
108 is [ 1,2,3 ... 10 ], [1..10], 'arithmetic sequence';
109 is [ 1,2,4 ... 256 ], [map 2 ** *, 0..8], 'geometric sequence';
110 is [ 1,1,*+* ...^ *>100 ], [1,1,2,3,5,8,13,21,34,55,89], 'callback sequence';
44f7995 @sorear Steal ... and ...^ from Rakudo
authored Jun 8, 2011
111
e51f7a9 @sorear [remove-CURLEX] Reimplementation of STD is_name
authored Jun 12, 2011
112 eval_lives_ok q[
113 class F2855::G7136 { ... }
114 class F2855::G7136 { }
115 ], "can stub then define nested classes";
116
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, …
authored Jun 16, 2011
117 {
21aca01 @sorear Make for-loops work in blasts
authored Jun 17, 2011
118 my @l = gather for 1,2 { take $_ };
119 is ~@l, "1 2", "gather for works";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, …
authored Jun 16, 2011
120
2c21c29 @sorear Rewrite stash handling
authored Jun 22, 2011
121 eval_dies_ok 'class { has $!foo; has $!foo; }',
122 "double attribute declaration caught";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, …
authored Jun 16, 2011
123
2c21c29 @sorear Rewrite stash handling
authored Jun 22, 2011
124 eval_dies_ok 'class { method abar {}; method abar {}; }',
125 "double method declaration caught";
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, …
authored Jun 16, 2011
126
127 # <chain> isn't tested here. It's not possible to do the same AST
128 # reconstruction tricks. However if <right> etc work, and chained
129 # comparisons work, it's pretty likely to work combinationally.
130 sub infix:<@a> { "a(@_.Str())" }
131 sub infix:<@b> is assoc<right> { "b(@_.Str())" }
132 sub infix:<@c> is assoc<list> { "c(@_.Str())" }
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored Jun 17, 2011
133 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, …
authored Jun 16, 2011
134 sub infix:<@e> is assoc<non> { "e(@_.Str())" }
135 sub infix:<@f> is assoc<left> { "f(@_.Str())" }
136
137 is (1 @a 2), 'a(1 2)', 'basic operator function';
138 is (1 @a 2 @a 3), 'a(a(1 2) 3)', 'operators default to left assoc';
139 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 Jun 17, 2011
140 is (1 @f 2 @a 3), 'a(f(1 2) 3)', 'mixed <left> at same prec works (1)';
141 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, …
authored Jun 16, 2011
142 is (1 @b 2 @b 3), 'b(1 b(2 3))', 'assoc<right> overrides';
143 is (1 @c 2 @c 3), 'c(1 2 3)', 'assoc<list> takes all 3 at once';
144 eval_dies_ok q[1 @c 2 @d 3], 'mixed <list> at same prec dies';
145 eval_dies_ok q[1 @e 2 @e 3], '<non> dies with 3';
146 is (1 @e 2), 'e(1 2)', '<non> with 2 works';
147
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored Jun 17, 2011
148 sub infix:<@g> is tighter<@a> { "g(@_.Str())" } #OK not used
149 sub infix:<@h> is looser<@a> { "h(@_.Str())" } #OK not used
150 sub infix:<@i> is tighter(&infix:<@a>) { "i(@_.Str())" } #OK not used
151 sub infix:<@j> is looser(&infix:<@a>) { "j(@_.Str())" } #OK not used
152 sub infix:<@k> is tighter<@h> { "k(@_.Str())" } #OK not used
153 sub infix:<@l> is looser<@g> { "l(@_.Str())" } #OK not used
154 sub infix:<@m> is equiv<@a> { "m(@_.Str())" } #OK not used
155 sub infix:<@n> is equiv(&infix:<@a>) { "n(@_.Str())" } #OK not used
156 sub infix:<@o> is equiv<@g> { "o(@_.Str())" } #OK not used
157 sub infix:<@p> is equiv<@h> { "p(@_.Str())" } #OK not used
158 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, …
authored Jun 16, 2011
159
160 my @cmptests = (
161 'a', 'g', 1, 0, 'tighter<> works',
162 'h', 'a', 1, 0, 'looser<> works',
163 'a', 'i', 1, 0, 'tighter<> works with code object',
164 'j', 'a', 1, 0, 'looser<> works with code object',
165 'h', 'k', 1, 0, 'tighter of a looser works',
166 'l', 'g', 1, 0, 'looser of a tighter works',
167 'k', 'a', 1, 0, 'tighter of a looser is still looser',
168 'a', 'l', 1, 0, 'looser of a tighter is still tighter',
169 'm', 'a', 0, 0, 'equiv works',
170 'n', 'a', 0, 0, 'equiv works with code object',
171 'o', 'g', 0, 0, 'equiv of tighter works',
172 'p', 'h', 0, 0, 'equiv of looser works',
173 'q', 'q', 1, 1, 'equiv also copies associativity',
174 );
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored Jun 17, 2011
175 sub ckb($res is copy) { #OK not used
176 $res ~~ s:g /<.alpha>//; #::
177 $res eq '((1 2) 3)' ?? 0 !! 1;
178 }
dff3b35 @sorear 36 new tests for tighter/looser/equiv. tighter+looser is not tested, …
authored Jun 16, 2011
179 my @frags;
c835aaa @sorear Fixup assoc/tighter/equiv/looser tests; now fully working
authored Jun 17, 2011
180 for @cmptests -> $lt, $gt, $right_br_ord, $right_br_opp, $msg {
181 push @frags, "is ckb(1 @$lt 2 @$gt 3), $right_br_ord, '$msg (1)';\n";
182 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, …
authored Jun 16, 2011
183 }
184 eval @frags.join;
185 }
186
9fa31a8 @sorear my-variables default to Any but with Mu constraint
authored Jun 25, 2011
187 {
188 lives_ok { my $x; $x = Mu },
189 "can assign Mu to default-typed variable (noninline)";
190 lives_ok { if 1 { my $x; $x = Mu } },
191 "can assign Mu to default-typed variable (inline)";
192 dies_ok { my Any $x; $x = Mu },
193 "cannot assign Mu to Any-typed variable (noninline)";
194 dies_ok { if 1 { my Any $x; $x = Mu } },
195 "cannot assign Mu to Any-typed variable (inline)";
196 ok { my $x; $x }.() === Any,
197 "default-typed variable receives Any (noninline)";
198 ok { if 1 { my $x; $x } }.() === Any,
199 "default-typed variable receives Any (inline)";
200
201 lives_ok { my @x; push @x, Mu }, "can push Mu";
202 lives_ok { my @x; push @x, 5; @x[0] = Mu }, "push creates Mu-ready vars";
203 lives_ok { my @x; unshift @x, Mu }, "can unshift Mu";
204 lives_ok { my @x; unshift @x, 5; @x[0] = Mu }, "unshift creates Mu-ready vars";
205 lives_ok { my $x; $x[0] = Mu }, "array creation autoviv supports Mu";
206 lives_ok { my @x; @x[0] = Mu }, "element creation autoviv supports Mu";
207 lives_ok { my $x; $x<a> = Mu }, "hash creation autoviv supports Mu";
208 lives_ok { my %x; %x<a> = Mu }, "hash element creation autoviv supports Mu";
209 }
210
ba002dd @sorear Fix heredoc interpolation space oddity (thou++)
authored Jun 26, 2011
211 # regression test from thou
212 {
213 my $x = 'Bar';
214 my $in = qq:to [A] ;
4d02280 @sorear Fix heredoc despacing for real, now with a working test too
authored Jun 27, 2011
215 $x Foo
216 A
217 is $in.substr(0,8), 'Bar Foo', "spaces preserved after heredoc interpolation";
ba002dd @sorear Fix heredoc interpolation space oddity (thou++)
authored Jun 27, 2011
218 }
219
27122b4 @sorear Fix binding to package-scoped arrays (yet again), @*ARGS and %*ENV fl…
authored Jun 27, 2011
220 {
221 ok @*ARGS.flattens, '@*ARGS is a flatteny thing';
222 ok %*ENV.flattens, '%*ENV is a flatteny thing';
223 @Y8158::z := [1,2,3];
224 ok @Y8158::z.flattens, 'binding to @foo::bar works';
225 }
226
d6516ab @sorear Incorporate colomon's power tests
authored Jun 27, 2011
227 # from colomon
228 {
229 isa_ok 1 ** 2, Int, "1 squared is an Int";
230 is 1 ** 2, 1, "1 squared is 1";
231
232 isa_ok 2 ** 3, Int, "2 ** 3 is an Int";
233 is 2 ** 3, 8, "2 ** 3 is 8";
234 isa_ok (2/3) ** 3, Rat, "(2/3) ** 3 is a Rat";
235 is (2/3) ** 3, 8 / 27, "(2/3) ** 3 is 8 / 27";
236 isa_ok FatRat.new(2, 3) ** 3, FatRat, "FatRat.new(2, 3) ** 3 is a FatRat";
237 is FatRat.new(2, 3) ** 3, 8 / 27, "FatRat.new(2, 3) ** 3 is 8 / 27";
238 isa_ok 2.54e0 ** 3, Num, "2.54e0 ** 3 is an Num";
239 is 2.54e0 ** 3, 16.387064e0, "2.54e0 ** 3 is 16.387064e0";
240
241 isa_ok 2 ** -3, Rat, "2 ** -3 is an Rat"; # spec?
242 is 2 ** -3, 1/8, "2 ** -3 is 1/8";
243 isa_ok (2/3) ** -3, Rat, "(2/3) ** -3 is a Rat";
244 is (2/3) ** -3, 27 / 8, "(2/3) ** -3 is 27 / 8";
245 isa_ok FatRat.new(2, 3) ** -3, FatRat, "FatRat.new(2, 3) ** -3 is a FatRat";
246 is FatRat.new(2, 3) ** -3, 27 / 8, "FatRat.new(2, 3) ** -3 is 27 / 8";
247 isa_ok 2.54e0 ** -3, Num, "2.54e0 ** -3 is an Num";
248 is_approx (2.54e0 ** -3), 0.0610237440947323, "2.54e0 ** -3 is 0.0610237440947323, more or less";
249
250 is_approx 1i ** 2, -1, "1i ** 2 is -1";
251 is_approx 1i ** 3, -1i, "1i ** 3 is -i";
252 is_approx 1i ** 4, 1, "1i ** 4 is 1";
253 }
254
bad54f1 @sorear Fix @x is copy for non-flatteny arguments
authored Jul 7, 2011
255 {
256 "x" ~~ /./;
257 $/.perl; # regression; failure mode was infinite loop
258 my $x = 1;
259 2 R+= $x;
260 is $x, 3, 'R+= works';
261
262 sub foo(@y is copy) { +@y }
263 is foo([1,2,4]), 3, '@y is copy works with non-flatteny values';
264 }
265
212ba5b @sorear Fix ^2 X ^2 (Util)
authored Jul 13, 2011
266 lives_ok { ^2 X ^2 }, 'X works on Ranges';
267
0fa6f23 @sorear Fix Foo::Bar regression
authored Oct 6, 2010
268 #is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
269
270 # {
271 # {
272 # our $x = 5; #OK
273 # }
274 # ok $::x == 5, '$::x finds our variable';
275 #
276 # package Fao { our $y = 6; } #OK
277 # ok $::Fao::y == 6, '$::Fao::y works as $Fao::y';
278 #
279 # { class Mao { } }
280 # ok ::Mao.new.defined, 'can use classes via ::Mao';
281 # }
282 #
283 # {
284 # my $x = 7; #OK
285 # ok $::x == 7, '$::x can find lexicals';
286 # class A3 {
287 # method moo { 42 }
288 # class B4 {
289 # ok ::A3.moo, '::A3 can find outer classes';
290 # }
291 # }
292 # }
ae2e557 @sorear Implement control operators next, redo, last, return
authored Sep 15, 2010
293
025e408 @pmurias [Test.pm6] remove &done-testing and &done_testing
pmurias authored Dec 31, 2010
294 done;
Something went wrong with that request. Please try again.