Permalink
Newer
Older
100644 483 lines (389 sloc) 9.94 KB
3
use MONKEY_TYPING;
4
5
use Test;
6
7
=begin description
8
9
Tests the "for" statement
10
11
This attempts to test as many variations of the
12
for statement as possible
13
14
=end description
15
17
18
## No foreach
19
# L<S04/The C<for> statement/"no foreach statement any more">
20
{
21
my $times_run = 0;
22
eval_dies_ok 'foreach 1..10 { $times_run++ }; 1', "foreach is gone";
23
eval_dies_ok 'foreach (1..10) { $times_run++}; 1',
24
"foreach is gone, even with parens";
25
is $times_run, 0, "foreach doesn't work";
26
}
27
28
## for with plain old range operator w/out parens
29
30
{
32
for 0 .. 5 { $a = $a ~ $_; };
33
is($a, '012345', 'for 0..5 {} works');
34
}
35
36
# ... with pointy blocks
37
38
{
40
for 0 .. 5 -> $_ { $b = $b ~ $_; };
41
is($b, '012345', 'for 0 .. 5 -> {} works');
42
}
43
44
#?pugs eval 'todo: slice context'
45
#?rakudo skip 'slice context'
46
{
47
my $str;
48
my @a = 1..3;
49
my @b = 5..6;
50
for zip(@a; @b) -> $x, $y {
51
$str ~= "($x $y)";
52
}
53
is $str, "(1 5)(2 4)(3 6)", 'for zip(@a; @b) -> $x, $y works';
54
}
55
56
# ... with referential sub
57
#?rakudo skip 'class accessing outer lexical'
Dec 25, 2008
59
my $d = '';
60
augment class Int {
61
method some_meth_1 {
62
$d = $d ~ self
63
}
64
};
65
for 0 .. 5 { .some_meth_1 };
66
is($d, '012345', 'for 0 .. 5 { .some_sub } works');
67
}
68
69
## and now with parens around the range operator
70
{
72
for (0 .. 5) { $e = $e ~ $_; };
73
is($e, '012345', 'for () {} works');
74
}
75
76
# ... with pointy blocks
77
{
79
for (0 .. 5) -> $_ { $f = $f ~ $_; };
80
is($f, '012345', 'for () -> {} works');
81
}
82
83
# ... with implicit topic
84
85
{
86
$_ = "GLOBAL VALUE";
87
for "INNER VALUE" {
88
is( .lc, "inner value", "Implicit default topic is seen by lc()");
89
};
90
is($_,"GLOBAL VALUE","After the loop the implicit topic gets restored");
94
# as statement modifier
95
$_ = "GLOBAL VALUE";
96
is( .lc, "inner value", "Implicit default topic is seen by lc()" )
97
for "INNER VALUE";
98
is($_,"GLOBAL VALUE","After the loop the implicit topic gets restored");
99
}
100
101
## and now for with 'topical' variables
102
103
# ... w/out parens
104
106
for 0 .. 5 -> $topic { $i = $i ~ $topic; };
107
is($i, '012345', 'for 0 .. 5 -> $topic {} works');
108
109
# ... with parens
110
112
for (0 .. 5) -> $topic { $j = $j ~ $topic; };
113
is($j, '012345', 'for () -> $topic {} works');
114
115
116
## for with @array operator w/out parens
117
118
my @array_k = (0 .. 5);
120
for @array_k { $k = $k ~ $_; };
121
is($k, '012345', 'for @array {} works');
122
123
# ... with pointy blocks
124
125
my @array_l = (0 .. 5);
127
for @array_l -> $_ { $l = $l ~ $_; };
128
is($l, '012345', 'for @array -> {} works');
129
130
## and now with parens around the @array
131
132
my @array_o = (0 .. 5);
134
for (@array_o) { $o = $o ~ $_; };
135
is($o, '012345', 'for (@array) {} works');
136
137
# ... with pointy blocks
138
{
139
my @array_p = (0 .. 5);
141
for (@array_p) -> $_ { $p = $p ~ $_; };
142
is($p, '012345', 'for (@array) -> {} works');
143
}
144
145
my @elems = <a b c d e>;
146
147
{
148
my @a;
149
for (@elems) {
150
push @a, $_;
151
}
152
my @e = <a b c d e>;
153
is(@a, @e, 'for (@a) { ... $_ ... } iterates all elems');
154
}
155
156
{
157
my @a;
158
for (@elems) -> $_ { push @a, $_ };
159
my @e = @elems;
160
is(@a, @e, 'for (@a)->$_ { ... $_ ... } iterates all elems' );
161
}
162
163
{
164
my @a;
165
for (@elems) { push @a, $_, $_; }
166
my @e = <a a b b c c d d e e>;
167
is(@a, @e, 'for (@a) { ... $_ ... $_ ... } iterates all elems, not just odd');
168
}
169
170
# "for @a -> $var" is ro by default.
171
#?rakudo skip "<-> is confusing the parser, I think"
172
{
173
my @a = <1 2 3 4>;
174
175
eval_dies_ok('for @a -> $elem {$elem = 5}', '-> $var is ro by default');
176
177
for @a <-> $elem {$elem++;}
178
is(@a, <2 3 4 5>, '<-> $var is rw');
179
180
for @a <-> $first, $second {$first++; $second++}
181
is(@a, <3 4 5 6>, '<-> $var, $var2 works');
182
}
183
184
# for with "is rw"
185
{
186
my @array_s = (0..2);
187
my @s = (1..3);
188
for @array_s { $_++ };
189
is(@array_s, @s, 'for @array { $_++ }');
190
}
191
192
{
193
my @array = <a b c d>;
194
for @array { $_ ~= "c" }
195
is ~@array, "ac bc cc dc",
196
'mutating $_ in for works';
197
}
198
199
{
200
my @array_t = (0..2);
201
my @t = (1..3);
202
for @array_t -> $val is rw { $val++ };
203
is(@array_t, @t, 'for @array -> $val is rw { $val++ }');
204
}
205
206
#?pugs eval 'todo'
208
{
209
my @array_v = (0..2);
210
my @v = (1..3);
211
for @array_v.values -> $val is rw { $val++ };
Jul 24, 2008
212
is(@array_v, @v, 'for @array.values -> $val is rw { $val++ }');
213
}
214
215
#?pugs eval 'todo'
217
{
218
my @array_kv = (0..2);
219
my @kv = (1..3);
220
for @array_kv.kv -> $key, $val is rw { $val++ };
221
is(@array_kv, @kv, 'for @array.kv -> $key, $val is rw { $val++ }');
222
}
223
224
#?pugs eval 'todo'
226
{
227
my %hash_v = ( a => 1, b => 2, c => 3 );
228
my %v = ( a => 2, b => 3, c => 4 );
229
for %hash_v.values -> $val is rw { $val++ };
230
is(%hash_v, %v, 'for %hash.values -> $val is rw { $val++ }');
231
}
232
233
#?pugs eval 'todo'
235
{
236
my %hash_kv = ( a => 1, b => 2, c => 3 );
237
my %kv = ( a => 2, b => 3, c => 4 );
238
try { for %hash_kv.kv -> $key, $val is rw { $val++ }; };
239
is( %hash_kv, %kv, 'for %hash.kv -> $key, $val is rw { $val++ }');
240
}
241
242
# .key //= ++$i for @array1;
Mar 29, 2009
243
class TestClass{ has $.key is rw };
244
Mar 29, 2009
247
my @array1 = (TestClass.new(:key<1>),TestClass.new());
248
249
my $i = 0;
Mar 29, 2009
250
my $sum1 = [+] @array1.map: { $_.key };
251
#?pugs todo 'bug'
252
is( $sum1, 2, '.key //= ++$i for @array1;' );
253
254
}
255
256
# .key = 1 for @array1;
258
{
259
my @array1 = (TestClass.new(),TestClass.new(:key<2>));
260
Mar 29, 2009
261
.key = 1 for @array1;
262
my $sum1 = [+] @array1.map: { $_.key };
263
is($sum1, 2, '.key = 1 for @array1;');
264
}
265
266
# $_.key = 1 for @array1;
268
{
269
my @array1 = (TestClass.new(),TestClass.new(:key<2>));
270
271
$_.key = 1 for @array1;
Mar 29, 2009
272
my $sum1 = [+] @array1.map: { $_.key };
273
is( $sum1, 2, '$_.key = 1 for @array1;');
274
275
}
276
277
# rw scalars
278
#L<S04/The C<for> statement/implicit parameter to block read/write "by default">
279
{
280
my ($a, $b, $c) = 0..2;
281
try { for ($a, $b, $c) { $_++ } };
282
is( [$a,$b,$c], [1,2,3], 'for ($a,$b,$c) { $_++ }');
283
284
($a, $b, $c) = 0..2;
285
try { for ($a, $b, $c) -> $x is rw { $x++ } };
286
is( [$a,$b,$c], [1,2,3], 'for ($a,$b,$c) -> $x is rw { $x++ }');
287
}
288
289
# list context
290
291
{
293
for 1..3, 4..6 { $a ~= $_.WHAT };
294
is($a, 'Int()Int()Int()Int()Int()Int()', 'List context');
295
296
$a = '';
297
for [1..3, 4..6] { $a ~= $_.WHAT };
298
is($a, 'Array()', 'List context');
299
300
$a = '';
301
for [1..3], [4..6] { $a ~= $_.WHAT };
302
is($a, 'Array()Array()', 'List context');
304
305
{
306
# this was a rakudo bug with mixed 'for' and recursion, which seems to
307
# confuse some lexical pads or the like, see RT #58392
308
my $gather = '';
309
sub f($l) {
310
if $l <= 0 {
311
return $l;
312
}
313
$gather ~= $l;
314
for 1..3 {
315
f($l-1);
316
$gather ~= '.';
317
}
318
}
319
f(2);
320
321
is $gather, '21....1....1....', 'Can mix recursion and for';
322
}
323
324
# grep and sort in for - these were pugs bugs once, so let's
325
# keep them as regression tests
326
327
{
328
my @array = <1 2 3 4>;
329
my $output = '';
330
331
for (grep { 1 }, @array) -> $elem {
332
$output ~= "$elem,";
333
}
334
335
is $output, "1,2,3,4,", "grep works in for";
336
}
337
338
{
339
my @array = <1 2 3 4>;
340
my $output = '';
341
346
is $output, "1,2,3,4,", "sort works in for";
347
}
348
349
{
350
my @array = <1 2 3 4>;
353
for (grep { 1 }, @array.sort) -> $elem {
354
$output ~= "$elem,";
355
}
356
357
is $output, "1,2,3,4,", "grep and sort work in for";
358
}
359
360
# L<S04/Statement parsing/keywords require whitespace>
361
#?rakudo todo "for(0..5) should die because there is no space after the for"
362
eval_dies_ok('for(0..5) { }','keyword needs at least one whitespace after it');
363
364
# looping with more than one loop variables
365
{
366
my @a = <1 2 3 4>;
367
my $str = '';
368
for @a -> $x, $y {
369
$str ~= $x+$y;
370
}
371
is $str, "37", "for loop with two variables";
372
}
373
Mar 20, 2009
374
{
375
#my $str = '';
376
eval_dies_ok('for 1..5 -> $x, $y { $str ~= "$x$y" }', 'Should throw exception StopIteration');
377
#is $str, "1234", "loop ran before throwing exception";
378
#diag ">$str<";
379
}
380
381
#?rakudo skip 'optional variable in for loop (RT #63994)'
Mar 20, 2009
382
{
383
my $str = '';
384
for 1..5 -> $x, $y? {
385
$str ~= " " ~ $x*$y;
386
}
387
is $str, " 2 12 0";
388
}
389
390
{
391
my $str = '';
392
for 1..5 -> $x, $y = 7 {
393
$str ~= " " ~ $x*$y;
394
}
395
is $str, " 2 12 35", 'default values in for-loops';
396
}
397
398
Mar 20, 2009
399
{
400
my @a = <1 2 3>;
401
my @b = <4 5 6>;
402
my $res = '';
403
for @a Z @b -> $x, $y {
404
$res ~= " " ~ $x * $y;
405
}
406
is $res, " 4 10 18", "Z -ed for loop";
407
}
408
409
#?rakudo skip "Z only works with 2 arrays at the moment"
Mar 20, 2009
410
{
411
my @a = <1 2 3>;
412
my $str = '';
413
414
for @a Z @a Z @a Z @a Z @a -> $q, $w, $e, $r, $t {
415
$str ~= " " ~ $q*$w*$e*$r*$t;
416
}
417
is $str, " 1 {2**5} {3**5}", "Z-ed for loop with 5 arrays";
418
}
Mar 20, 2009
419
420
{
421
eval_dies_ok 'for 1.. { };', "Please use ..* for indefinite range";
422
eval_dies_ok 'for 1... { };', "1... does not exist";
423
}
424
425
{
426
my $c;
427
for 1..8 {
428
$c = $_;
429
last if $_ == 6;
430
}
431
is $c, 6, 'for loop ends in time using last';
432
}
433
Mar 29, 2009
434
#?rakudo skip 'lazy lists (loops)'
435
{
436
my $c;
437
for 1..* {
438
$c = $_;
439
last if $_ == 6;
440
}
441
is $c, 6, 'infinte for loop ends in time using last';
442
}
443
Mar 29, 2009
444
#?rakudo skip 'lazy lists (loops)'
445
{
446
my $c;
447
for 1..Inf {
448
$c = $_;
449
last if $_ == 6;
450
}
451
is $c, 6, 'infinte for loop ends in time using last';
452
}
453
454
# RT #62478
455
{
456
eval('for (my $ii = 1; $ii <= 3; $ii++) { say $ii; }');
457
ok "$!" ~~ /C\-style/, 'mentions C-style';
458
ok "$!" ~~ /for/, 'mentions for';
459
ok "$!" ~~ /loop/, 'mentions loop';
460
}
461
462
# RT #65212
463
{
464
my $parsed = 0;
465
eval '$parsed = 1; for (1..3)->$n { last }';
466
#?rakudo todo 'RT #65212'
467
ok ! $parsed, 'for (1..3)->$n fails to parse';
468
}
Mar 20, 2009
469
470
# RT #71268
471
{
472
sub rt71268 { for ^1 {} }
473
#?rakudo todo 'RT 71268'
474
lives_ok { ~(rt71268) }, 'can stringify "for ^1 {}" without death';
475
#?rakudo skip 'RT 71268'
476
ok rt71268() ~~ Nil, 'result of "for ^1 {}" is Nil (what else?)';
477
}
478
479
480
done_testing;
481
482
# vim: ft=perl6