Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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