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