Skip to content

HTTPS clone URL

Subversion checkout URL

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