Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 310 lines (268 sloc) 10.323 kb
57e7ad8 [t] move some junction tests
moritz authored
1 use v6;
2 use Test;
3
000d727 [t/spec] tests for RT #75368 and new spec wrt autothreading over negated...
moritz authored
4 plan 83;
57e7ad8 [t] move some junction tests
moritz authored
5
6 {
ffa7511 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" (as...
Kodi authored
7 # Solves the equation A + B = A * C for integers
57e7ad8 [t] move some junction tests
moritz authored
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 ) {
ffa7511 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" (as...
Kodi authored
15 return "$a + $b = $a$c";
57e7ad8 [t] move some junction tests
moritz authored
16 } else {
ffa7511 [t/spec/] "Junction" -> "junction", ".eigenstates" -> "!eigenstates" (as...
Kodi authored
17 return ();
57e7ad8 [t] move some junction tests
moritz authored
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.
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
24 my Mu $answer = is_it(any(1..2), any(7..9), any(0..6));
57e7ad8 [t] move some junction tests
moritz authored
25 is($n, 42, "called lots of times :-)");
d11fdec [t/spec] avoid autothreading through ok() in three test files
moritz authored
26 ok( ?($answer eq "1 + 9 = 10"), "found right answer");
57e7ad8 [t] move some junction tests
moritz authored
27 }
28
5c2c4cd [t/spec] Few more tests for auto-threading, these ones covering auto-thr...
jnthn authored
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
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
37 my $x;
38 my Mu $r;
39 my Mu $ok;
5c2c4cd [t/spec] Few more tests for auto-threading, these ones covering auto-thr...
jnthn authored
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
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
53 #?niecza skip 'autothreading multisubs'
de5b1fb [t/spec] A bunch of tests for junctional dispatch with multi-subs (with ...
jnthn authored
54 {
55 # Check auto-threding works right on multi-subs.
56 my $calls_a = 0;
57 my $calls_b = 0;
58 my $calls_c = 0;
59 my ($r, $ok);
60 multi mstest(Int $x) { $calls_a++; return $x }
8dc7d4b [t/spec] mark various tests that intentionally declare things that are n...
lwall authored
61 multi mstest(Str $x, Str $y) { $calls_b++ } #OK not used
62 multi mstest(Str $x) { $calls_c++ } #OK not used
de5b1fb [t/spec] A bunch of tests for junctional dispatch with multi-subs (with ...
jnthn authored
63 $r = mstest(1&2 | 3);
64 is($calls_a, 3, 'correct multi-sub called right number of times');
65 is($calls_b, 0, 'incorrect multi-sub not called');
66 is($calls_c, 0, 'incorrect multi-sub not called');
67 $ok = $r.perl.subst(/\D/, '', :g) eq '123' | '213' | '312' | '321'; # e.g. & values together
68 ok(?$ok, 'junction structure maintained');
69
70 $calls_a = 0;
71 $calls_b = 0;
72 $calls_c = 0;
73 mstest("a" | "b", "c" & "d");
74 is($calls_b, 4, 'correct multi-sub called right number of times');
75 is($calls_a, 0, 'incorrect multi-sub not called');
76 is($calls_c, 0, 'incorrect multi-sub not called');
77
78 $calls_a = 0;
79 $calls_b = 0;
80 $calls_c = 0;
81 mstest('a' | 1 & 'b');
82 is($calls_a, 1, 'correct multi-sub called right number of times (junction of many types)');
83 is($calls_c, 2, 'correct multi-sub called right number of times (junction of many types)');
84 is($calls_b, 0, 'incorrect multi-sub not called');
85
86 # Extra sanity, in case some multi-dispatch caching issues existed.
87 $calls_a = 0;
88 $calls_b = 0;
89 $calls_c = 0;
90 mstest('a' | 1 & 'b');
91 is($calls_a, 1, 'correct multi-sub called again right number of times (junction of many types)');
92 is($calls_c, 2, 'correct multi-sub called again right number of times (junction of many types)');
93 is($calls_b, 0, 'incorrect multi-sub again not called');
94
95 $calls_a = 0;
96 $calls_b = 0;
97 $calls_c = 0;
98 mstest('a');
99 is($calls_a, 0, 'non-junctional dispatch still works');
100 is($calls_b, 0, 'non-junctional dispatch still works');
101 is($calls_c, 1, 'non-junctional dispatch still works');
102 }
5c2c4cd [t/spec] Few more tests for auto-threading, these ones covering auto-thr...
jnthn authored
103
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
104 #?niecza skip 'autothreading + MMD'
de5b1fb [t/spec] A bunch of tests for junctional dispatch with multi-subs (with ...
jnthn authored
105 {
106 # Check auto-threading with multi-methods. Basically a re-hash of the
107 # above, but in a class.
108 class MMTest {
109 has $.calls_a = 0;
110 has $.calls_b = 0;
111 has $.calls_c = 0;
112 multi method mmtest(Int $x) { $!calls_a++; return $x }
91600de [t/spec] more warning suppressions
lwall authored
113 multi method mmtest(Str $x, Str $y) { $!calls_b++ } #OK not used
114 multi method mmtest(Str $x) { $!calls_c++ } #OK not used
de5b1fb [t/spec] A bunch of tests for junctional dispatch with multi-subs (with ...
jnthn authored
115 }
116 my ($obj, $r, $ok);
117 $obj = MMTest.new();
118 $r = $obj.mmtest(1&2 | 3);
119 is($obj.calls_a, 3, 'correct multi-method called right number of times');
120 is($obj.calls_b, 0, 'incorrect multi-method not called');
121 is($obj.calls_c, 0, 'incorrect multi-method not called');
122 $ok = $r.perl.subst(/\D/, '', :g) eq '123' | '213' | '312' | '321'; # e.g. & values together
123 ok(?$ok, 'junction structure maintained');
124
125 $obj = MMTest.new();
126 $obj.mmtest("a" | "b", "c" & "d");
127 is($obj.calls_b, 4, 'correct multi-method called right number of times');
128 is($obj.calls_a, 0, 'incorrect multi-method not called');
129 is($obj.calls_c, 0, 'incorrect multi-method not called');
130
131 $obj = MMTest.new();
132 $obj.mmtest('a' | 1 & 'b');
133 is($obj.calls_a, 1, 'correct multi-method called right number of times (junction of many types)');
134 is($obj.calls_c, 2, 'correct multi-method called right number of times (junction of many types)');
135 is($obj.calls_b, 0, 'incorrect multi-method not called');
136 }
62c7abe [t/spec] Tests for junction auto-threading and named parameters - fudged...
jnthn authored
137
138 {
139 # Ensure named params in single dispatch auto-thread.
140 my $count = 0;
141 my @got;
142 sub nptest($a, :$b, :$c) { $count++; @got.push($a ~ $b ~ $c) }
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
143 my Mu $r = nptest(1, c => 4|5, b => 2|3);
62c7abe [t/spec] Tests for junction auto-threading and named parameters - fudged...
jnthn authored
144 is($count, 4, 'auto-threaded over named parameters to call sub enough times');
145 @got .= sort;
146 is(@got.elems, 4, 'got array of right size to check what was called');
147 is(@got[0], '124', 'called with correct parameters');
148 is(@got[1], '125', 'called with correct parameters');
149 is(@got[2], '134', 'called with correct parameters');
150 is(@got[3], '135', 'called with correct parameters');
151 }
152
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
153 #?niecza skip 'autothreading + MMD'
62c7abe [t/spec] Tests for junction auto-threading and named parameters - fudged...
jnthn authored
154 {
155 # Ensure named params in multi dispatch auto-thread.
156 my $count_a = 0;
157 my $count_b = 0;
158 my @got;
159 multi npmstest(Int $a, :$b, :$c) { $count_a++; @got.push($a ~ $b ~ $c) }
160 multi npmstest(Str $a, :$b, :$c) { $count_b++; @got.push($a ~ $b ~ $c) }
161 my $r = npmstest(1&'a', c => 2|3, b => 1);
162 is($count_a, 2, 'auto-threaded over named parameters to call multi-sub variant enough times');
163 is($count_b, 2, 'auto-threaded over named parameters to call multi-sub variant enough times');
164 @got .= sort;
165 is(@got.elems, 4, 'got array of right size to check what was called');
166 is(@got[0], '112', 'called with correct parameters');
167 is(@got[1], '113', 'called with correct parameters');
168 is(@got[2], 'a12', 'called with correct parameters');
169 is(@got[3], 'a13', 'called with correct parameters');
170 }
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
171
172 {
173 # Auto-threading over an invocant.
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
174 my $cnt1 = 0;
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
175 class JuncInvTest1 {
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
176 method a { $cnt1++; }
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
177 has $.n;
178 method d { 2 * $.n }
179 }
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
180 my $cnt2 = 0;
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
181 class JuncInvTest2 {
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
182 method a { $cnt2++; }
183 method b($x) { $cnt2++ } #OK not used
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
184 }
185
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
186 my Mu $x = JuncInvTest1.new | JuncInvTest1.new | JuncInvTest2.new;
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
187 $x.a;
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
188 is $cnt1, 2, 'basic auto-threading over invocant works';
189 is $cnt2, 1, 'basic auto-threading over invocant works';
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
190
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
191 $cnt1 = $cnt2 = 0;
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
192 $x = JuncInvTest1.new | JuncInvTest2.new & JuncInvTest2.new;
193 $x.a;
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
194 is $cnt1, 1, 'auto-threading over invocant of nested junctions works';
195 is $cnt2, 2, 'auto-threading over invocant of nested junctions works';
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
196
197 $x = JuncInvTest1.new(n => 1) | JuncInvTest1.new(n => 2) & JuncInvTest1.new(n => 4);
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
198 my Mu $r = $x.d;
8ed5f61 [t/spec] many small improvements:
moritz authored
199 my $ok = ?($r.perl.subst(/\D/, '', :g) eq '248' | '284' | '482' | '842');
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
200 ok($ok, 'auto-threading over invocant produced correct junctional result');
201
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
202 $cnt2 = 0;
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
203 $x = JuncInvTest2.new | JuncInvTest2.new;
204 $x.b('a' | 'b' | 'c');
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
205 is $cnt2, 6, 'auto-threading over invocant and parameters works';
f914433 [t/spec] Various, though certainly not exhaustive, tests for auto-thread...
jnthn authored
206 }
147ede3 [t/spec] more autothreading tests (for .values and prefix:<+>)
moritz authored
207
208 # test that various things autothread
209
210 {
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
211 my Mu $j = [1, 2] | 5;
147ede3 [t/spec] more autothreading tests (for .values and prefix:<+>)
moritz authored
212
213 ok ?( +$j == 5 ), 'prefix:<+> autothreads (1)';
214 ok ?( +$j == 2 ), 'prefix:<+> autothreads (2)';
215 ok !( +$j == 3 ), 'prefix:<+> autothreads (3)';
216 }
9a049c7 [t/spec] autothreading prime test
moritz authored
217
218 # this is nothing new, but it's such a cool example for
219 # autothreading that I want it to be in the test suite nonetheless ;-)
220 {
221 sub primetest(Int $n) {
222 ?(none(2..$n) * any(2..$n) == $n);
223 };
224
225 # 2 3 4 5 6 7 8 9 10 11 12 13 14 15
226 my @is_prime = (1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0);
227
228 for @is_prime.kv -> $idx, $ref {
229 is +primetest($idx + 2), $ref, "primality test for { $idx + 2 } works";
230 }
231 }
5b43411 [t] merge array_deref.t into autothreading.t
moritz authored
232
233
234 #?pugs skip 'autothreading over array indexing'
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
235 #?niecza skip 'autothreading over array indexing'
5b43411 [t] merge array_deref.t into autothreading.t
moritz authored
236 {
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
237 my Mu $junc = 0|1|2;
5b43411 [t] merge array_deref.t into autothreading.t
moritz authored
238 my @a = (0,1,2);
239 my $bool = Bool::False;
240 ok ?(@a[$junc] == $junc), 'can autothread over array indexes';
241 }
d505e37 [t] merge junction/s09eg.t into autothreading.t
moritz authored
242
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
243 # Tests former autothreading junction example from Synopsis 09
244 #?niecza skip '&skip'
d505e37 [t] merge junction/s09eg.t into autothreading.t
moritz authored
245 {
246 my $c = 0;
247
248 is(substr("camel", 0, 2), "ca", "substr()");
249
250 $c = 0;
251 sub my_substr ($str, $i, $j) {
252 $c++;
9c2b9a8 [t/spec] revert r26201 (except the part that touches TASKS)
moritz authored
253 my @c = split "", $str;
d505e37 [t] merge junction/s09eg.t into autothreading.t
moritz authored
254 join("", @c[$i..($i+$j-1)]);
255 }
256
257 my $j = my_substr("camel", 0|1, 2&3);
258
259 is($c, 4, "substr() called 4 times");
260 }
8176a9b [t/spec] tests for RT #65096, autothreading over Array parameters
moritz authored
261
262 # test autothreading while passing arrays:
263 {
264 sub my_elems(@a) {
265 @a.elems;
266 }
267 ok !(my_elems([2, 3]|[4, 5, 6]) == 1),
268 'autothreading over array parameters (0)';
269 ok ?(my_elems([2, 3]|[4, 5, 6]) == 2),
270 'autothreading over array parameters (1)';
271 ok ?(my_elems([2, 3]|[4, 5, 6]) == 3),
272 'autothreading over array parameters (2)';
273 ok !(my_elems([2, 3]|[4, 5, 6]) == 4),
274 'autothreading over array parameters (3)';
275 }
276
82332a3 [t/spec] fix some smartlinks, and a broken test in autothreading.t
moritz authored
277 # L<S02/Undefined types/"default block parameter type">
0e3afce [t/TASKS] update; [t/spec] default block parameter type is Object
moritz authored
278
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
279 # block parameters default to Mu, so test that they don't autothread:
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
280 #?niecza skip 'NYI'
0e3afce [t/TASKS] update; [t/spec] default block parameter type is Object
moritz authored
281 {
282 my $c = 0;
283 for 1|2, 3|4, 5|6 -> $x {
284 $c++;
285 }
286 is $c, 3, 'do not autothread over blocks by default';
287 $c = 0;
288 for 1|2, 3|4, 5|6 -> Any $x {
289 $c++;
290 }
82332a3 [t/spec] fix some smartlinks, and a broken test in autothreading.t
moritz authored
291 is $c, 6, 'do autothread over blocks with explicit Any';
0e3afce [t/TASKS] update; [t/spec] default block parameter type is Object
moritz authored
292 }
293
000d727 [t/spec] tests for RT #75368 and new spec wrt autothreading over negated...
moritz authored
294 # used to be RT #75368
295 # L<S03/Junctive operators/Use of negative operators with junctions>
af86cfd @sorear Fudge and simplify S03-junctions/autothreading for Niecza
sorear authored
296 #?niecza skip 'broken'
000d727 [t/spec] tests for RT #75368 and new spec wrt autothreading over negated...
moritz authored
297 {
298 my Mu $x = 'a' ne ('a'|'b'|'c');
299 ok $x ~~ Bool, 'infix:<ne> collapses the junction (1)';
300 ok $x !~~ Junction, 'infix:<ne> collapses the junction (2)';
301 nok $x, '... and the result is False';
302
303 my Mu $y = 'a' !eq ('a'|'b'|'c');
304 ok $y ~~ Bool, 'infix:<!eq> collapses the junction (1)';
305 ok $y !~~ Junction, 'infix:<!eq> collapses the junction (2)';
306 nok $y, '... and the result is False';
307 }
308
8176a9b [t/spec] tests for RT #65096, autothreading over Array parameters
moritz authored
309 # vim: ft=perl6
Something went wrong with that request. Please try again.