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