Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 353 lines (262 sloc) 10.698 kb
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
1 use v6;
2
3 use Test;
4
310944af »
2009-03-20 test substr on junctions
5 plan 82;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
6
7 =begin pod
8
9 Misc. Junction tests
10
11 =end pod
12
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
13 # avoid auto-threading on ok()
14 sub jok(Object $condition, $msg?) { ok ?($condition), $msg };
15
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
16 # L<S03/Junctive operators>
17 # L<S09/Junctions>
18 {
19
20 # initalize them all to empty strings
21 my $a = '';
22 my $b = '';
23 my $c = '';
24
25 # make sure they all match to an empty string
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
26 jok('' eq ($a & $b & $c), 'junction of ($a & $b & $c) matches an empty string');
27 jok('' eq all($a, $b, $c), 'junction of all($a, $b, $c) matches an empty string');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
28
29 # give $a a value
30 $a = 'a';
31
32 # make sure that at least one of them matches 'a'
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
33 jok('a' eq ($b | $c | $a), 'junction of ($b | $c | $a) matches at least one "a"');
34 jok('a' eq any($b, $c, $a), 'junction of any($b, $c, $a) matches at least one "a"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
35
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
36 jok('' eq ($b | $c | $a), 'junction of ($b | $c | $a) matches at least one empty string');
37 jok('' eq any($b, $c, $a), 'junction of any($b, $c, $a) matches at least one empty string');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
38
39 # make sure that ~only~ one of them matches 'a'
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
40 jok('a' eq ($b ^ $c ^ $a), 'junction of ($b ^ $c ^ $a) matches at ~only~ one "a"');
41 jok('a' eq one($b, $c, $a), 'junction of one($b, $c, $a) matches at ~only~ one "a"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
42
43 # give $b a value
44 $b = 'a';
45
46 # now this will fail
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
47 jok('a' ne ($b ^ $c ^ $a), 'junction of ($b ^ $c ^ $a) matches at more than one "a"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
48
49 # change $b and give $c a value
50 $b = 'b';
51 $c = 'c';
52
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
53 jok('a' eq ($b ^ $c ^ $a), 'junction of ($b ^ $c ^ $a) matches at ~only~ one "a"');
54 jok('b' eq ($a ^ $b ^ $c), 'junction of ($a ^ $b ^ $c) matches at ~only~ one "b"');
55 jok('c' eq ($c ^ $a ^ $b), 'junction of ($c ^ $a ^ $b) matches at ~only~ one "c"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
56
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
57 jok('a' eq ($b | $c | $a), 'junction of ($b | $c | $a) matches at least one "a"');
58 jok('b' eq ($a | $b | $c), 'junction of ($a | $b | $c) matches at least one "b"');
59 jok('c' eq ($c | $a | $b), 'junction of ($c | $a | $b) matches at least one "c"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
60
61 ok(not(('a' eq ($b | $c | $a)) === Bool::False), 'junctional comparison doesn not mistakenly return both true and false');
62 ok(not(('b' eq ($a | $b | $c)) === Bool::False), 'junctional comparison doesn not mistakenly return both true and false');
63 ok(not(('c' eq ($c | $a | $b)) === Bool::False), 'junctional comparison doesn not mistakenly return both true and false');
64
65 # test junction to junction
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
66 jok(('a' | 'b' | 'c') eq ($a & $b & $c), 'junction ("a" | "b" | "c") matches junction ($a & $b & $c)');
67 jok(('a' & 'b' & 'c') eq ($a | $b | $c), 'junction ("a" & "b" & "c") matches junction ($a | $b | $c)');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
68
69 # mix around variables and literals
70
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
71 jok(($a & 'b' & 'c') eq ('a' | $b | $c), 'junction ($a & "b" & "c") matches junction ("a" | $b | $c)');
72 jok(($a & 'b' & $c) eq ('a' | $b | 'c'), 'junction ($a & "b" & $c) matches junction ("a" | $b | "c")');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
73
74 }
75
76 # same tests, but with junctions as variables
77 {
78 # initalize them all to empty strings
79 my $a = '';
80 my $b = '';
81 my $c = '';
82
83 my $all_of_them = $a & $b & $c;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
84 jok('' eq $all_of_them, 'junction variable of ($a & $b & $c) matches and empty string');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
85
86 $a = 'a';
87
88 my $any_of_them = $b | $c | $a;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
89 jok('a' eq $any_of_them, 'junction variable of ($b | $c | $a) matches at least one "a"');
90 jok('' eq $any_of_them, 'junction variable of ($b | $c | $a) matches at least one empty string');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
91
92 my $one_of_them = $b ^ $c ^ $a;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
93 jok('a' eq $one_of_them, 'junction variable of ($b ^ $c ^ $a) matches at ~only~ one "a"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
94
95 $b = 'a';
96
97 {
98 my $one_of_them = $b ^ $c ^ $a;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
99 jok('a' ne $one_of_them, 'junction variable of ($b ^ $c ^ $a) matches at more than one "a"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
100 }
101
102 $b = 'b';
103 $c = 'c';
104
105 {
106 my $one_of_them = $b ^ $c ^ $a;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
107 jok('a' eq $one_of_them, 'junction of ($b ^ $c ^ $a) matches at ~only~ one "a"');
108 jok('b' eq $one_of_them, 'junction of ($a ^ $b ^ $c) matches at ~only~ one "b"');
109 jok('c' eq $one_of_them, 'junction of ($c ^ $a ^ $b) matches at ~only~ one "c"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
110 }
111
112 {
113 my $any_of_them = $b | $c | $a;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
114 jok('a' eq $any_of_them, 'junction of ($b | $c | $a) matches at least one "a"');
115 jok('b' eq $any_of_them, 'junction of ($a | $b | $c) matches at least one "b"');
116 jok('c' eq $any_of_them, 'junction of ($c | $a | $b) matches at least one "c"');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
117 }
118
119 }
120
121 {
122 my $j = 1 | 2;
123 $j = 5;
124 is($j, 5, 'reassignment of junction variable');
125 }
126
127 {
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
128 my $j;
129 my $k;
130 my $l;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
131
132 $j = 1|2;
d511e2db »
2008-09-19 [spec] Explicitly stringify .WHAT result to avoid 'use uninitialised …
133 is(~WHAT($j),'Junction', 'basic junction type reference test');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
134
135 $k=$j;
d511e2db »
2008-09-19 [spec] Explicitly stringify .WHAT result to avoid 'use uninitialised …
136 is(~WHAT($k),'Junction', 'assignment preserves reference');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
137
138 # XXX does this next one make any sense?
139 $l=\$j;
d511e2db »
2008-09-19 [spec] Explicitly stringify .WHAT result to avoid 'use uninitialised …
140 is(~WHAT($l),'Junction', 'hard reference to junction');
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
141 }
142
143
144 =begin description
145
146 Tests junction examples from Synopsis 03
147
148 j() is used to convert a junction to canonical string form, currently
149 just using .perl until a better approach presents itself.
150
151 L<S03/Junctive operators>
152
153 =end description
154
155 # Canonical stringification of a junction
156 sub j (Junction $j) { return $j.perl }
157
158 {
159 # L<S03/Junctive operators/They thread through operations>
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
160 my $got;
161 my $want;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
162 $got = ((1|2|3)+4);
163 $want = (5|6|7);
164 is( j($got), j($want), 'thread + returning junctive result');
165
166 $got = ((1|2) + (3&4));
167 $want = ((4|5) & (5|6));
168 is( j($got), j($want), 'thread + returning junctive combination of results');
169
170 # L<S03/Junctive operators/This opens doors for constructions like>
171 # unless $roll == any(1..6) { print "Invalid roll" }
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
172 my $roll;
173 my $note;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
174 $roll = 3; $note = '';
175 unless $roll == any(1..6) { $note = "Invalid roll"; };
176 is($note, "", 'any() junction threading ==');
177
178 $roll = 7; $note = '';
179 unless $roll == any(1..6) { $note = "Invalid roll"; };
180 is($note, "Invalid roll", 'any() junction threading ==');
181
182 # if $roll == 1|2|3 { print "Low roll" }
183 $roll = 4; $note = '';
184 if $roll == 1|2|3 { $note = "Low roll" }
185 is($note, "", '| junction threading ==');
186
187 $roll = 2; $note = '';
188 if $roll == 1|2|3 { $note = "Low roll" }
189 is($note, "Low roll", '| junction threading ==');
d0da2231 »
2008-11-13 [spec]: Unfudge some junction tests for Rakudo.
190 }
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
191
d0da2231 »
2008-11-13 [spec]: Unfudge some junction tests for Rakudo.
192 #?rakudo skip 'Junctions as subscripts'
193 {
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
194 # L<S03/Junctive operators/Junctions work through subscripting>
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
195 my $got;
196 my @foo;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
197 $got = ''; @foo = ();
198 $got ~= 'y' if try { @foo[any(1,2,3)] };
199 is($got, '', "junctions work through subscripting, 0 matches");
200
201 $got = ''; @foo = (0,1);
202 $got ~= 'y' if try { @foo[any(1,2,3)] };
203 is($got, '', "junctions work through subscripting, 1 match");
204
205 $got = ''; @foo = (1,1,1);
206 $got ~= 'y' if try { @foo[any(1,2,3)] };
207 is($got, '', "junctions work through subscripting, 3 matches");
208
209
210 # L<S03/Junctive operators/Junctions are specifically unordered>
211 # Compiler *can* reorder and parallelize but *may not* so don't test
212 # for all(@foo) {...};
213
214 # Not sure what is expected
215 #my %got = ('1' => 1); # Hashes are unordered too
216 #@foo = (2,3,4);
217 #for all(@foo) { %got{$_} = 1; };
218 #is( %got.keys.sort.join(','), '1,2,3,4',
219 # 'for all(...) { ...} as parallelizable');
220 }
221
222 =begin description
223
224 These are implemented but still awaiting clarification on p6l.
225
226 L<S03/Junctive operators/They thread through operations>
227
228 On Fri, 2005-02-11 at 10:46 +1100, Damian Conway wrote:
229 > Subject: Re: Fwd: Junctive puzzles.
230 >
231 > Junctions have an associated boolean predicate that's preserved across
232 > operations on the junction. Junctions also implicitly distribute across
233 > operations, and rejunctify the results.
234
235 =end description
236
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
237 #?rakudo skip 'Junctions of Code Objects'
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
238 {
239 my @subs = (sub {3}, sub {2});
240
648ae66f »
2008-07-01 [spec] fudged S03-junctions/misc.t
241 my $got;
242 my $want;
82ba44c6 »
2008-07-01 [spec] started to move junction tests (and upate POD). Much more work…
243
244 is(j(any(@subs)()), j(3|2), '.() on any() junction of subs');
245
246 $want = (3&2);
247 $got = all(@subs)();
248 is(j($got), j($want), '.() on all() junction of subs');
249
250 $want = (3^2);
251 $got = one(@subs)();
252 is(j($got), j($want), '.() on one() junction of subs');
253
254 $want = none(3,2);
255 $got = none(@subs)();
256 is(j($got), j($want), '.() on none() junction of subs');
257
258 $want = one( any(3,2), all(3,2) );
259 $got = one( any(@subs), all(@subs) )();
260 is(j($got), j($want), '.() on complex junction of subs');
261
262 # Avoid future constant folding
263 #my $rand = rand;
264 #my $zero = int($rand-$rand);
265 #my @subs = (sub {3+$zero}, sub {2+$zero});
266 }
267
268 # Check functional and operator versions produce the same structure
269 {
270 is(j((1|2)^(3&4)), j(one(any(1,2),all(3,4))),
271 '((1|2)^(3&4)) equiv to one(any(1,2),all(3,4))');
272
273 is(j((1|2)&(3&4)), j(all(any(1,2),all(3,4))),
274 '((1|2)&(3&4)) equiv to all(any(1,2),all(3,4))');
275
276 is(j((1|2)|(3&4)), j(any(any(1,2),all(3,4))),
277 '((1|2)|(3&4)) equiv to any(any(1,2),all(3,4))');
278 }
279
280 # junction in boolean context
281 ok(?(0&0) == ?(0&&0), 'boolean context');
282 ok(?(0&1) == ?(0&&1), 'boolean context');
283 ok(?(1&1) == ?(1&&1), 'boolean context');
284 ok(?(1&0) == ?(1&&0), 'boolean context');
285 ok(!(?(0&0) != ?(0&&0)), 'boolean context');
286 ok(!(?(0&1) != ?(0&&1)), 'boolean context');
287 ok(!(?(1&1) != ?(1&&1)), 'boolean context');
288 ok(!(?(1&0) != ?(1&&0)), 'boolean context');
289
290
291 {
292 my $c = 0;
293 if 1 == 1 { $c++ }
294 is $c, 1;
295 if 1 == 1|2 { $c++ }
296 is $c, 2;
297 if 1 == 1|2|3 { $c++ }
298 is $c, 3;
299
300 $c++ if 1 == 1;
301 is $c, 4;
302 $c++ if 1 == 1|2;
303 is $c, 5, 'if modifier with junction should be called once';
304
305 $c = 0;
306 $c++ if 1 == 1|2|3;
307 is $c, 1, 'if modifier with junction should be called once';
308
309 $c = 0;
310 $c++ if 1 == any(1, 2, 3);
311 is $c, 1, 'if modifier with junction should be called once';
312 }
57e7ad80 »
2008-11-09 [t] move some junction tests
313
314 {
315 my @array = <1 2 3 4 5 6 7 8>;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
316 jok( all(@array) == one(@array), "all(@x) == one(@x) tests uniqueness(+ve)" );
57e7ad80 »
2008-11-09 [t] move some junction tests
317
318 push @array, 6;
e97f6d58 »
2009-01-19 [t/spec] avoid autohreading through ok()
319 jok( !( all(@array) == one(@array) ), "all(@x) == one(@x) tests uniqueness(-ve)" );
57e7ad80 »
2008-11-09 [t] move some junction tests
320
321 }
1c006225 »
2009-01-11 [t/spec] test for RT #60886
322
323 # used to be a rakudo regression (RT #60886)
324 ok ?(undef & undef ~~ undef), 'undef & undef ~~ undef works';
310944af »
2009-03-20 test substr on junctions
325
326
327 #?rakudo skip 'substr on juctions'
328 {
329 is substr("abcd", 1, 2), "bc", "simple substr";
330 my $res = substr(any("abcd", "efgh"), 1, 2);
331 is $res.WHAT, "Junction", "substr works on junctions";
332 is $res, "bc";
333 is $res, "fg";
334 }
335
336 #?rakudo skip 'substr on juctions'
337 {
338 my $res = substr("abcd", 1|2, 2);
339 is $res.WHAT, "Junction", "substr works on junctions";
340 is $res, "bc";
341 is $res, "cd";
342 }
343
344 #?rakudo skip 'substr on juctions'
345 {
346 my $res = substr("abcd", 1, 1|2);
347 is $res.WHAT, "Junction", "substr works on junctions";
348 is $res, "bc";
349 is $res, "b";
350 }
351
352
Something went wrong with that request. Please try again.