Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 351 lines (302 sloc) 11.577 kb
57e7ad80 »
2008-11-09 [t] move some junction tests
1 use v6;
2 use Test;
3
b88a9d95 »
2013-03-11 autothreading order tests (& before |)
4 plan 89;
57e7ad80 »
2008-11-09 [t] move some junction tests
5
6 {
ffa7511e »
2009-11-01 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" …
7 # Solves the equation A + B = A * C for integers
57e7ad80 »
2008-11-09 [t] move some junction tests
8 # by autothreading over all interesting values
9
10 my $n = 0;
11 sub is_it($a, $b, $c) {
12 $n++;
13 if ($a != $b && $b != $c && $a != $c &&
14 $a * 10 + $c == $a + $b ) {
ffa7511e »
2009-11-01 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" …
15 return "$a + $b = $a$c";
57e7ad80 »
2008-11-09 [t] move some junction tests
16 } else {
ffa7511e »
2009-11-01 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" …
17 return ();
57e7ad80 »
2008-11-09 [t] move some junction tests
18 }
19 }
20
21 # note that since the junction is not evaluated in boolean context,
22 # it's not collapsed, and the auto-threading may not abort prematurely
23 # when a result is found.
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
24 my Mu $answer = is_it(any(1..2), any(7..9), any(0..6));
57e7ad80 »
2008-11-09 [t] move some junction tests
25 is($n, 42, "called lots of times :-)");
d11fdec0 »
2009-01-19 [t/spec] avoid autothreading through ok() in three test files
26 ok( ?($answer eq "1 + 9 = 10"), "found right answer");
57e7ad80 »
2008-11-09 [t] move some junction tests
27 }
28
5c2c4cd7 »
2009-01-19 [t/spec] Few more tests for auto-threading, these ones covering auto-…
29 {
30 # Checks auto-threading works on method calls too, and that we get the
31 # right result.
32 class Foo {
33 has $.count = 0;
34 method test($x) { $!count++; return $x }
35 }
36
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
37 my $x;
38 my Mu $r;
39 my Mu $ok;
5c2c4cd7 »
2009-01-19 [t/spec] Few more tests for auto-threading, these ones covering auto-…
40 $x = Foo.new;
41 $r = $x.test(1|2);
42 is($x.count, 2, 'method called right number of times');
43 $ok = $r.perl.subst(/\D/, '', :g) eq '12' | '21';
44 ok(?$ok, 'right values passed to method');
45
46 $x = Foo.new;
47 $r = $x.test(1 & 2 | 3);
48 is($x.count, 3, 'method called right number of times');
49 $ok = $r.perl.subst(/\D/, '', :g) eq '123' | '213' | '312' | '321'; # e.g. & values together
50 ok(?$ok, 'junction structure maintained');
51 }
52
de5b1fbd »
2009-01-19 [t/spec] A bunch of tests for junctional dispatch with multi-subs (wi…
53 {
54 # Check auto-threding works right on multi-subs.
55 my $calls_a = 0;
56 my $calls_b = 0;
57 my $calls_c = 0;
58 my ($r, $ok);
59 multi mstest(Int $x) { $calls_a++; return $x }
8dc7d4b8 »
2010-07-15 [t/spec] mark various tests that intentionally declare things that ar…
60 multi mstest(Str $x, Str $y) { $calls_b++ } #OK not used
61 multi mstest(Str $x) { $calls_c++ } #OK not used
de5b1fbd »
2009-01-19 [t/spec] A bunch of tests for junctional dispatch with multi-subs (wi…
62 $r = mstest(1&2 | 3);
63 is($calls_a, 3, 'correct multi-sub called right number of times');
64 is($calls_b, 0, 'incorrect multi-sub not called');
65 is($calls_c, 0, 'incorrect multi-sub not called');
66 $ok = $r.perl.subst(/\D/, '', :g) eq '123' | '213' | '312' | '321'; # e.g. & values together
67 ok(?$ok, 'junction structure maintained');
68
69 $calls_a = 0;
70 $calls_b = 0;
71 $calls_c = 0;
72 mstest("a" | "b", "c" & "d");
73 is($calls_b, 4, 'correct multi-sub called right number of times');
74 is($calls_a, 0, 'incorrect multi-sub not called');
75 is($calls_c, 0, 'incorrect multi-sub not called');
76
77 $calls_a = 0;
78 $calls_b = 0;
79 $calls_c = 0;
80 mstest('a' | 1 & 'b');
81 is($calls_a, 1, 'correct multi-sub called right number of times (junction of many types)');
82 is($calls_c, 2, 'correct multi-sub called right number of times (junction of many types)');
83 is($calls_b, 0, 'incorrect multi-sub not called');
84
85 # Extra sanity, in case some multi-dispatch caching issues existed.
86 $calls_a = 0;
87 $calls_b = 0;
88 $calls_c = 0;
89 mstest('a' | 1 & 'b');
90 is($calls_a, 1, 'correct multi-sub called again right number of times (junction of many types)');
91 is($calls_c, 2, 'correct multi-sub called again right number of times (junction of many types)');
92 is($calls_b, 0, 'incorrect multi-sub again not called');
93
94 $calls_a = 0;
95 $calls_b = 0;
96 $calls_c = 0;
97 mstest('a');
98 is($calls_a, 0, 'non-junctional dispatch still works');
99 is($calls_b, 0, 'non-junctional dispatch still works');
100 is($calls_c, 1, 'non-junctional dispatch still works');
101 }
5c2c4cd7 »
2009-01-19 [t/spec] Few more tests for auto-threading, these ones covering auto-…
102
de5b1fbd »
2009-01-19 [t/spec] A bunch of tests for junctional dispatch with multi-subs (wi…
103 {
104 # Check auto-threading with multi-methods. Basically a re-hash of the
105 # above, but in a class.
106 class MMTest {
107 has $.calls_a = 0;
108 has $.calls_b = 0;
109 has $.calls_c = 0;
110 multi method mmtest(Int $x) { $!calls_a++; return $x }
91600dea »
2010-07-15 [t/spec] more warning suppressions
111 multi method mmtest(Str $x, Str $y) { $!calls_b++ } #OK not used
112 multi method mmtest(Str $x) { $!calls_c++ } #OK not used
de5b1fbd »
2009-01-19 [t/spec] A bunch of tests for junctional dispatch with multi-subs (wi…
113 }
114 my ($obj, $r, $ok);
115 $obj = MMTest.new();
116 $r = $obj.mmtest(1&2 | 3);
117 is($obj.calls_a, 3, 'correct multi-method called right number of times');
118 is($obj.calls_b, 0, 'incorrect multi-method not called');
119 is($obj.calls_c, 0, 'incorrect multi-method not called');
120 $ok = $r.perl.subst(/\D/, '', :g) eq '123' | '213' | '312' | '321'; # e.g. & values together
121 ok(?$ok, 'junction structure maintained');
122
123 $obj = MMTest.new();
124 $obj.mmtest("a" | "b", "c" & "d");
125 is($obj.calls_b, 4, 'correct multi-method called right number of times');
126 is($obj.calls_a, 0, 'incorrect multi-method not called');
127 is($obj.calls_c, 0, 'incorrect multi-method not called');
128
129 $obj = MMTest.new();
130 $obj.mmtest('a' | 1 & 'b');
131 is($obj.calls_a, 1, 'correct multi-method called right number of times (junction of many types)');
132 is($obj.calls_c, 2, 'correct multi-method called right number of times (junction of many types)');
133 is($obj.calls_b, 0, 'incorrect multi-method not called');
134 }
62c7abe0 »
2009-01-19 [t/spec] Tests for junction auto-threading and named parameters - fud…
135
136 {
137 # Ensure named params in single dispatch auto-thread.
138 my $count = 0;
139 my @got;
140 sub nptest($a, :$b, :$c) { $count++; @got.push($a ~ $b ~ $c) }
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
141 my Mu $r = nptest(1, c => 4|5, b => 2|3);
62c7abe0 »
2009-01-19 [t/spec] Tests for junction auto-threading and named parameters - fud…
142 is($count, 4, 'auto-threaded over named parameters to call sub enough times');
143 @got .= sort;
144 is(@got.elems, 4, 'got array of right size to check what was called');
145 is(@got[0], '124', 'called with correct parameters');
146 is(@got[1], '125', 'called with correct parameters');
147 is(@got[2], '134', 'called with correct parameters');
148 is(@got[3], '135', 'called with correct parameters');
149 }
150
151 {
152 # Ensure named params in multi dispatch auto-thread.
153 my $count_a = 0;
154 my $count_b = 0;
155 my @got;
156 multi npmstest(Int $a, :$b, :$c) { $count_a++; @got.push($a ~ $b ~ $c) }
157 multi npmstest(Str $a, :$b, :$c) { $count_b++; @got.push($a ~ $b ~ $c) }
158 my $r = npmstest(1&'a', c => 2|3, b => 1);
159 is($count_a, 2, 'auto-threaded over named parameters to call multi-sub variant enough times');
160 is($count_b, 2, 'auto-threaded over named parameters to call multi-sub variant enough times');
161 @got .= sort;
162 is(@got.elems, 4, 'got array of right size to check what was called');
163 is(@got[0], '112', 'called with correct parameters');
164 is(@got[1], '113', 'called with correct parameters');
165 is(@got[2], 'a12', 'called with correct parameters');
166 is(@got[3], 'a13', 'called with correct parameters');
167 }
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
168
169 {
170 # Auto-threading over an invocant.
a2ccce2e »
2011-06-11 [S03-junctions/autothreading] Use our to avoid testing unrelated prot…
171 our $cnt1 = 0;
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
172 class JuncInvTest1 {
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
173 method a { $cnt1++; }
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
174 has $.n;
175 method d { 2 * $.n }
176 }
a2ccce2e »
2011-06-11 [S03-junctions/autothreading] Use our to avoid testing unrelated prot…
177 our $cnt2 = 0;
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
178 class JuncInvTest2 {
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
179 method a { $cnt2++; }
180 method b($x) { $cnt2++ } #OK not used
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
181 }
182
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
183 my Mu $x = JuncInvTest1.new | JuncInvTest1.new | JuncInvTest2.new;
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
184 $x.a;
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
185 is $cnt1, 2, 'basic auto-threading over invocant works';
186 is $cnt2, 1, 'basic auto-threading over invocant works';
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
187
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
188 $cnt1 = $cnt2 = 0;
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
189 $x = JuncInvTest1.new | JuncInvTest2.new & JuncInvTest2.new;
190 $x.a;
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
191 is $cnt1, 1, 'auto-threading over invocant of nested junctions works';
192 is $cnt2, 2, 'auto-threading over invocant of nested junctions works';
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
193
194 $x = JuncInvTest1.new(n => 1) | JuncInvTest1.new(n => 2) & JuncInvTest1.new(n => 4);
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
195 my Mu $r = $x.d;
8ed5f61e »
2009-02-18 [t/spec] many small improvements:
196 my $ok = ?($r.perl.subst(/\D/, '', :g) eq '248' | '284' | '482' | '842');
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
197 ok($ok, 'auto-threading over invocant produced correct junctional result');
198
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
199 $cnt2 = 0;
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
200 $x = JuncInvTest2.new | JuncInvTest2.new;
201 $x.b('a' | 'b' | 'c');
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
202 is $cnt2, 6, 'auto-threading over invocant and parameters works';
f914433c »
2009-01-28 [t/spec] Various, though certainly not exhaustive, tests for auto-thr…
203 }
147ede3f »
2009-02-19 [t/spec] more autothreading tests (for .values and prefix:<+>)
204
205 # test that various things autothread
206
207 {
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
208 my Mu $j = [1, 2] | 5;
147ede3f »
2009-02-19 [t/spec] more autothreading tests (for .values and prefix:<+>)
209
210 ok ?( +$j == 5 ), 'prefix:<+> autothreads (1)';
211 ok ?( +$j == 2 ), 'prefix:<+> autothreads (2)';
212 ok !( +$j == 3 ), 'prefix:<+> autothreads (3)';
213 }
9a049c74 »
2009-02-26 [t/spec] autothreading prime test
214
215 # this is nothing new, but it's such a cool example for
216 # autothreading that I want it to be in the test suite nonetheless ;-)
217 {
218 sub primetest(Int $n) {
219 ?(none(2..$n) * any(2..$n) == $n);
220 };
221
222 # 2 3 4 5 6 7 8 9 10 11 12 13 14 15
223 my @is_prime = (1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0);
224
225 for @is_prime.kv -> $idx, $ref {
226 is +primetest($idx + 2), $ref, "primality test for { $idx + 2 } works";
227 }
228 }
5b43411b »
2009-03-19 [t] merge array_deref.t into autothreading.t
229
230
231 #?pugs skip 'autothreading over array indexing'
232 {
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
233 my Mu $junc = 0|1|2;
5b43411b »
2009-03-19 [t] merge array_deref.t into autothreading.t
234 my @a = (0,1,2);
235 my $bool = Bool::False;
236 ok ?(@a[$junc] == $junc), 'can autothread over array indexes';
237 }
d505e37c »
2009-03-19 [t] merge junction/s09eg.t into autothreading.t
238
af86cfdc »
2011-06-02 Fudge and simplify S03-junctions/autothreading for Niecza
239 # Tests former autothreading junction example from Synopsis 09
d505e37c »
2009-03-19 [t] merge junction/s09eg.t into autothreading.t
240 {
241 my $c = 0;
242
243 is(substr("camel", 0, 2), "ca", "substr()");
244
245 $c = 0;
246 sub my_substr ($str, $i, $j) {
247 $c++;
9c2b9a85 »
2009-04-17 [t/spec] revert r26201 (except the part that touches TASKS)
248 my @c = split "", $str;
d505e37c »
2009-03-19 [t] merge junction/s09eg.t into autothreading.t
249 join("", @c[$i..($i+$j-1)]);
250 }
251
252 my $j = my_substr("camel", 0|1, 2&3);
253
254 is($c, 4, "substr() called 4 times");
255 }
8176a9bc »
2009-04-29 [t/spec] tests for RT #65096, autothreading over Array parameters
256
257 # test autothreading while passing arrays:
258 {
259 sub my_elems(@a) {
260 @a.elems;
261 }
262 ok !(my_elems([2, 3]|[4, 5, 6]) == 1),
263 'autothreading over array parameters (0)';
264 ok ?(my_elems([2, 3]|[4, 5, 6]) == 2),
265 'autothreading over array parameters (1)';
266 ok ?(my_elems([2, 3]|[4, 5, 6]) == 3),
267 'autothreading over array parameters (2)';
268 ok !(my_elems([2, 3]|[4, 5, 6]) == 4),
269 'autothreading over array parameters (3)';
270 }
271
82332a3a »
2010-03-15 [t/spec] fix some smartlinks, and a broken test in autothreading.t
272 # L<S02/Undefined types/"default block parameter type">
0e3afce7 »
2009-05-03 [t/TASKS] update; [t/spec] default block parameter type is Object
273
8f9a1198 »
2009-11-25 [t/] unify compartmentalized undef and Object concepts into Mu
274 # block parameters default to Mu, so test that they don't autothread:
0e3afce7 »
2009-05-03 [t/TASKS] update; [t/spec] default block parameter type is Object
275 {
276 my $c = 0;
277 for 1|2, 3|4, 5|6 -> $x {
278 $c++;
279 }
280 is $c, 3, 'do not autothread over blocks by default';
625cd925 »
2011-06-03 Unfudge for block Mu parameters
281 }
282 #?niecza skip 'interferes hard with inlining'
283 {
284 my $c = 0;
0e3afce7 »
2009-05-03 [t/TASKS] update; [t/spec] default block parameter type is Object
285 for 1|2, 3|4, 5|6 -> Any $x {
286 $c++;
287 }
82332a3a »
2010-03-15 [t/spec] fix some smartlinks, and a broken test in autothreading.t
288 is $c, 6, 'do autothread over blocks with explicit Any';
0e3afce7 »
2009-05-03 [t/TASKS] update; [t/spec] default block parameter type is Object
289 }
290
000d727d »
2010-05-30 [t/spec] tests for RT #75368 and new spec wrt autothreading over nega…
291 # used to be RT #75368
292 # L<S03/Junctive operators/Use of negative operators with junctions>
293 {
294 my Mu $x = 'a' ne ('a'|'b'|'c');
295 ok $x ~~ Bool, 'infix:<ne> collapses the junction (1)';
296 ok $x !~~ Junction, 'infix:<ne> collapses the junction (2)';
297 nok $x, '... and the result is False';
298
299 my Mu $y = 'a' !eq ('a'|'b'|'c');
300 ok $y ~~ Bool, 'infix:<!eq> collapses the junction (1)';
301 ok $y !~~ Junction, 'infix:<!eq> collapses the junction (2)';
302 nok $y, '... and the result is False';
f7b449b0 »
2012-03-23 test that != autothreads like !==
303
304 my Mu $z = any(1, 2, 3);
305 ok 4 != $z, '!= autothreads like not == (1)';
306 nok 3 != $z, '!= autothreads like not == (2)';
000d727d »
2010-05-30 [t/spec] tests for RT #75368 and new spec wrt autothreading over nega…
307 }
308
a7cc650a »
2011-10-01 autothreading over named params (RT #69863)
309 # RT #69863
310 # autothreading over named-only params
311 {
312 sub foo(Int :$n) { $n }
313 ok foo(n => 1|2) ~~ Junction, 'named-only params autothread correctly';
314 }
315
54444223 »
2011-10-24 test for RT #76422, junctions should not flatten ranges
316 # test that junctions doen't flatten ranges
317 # RT #76422
318 {
319 ok ((1..42) | (8..35)).max == 42, 'infix | does not flatten ranges';
320 }
321
b88a9d95 »
2013-03-11 autothreading order tests (& before |)
322 # test that the order of junction autothreading is:
323 # the leftmost all or none junction (if any), then
324 # the leftmost one or any junction.
325
326 {
327 sub tp($a, $b, $c) { "$a $b $c" };
328
329 my Mu $res = tp("dog", 1|2, 10&20);
330 # should turn into:
331 # all( tp("dog", 1|2, 10),
332 # tp("dog", 1|2, 20))
333 #
334 # into:
335 # all( any( tp("dog", 1, 10), tp("dog", 2, 10),
336 # any( tp("dog", 1, 20), tp("dog", 2, 20)))
7d2ac006 »
2013-03-11 fix a typo.
337 is $res.Str, q{all(any("dog 1 10", "dog 2 10"), any("dog 1 20", "dog 2 20"))}, "an & junction right of a | junction will be autothreaded first";
b88a9d95 »
2013-03-11 autothreading order tests (& before |)
338
339 $res = tp("foo"&"bar", 1|2, 0);
340 # should turn into:
341 # all( tp("foo", 1|2, 0),
342 # tp("bar", 1|2, 0))
343 #
344 # into:
345 # all( any( tp("foo", 1, 0), tp("foo", 2, 0)),
346 # any( tp("bar", 1, 0), tp("bar", 2, 0)))
347 is $res.Str, q{all(any("foo 1 0", "foo 2 0"), any("bar 1 0", "bar 2 0"))}, "an & junction left of a | junction will be autothreaded first";
348 }
349
8176a9bc »
2009-04-29 [t/spec] tests for RT #65096, autothreading over Array parameters
350 # vim: ft=perl6
Something went wrong with that request. Please try again.