Commit | Line | Data |
---|---|---|
36c66720 RH |
1 | #!./perl |
2 | ||
3 | # We have the following types of loop: | |
4 | # | |
5 | # 1a) while(A) {B} | |
6 | # 1b) B while A; | |
7 | # | |
8 | # 2a) until(A) {B} | |
9 | # 2b) B until A; | |
10 | # | |
11 | # 3a) for(@A) {B} | |
12 | # 3b) B for A; | |
13 | # | |
14 | # 4a) for (A;B;C) {D} | |
15 | # | |
16 | # 5a) { A } # a bare block is a loop which runs once | |
17 | # | |
18 | # Loops of type (b) don't allow for next/last/redo style | |
19 | # control, so we ignore them here. Type (a) loops can | |
20 | # all be labelled, so there are ten possibilities (each | |
21 | # of 5 types, labelled/unlabelled). We therefore need | |
22 | # thirty tests to try the three control statements against | |
23 | # the ten types of loop. For the first four types it's useful | |
24 | # to distinguish the case where next re-iterates from the case | |
25 | # where it leaves the loop. That makes 38. | |
26 | # All these tests rely on "last LABEL" | |
27 | # so if they've *all* failed, maybe you broke that... | |
28 | # | |
29 | # These tests are followed by an extra test of nested loops. | |
30 | # Feel free to add more here. | |
31 | # | |
32 | # -- .robin. <robin@kitsite.com> 2001-03-13 | |
de29acd5 DL |
33 | BEGIN { |
34 | chdir 't' if -d 't'; | |
1ae3d757 | 35 | require "./test.pl"; |
624c42e2 | 36 | set_up_inc(qw(. ../lib)); |
de29acd5 | 37 | } |
36c66720 | 38 | |
0c0c317c | 39 | plan( tests => 67 ); |
36c66720 RH |
40 | |
41 | my $ok; | |
42 | ||
de29acd5 | 43 | TEST1: { |
36c66720 RH |
44 | |
45 | $ok = 0; | |
46 | ||
47 | my $x = 1; | |
48 | my $first_time = 1; | |
49 | while($x--) { | |
50 | if (!$first_time) { | |
51 | $ok = 1; | |
52 | last TEST1; | |
53 | } | |
54 | $ok = 0; | |
55 | $first_time = 0; | |
56 | redo; | |
57 | last TEST1; | |
58 | } | |
59 | continue { | |
60 | $ok = 0; | |
61 | last TEST1; | |
62 | } | |
63 | $ok = 0; | |
64 | } | |
de29acd5 | 65 | cmp_ok($ok,'==',1,'no label on while()'); |
36c66720 | 66 | |
de29acd5 | 67 | TEST2: { |
36c66720 RH |
68 | |
69 | $ok = 0; | |
70 | ||
71 | my $x = 2; | |
72 | my $first_time = 1; | |
73 | my $been_in_continue = 0; | |
74 | while($x--) { | |
75 | if (!$first_time) { | |
76 | $ok = $been_in_continue; | |
77 | last TEST2; | |
78 | } | |
79 | $ok = 0; | |
80 | $first_time = 0; | |
81 | next; | |
82 | last TEST2; | |
83 | } | |
84 | continue { | |
85 | $been_in_continue = 1; | |
86 | } | |
87 | $ok = 0; | |
88 | } | |
de29acd5 | 89 | cmp_ok($ok,'==',1,'no label on while() successful next'); |
36c66720 | 90 | |
de29acd5 | 91 | TEST3: { |
36c66720 RH |
92 | |
93 | $ok = 0; | |
94 | ||
95 | my $x = 1; | |
96 | my $first_time = 1; | |
97 | my $been_in_loop = 0; | |
98 | my $been_in_continue = 0; | |
99 | while($x--) { | |
100 | $been_in_loop = 1; | |
101 | if (!$first_time) { | |
102 | $ok = 0; | |
103 | last TEST3; | |
104 | } | |
105 | $ok = 0; | |
106 | $first_time = 0; | |
107 | next; | |
108 | last TEST3; | |
109 | } | |
110 | continue { | |
111 | $been_in_continue = 1; | |
112 | } | |
113 | $ok = $been_in_loop && $been_in_continue; | |
114 | } | |
de29acd5 | 115 | cmp_ok($ok,'==',1,'no label on while() unsuccessful next'); |
36c66720 | 116 | |
de29acd5 | 117 | TEST4: { |
36c66720 RH |
118 | |
119 | $ok = 0; | |
120 | ||
121 | my $x = 1; | |
122 | my $first_time = 1; | |
123 | while($x++) { | |
124 | if (!$first_time) { | |
125 | $ok = 0; | |
126 | last TEST4; | |
127 | } | |
128 | $ok = 0; | |
129 | $first_time = 0; | |
130 | last; | |
131 | last TEST4; | |
132 | } | |
133 | continue { | |
134 | $ok = 0; | |
135 | last TEST4; | |
136 | } | |
137 | $ok = 1; | |
138 | } | |
de29acd5 | 139 | cmp_ok($ok,'==',1,'no label on while() last'); |
36c66720 | 140 | |
de29acd5 | 141 | TEST5: { |
36c66720 RH |
142 | |
143 | $ok = 0; | |
144 | ||
145 | my $x = 0; | |
146 | my $first_time = 1; | |
147 | until($x++) { | |
148 | if (!$first_time) { | |
149 | $ok = 1; | |
150 | last TEST5; | |
151 | } | |
152 | $ok = 0; | |
153 | $first_time = 0; | |
154 | redo; | |
155 | last TEST5; | |
156 | } | |
157 | continue { | |
158 | $ok = 0; | |
159 | last TEST5; | |
160 | } | |
161 | $ok = 0; | |
162 | } | |
de29acd5 | 163 | cmp_ok($ok,'==',1,'no label on until()'); |
36c66720 | 164 | |
de29acd5 | 165 | TEST6: { |
36c66720 RH |
166 | |
167 | $ok = 0; | |
168 | ||
169 | my $x = 0; | |
170 | my $first_time = 1; | |
171 | my $been_in_continue = 0; | |
172 | until($x++ >= 2) { | |
173 | if (!$first_time) { | |
174 | $ok = $been_in_continue; | |
175 | last TEST6; | |
176 | } | |
177 | $ok = 0; | |
178 | $first_time = 0; | |
179 | next; | |
180 | last TEST6; | |
181 | } | |
182 | continue { | |
183 | $been_in_continue = 1; | |
184 | } | |
185 | $ok = 0; | |
186 | } | |
de29acd5 | 187 | cmp_ok($ok,'==',1,'no label on until() successful next'); |
36c66720 | 188 | |
de29acd5 | 189 | TEST7: { |
36c66720 RH |
190 | |
191 | $ok = 0; | |
192 | ||
193 | my $x = 0; | |
194 | my $first_time = 1; | |
195 | my $been_in_loop = 0; | |
196 | my $been_in_continue = 0; | |
197 | until($x++) { | |
198 | $been_in_loop = 1; | |
199 | if (!$first_time) { | |
200 | $ok = 0; | |
201 | last TEST7; | |
202 | } | |
203 | $ok = 0; | |
204 | $first_time = 0; | |
205 | next; | |
206 | last TEST7; | |
207 | } | |
208 | continue { | |
209 | $been_in_continue = 1; | |
210 | } | |
211 | $ok = $been_in_loop && $been_in_continue; | |
212 | } | |
de29acd5 | 213 | cmp_ok($ok,'==',1,'no label on until() unsuccessful next'); |
36c66720 | 214 | |
de29acd5 | 215 | TEST8: { |
36c66720 RH |
216 | |
217 | $ok = 0; | |
218 | ||
219 | my $x = 0; | |
220 | my $first_time = 1; | |
221 | until($x++ == 10) { | |
222 | if (!$first_time) { | |
223 | $ok = 0; | |
224 | last TEST8; | |
225 | } | |
226 | $ok = 0; | |
227 | $first_time = 0; | |
228 | last; | |
229 | last TEST8; | |
230 | } | |
231 | continue { | |
232 | $ok = 0; | |
233 | last TEST8; | |
234 | } | |
235 | $ok = 1; | |
236 | } | |
de29acd5 | 237 | cmp_ok($ok,'==',1,'no label on until() last'); |
36c66720 | 238 | |
de29acd5 | 239 | TEST9: { |
36c66720 RH |
240 | |
241 | $ok = 0; | |
242 | ||
243 | my $first_time = 1; | |
244 | for(1) { | |
245 | if (!$first_time) { | |
246 | $ok = 1; | |
247 | last TEST9; | |
248 | } | |
249 | $ok = 0; | |
250 | $first_time = 0; | |
251 | redo; | |
252 | last TEST9; | |
253 | } | |
254 | continue { | |
255 | $ok = 0; | |
256 | last TEST9; | |
257 | } | |
258 | $ok = 0; | |
259 | } | |
de29acd5 | 260 | cmp_ok($ok,'==',1,'no label on for(@array)'); |
36c66720 | 261 | |
de29acd5 | 262 | TEST10: { |
36c66720 RH |
263 | |
264 | $ok = 0; | |
265 | ||
266 | my $first_time = 1; | |
267 | my $been_in_continue = 0; | |
268 | for(1,2) { | |
269 | if (!$first_time) { | |
270 | $ok = $been_in_continue; | |
271 | last TEST10; | |
272 | } | |
273 | $ok = 0; | |
274 | $first_time = 0; | |
275 | next; | |
276 | last TEST10; | |
277 | } | |
278 | continue { | |
279 | $been_in_continue = 1; | |
280 | } | |
281 | $ok = 0; | |
282 | } | |
de29acd5 | 283 | cmp_ok($ok,'==',1,'no label on for(@array) successful next'); |
36c66720 | 284 | |
de29acd5 | 285 | TEST11: { |
36c66720 RH |
286 | |
287 | $ok = 0; | |
288 | ||
289 | my $first_time = 1; | |
290 | my $been_in_loop = 0; | |
291 | my $been_in_continue = 0; | |
292 | for(1) { | |
293 | $been_in_loop = 1; | |
294 | if (!$first_time) { | |
295 | $ok = 0; | |
296 | last TEST11; | |
297 | } | |
298 | $ok = 0; | |
299 | $first_time = 0; | |
300 | next; | |
301 | last TEST11; | |
302 | } | |
303 | continue { | |
304 | $been_in_continue = 1; | |
305 | } | |
306 | $ok = $been_in_loop && $been_in_continue; | |
307 | } | |
de29acd5 | 308 | cmp_ok($ok,'==',1,'no label on for(@array) unsuccessful next'); |
36c66720 | 309 | |
de29acd5 | 310 | TEST12: { |
36c66720 RH |
311 | |
312 | $ok = 0; | |
313 | ||
314 | my $first_time = 1; | |
315 | for(1..10) { | |
316 | if (!$first_time) { | |
317 | $ok = 0; | |
318 | last TEST12; | |
319 | } | |
320 | $ok = 0; | |
321 | $first_time = 0; | |
322 | last; | |
323 | last TEST12; | |
324 | } | |
325 | continue { | |
326 | $ok=0; | |
327 | last TEST12; | |
328 | } | |
329 | $ok = 1; | |
330 | } | |
de29acd5 | 331 | cmp_ok($ok,'==',1,'no label on for(@array) last'); |
36c66720 | 332 | |
de29acd5 | 333 | TEST13: { |
36c66720 RH |
334 | |
335 | $ok = 0; | |
336 | ||
337 | for(my $first_time = 1; 1;) { | |
338 | if (!$first_time) { | |
339 | $ok = 1; | |
340 | last TEST13; | |
341 | } | |
342 | $ok = 0; | |
343 | $first_time=0; | |
344 | ||
345 | redo; | |
346 | last TEST13; | |
347 | } | |
348 | $ok = 0; | |
349 | } | |
de29acd5 | 350 | cmp_ok($ok,'==',1,'no label on for(;;)'); |
36c66720 | 351 | |
de29acd5 | 352 | TEST14: { |
36c66720 RH |
353 | |
354 | $ok = 0; | |
355 | ||
356 | for(my $first_time = 1; 1; $first_time=0) { | |
357 | if (!$first_time) { | |
358 | $ok = 1; | |
359 | last TEST14; | |
360 | } | |
361 | $ok = 0; | |
362 | next; | |
363 | last TEST14; | |
364 | } | |
365 | $ok = 0; | |
366 | } | |
de29acd5 | 367 | cmp_ok($ok,'==',1,'no label on for(;;) successful next'); |
36c66720 | 368 | |
de29acd5 | 369 | TEST15: { |
36c66720 RH |
370 | |
371 | $ok = 0; | |
372 | ||
373 | my $x=1; | |
374 | my $been_in_loop = 0; | |
375 | for(my $first_time = 1; $x--;) { | |
376 | $been_in_loop = 1; | |
377 | if (!$first_time) { | |
378 | $ok = 0; | |
379 | last TEST15; | |
380 | } | |
381 | $ok = 0; | |
382 | $first_time = 0; | |
383 | next; | |
384 | last TEST15; | |
385 | } | |
386 | $ok = $been_in_loop; | |
387 | } | |
de29acd5 | 388 | cmp_ok($ok,'==',1,'no label on for(;;) unsuccessful next'); |
36c66720 | 389 | |
de29acd5 | 390 | TEST16: { |
36c66720 RH |
391 | |
392 | $ok = 0; | |
393 | ||
394 | for(my $first_time = 1; 1; last TEST16) { | |
395 | if (!$first_time) { | |
396 | $ok = 0; | |
397 | last TEST16; | |
398 | } | |
399 | $ok = 0; | |
400 | $first_time = 0; | |
401 | last; | |
402 | last TEST16; | |
403 | } | |
404 | $ok = 1; | |
405 | } | |
de29acd5 | 406 | cmp_ok($ok,'==',1,'no label on for(;;) last'); |
36c66720 | 407 | |
de29acd5 | 408 | TEST17: { |
36c66720 RH |
409 | |
410 | $ok = 0; | |
411 | my $first_time = 1; | |
412 | ||
413 | { | |
414 | if (!$first_time) { | |
415 | $ok = 1; | |
416 | last TEST17; | |
417 | } | |
418 | $ok = 0; | |
419 | $first_time=0; | |
420 | ||
421 | redo; | |
422 | last TEST17; | |
423 | } | |
424 | continue { | |
425 | $ok = 0; | |
426 | last TEST17; | |
427 | } | |
428 | $ok = 0; | |
429 | } | |
de29acd5 | 430 | cmp_ok($ok,'==',1,'no label on bare block'); |
36c66720 | 431 | |
de29acd5 | 432 | TEST18: { |
36c66720 RH |
433 | |
434 | $ok = 0; | |
435 | { | |
436 | next; | |
437 | last TEST18; | |
438 | } | |
439 | continue { | |
440 | $ok = 1; | |
441 | last TEST18; | |
442 | } | |
443 | $ok = 0; | |
444 | } | |
de29acd5 | 445 | cmp_ok($ok,'==',1,'no label on bare block next'); |
36c66720 | 446 | |
de29acd5 | 447 | TEST19: { |
36c66720 RH |
448 | |
449 | $ok = 0; | |
450 | { | |
451 | last; | |
452 | last TEST19; | |
453 | } | |
454 | continue { | |
455 | $ok = 0; | |
456 | last TEST19; | |
457 | } | |
458 | $ok = 1; | |
459 | } | |
de29acd5 | 460 | cmp_ok($ok,'==',1,'no label on bare block last'); |
36c66720 RH |
461 | |
462 | ### Now do it all again with labels | |
463 | ||
de29acd5 | 464 | TEST20: { |
36c66720 RH |
465 | |
466 | $ok = 0; | |
467 | ||
468 | my $x = 1; | |
469 | my $first_time = 1; | |
470 | LABEL20: while($x--) { | |
471 | if (!$first_time) { | |
472 | $ok = 1; | |
473 | last TEST20; | |
474 | } | |
475 | $ok = 0; | |
476 | $first_time = 0; | |
477 | redo LABEL20; | |
478 | last TEST20; | |
479 | } | |
480 | continue { | |
481 | $ok = 0; | |
482 | last TEST20; | |
483 | } | |
484 | $ok = 0; | |
485 | } | |
de29acd5 | 486 | cmp_ok($ok,'==',1,'label on while()'); |
36c66720 | 487 | |
de29acd5 | 488 | TEST21: { |
36c66720 RH |
489 | |
490 | $ok = 0; | |
491 | ||
492 | my $x = 2; | |
493 | my $first_time = 1; | |
494 | my $been_in_continue = 0; | |
495 | LABEL21: while($x--) { | |
496 | if (!$first_time) { | |
497 | $ok = $been_in_continue; | |
498 | last TEST21; | |
499 | } | |
500 | $ok = 0; | |
501 | $first_time = 0; | |
502 | next LABEL21; | |
503 | last TEST21; | |
504 | } | |
505 | continue { | |
506 | $been_in_continue = 1; | |
507 | } | |
508 | $ok = 0; | |
509 | } | |
de29acd5 | 510 | cmp_ok($ok,'==',1,'label on while() successful next'); |
36c66720 | 511 | |
de29acd5 | 512 | TEST22: { |
36c66720 RH |
513 | |
514 | $ok = 0; | |
515 | ||
516 | my $x = 1; | |
517 | my $first_time = 1; | |
518 | my $been_in_loop = 0; | |
519 | my $been_in_continue = 0; | |
520 | LABEL22: while($x--) { | |
521 | $been_in_loop = 1; | |
522 | if (!$first_time) { | |
523 | $ok = 0; | |
524 | last TEST22; | |
525 | } | |
526 | $ok = 0; | |
527 | $first_time = 0; | |
528 | next LABEL22; | |
529 | last TEST22; | |
530 | } | |
531 | continue { | |
532 | $been_in_continue = 1; | |
533 | } | |
534 | $ok = $been_in_loop && $been_in_continue; | |
535 | } | |
de29acd5 | 536 | cmp_ok($ok,'==',1,'label on while() unsuccessful next'); |
36c66720 | 537 | |
de29acd5 | 538 | TEST23: { |
36c66720 RH |
539 | |
540 | $ok = 0; | |
541 | ||
542 | my $x = 1; | |
543 | my $first_time = 1; | |
544 | LABEL23: while($x++) { | |
545 | if (!$first_time) { | |
546 | $ok = 0; | |
547 | last TEST23; | |
548 | } | |
549 | $ok = 0; | |
550 | $first_time = 0; | |
551 | last LABEL23; | |
552 | last TEST23; | |
553 | } | |
554 | continue { | |
555 | $ok = 0; | |
556 | last TEST23; | |
557 | } | |
558 | $ok = 1; | |
559 | } | |
de29acd5 | 560 | cmp_ok($ok,'==',1,'label on while() last'); |
36c66720 | 561 | |
de29acd5 | 562 | TEST24: { |
36c66720 RH |
563 | |
564 | $ok = 0; | |
565 | ||
566 | my $x = 0; | |
567 | my $first_time = 1; | |
568 | LABEL24: until($x++) { | |
569 | if (!$first_time) { | |
570 | $ok = 1; | |
571 | last TEST24; | |
572 | } | |
573 | $ok = 0; | |
574 | $first_time = 0; | |
575 | redo LABEL24; | |
576 | last TEST24; | |
577 | } | |
578 | continue { | |
579 | $ok = 0; | |
580 | last TEST24; | |
581 | } | |
582 | $ok = 0; | |
583 | } | |
de29acd5 | 584 | cmp_ok($ok,'==',1,'label on until()'); |
36c66720 | 585 | |
de29acd5 | 586 | TEST25: { |
36c66720 RH |
587 | |
588 | $ok = 0; | |
589 | ||
590 | my $x = 0; | |
591 | my $first_time = 1; | |
592 | my $been_in_continue = 0; | |
593 | LABEL25: until($x++ >= 2) { | |
594 | if (!$first_time) { | |
595 | $ok = $been_in_continue; | |
596 | last TEST25; | |
597 | } | |
598 | $ok = 0; | |
599 | $first_time = 0; | |
600 | next LABEL25; | |
601 | last TEST25; | |
602 | } | |
603 | continue { | |
604 | $been_in_continue = 1; | |
605 | } | |
606 | $ok = 0; | |
607 | } | |
de29acd5 | 608 | cmp_ok($ok,'==',1,'label on until() successful next'); |
36c66720 | 609 | |
de29acd5 | 610 | TEST26: { |
36c66720 RH |
611 | |
612 | $ok = 0; | |
613 | ||
614 | my $x = 0; | |
615 | my $first_time = 1; | |
616 | my $been_in_loop = 0; | |
617 | my $been_in_continue = 0; | |
618 | LABEL26: until($x++) { | |
619 | $been_in_loop = 1; | |
620 | if (!$first_time) { | |
621 | $ok = 0; | |
622 | last TEST26; | |
623 | } | |
624 | $ok = 0; | |
625 | $first_time = 0; | |
626 | next LABEL26; | |
627 | last TEST26; | |
628 | } | |
629 | continue { | |
630 | $been_in_continue = 1; | |
631 | } | |
632 | $ok = $been_in_loop && $been_in_continue; | |
633 | } | |
de29acd5 | 634 | cmp_ok($ok,'==',1,'label on until() unsuccessful next'); |
36c66720 | 635 | |
de29acd5 | 636 | TEST27: { |
36c66720 RH |
637 | |
638 | $ok = 0; | |
639 | ||
640 | my $x = 0; | |
641 | my $first_time = 1; | |
642 | LABEL27: until($x++ == 10) { | |
643 | if (!$first_time) { | |
644 | $ok = 0; | |
645 | last TEST27; | |
646 | } | |
647 | $ok = 0; | |
648 | $first_time = 0; | |
649 | last LABEL27; | |
650 | last TEST27; | |
651 | } | |
652 | continue { | |
653 | $ok = 0; | |
654 | last TEST8; | |
655 | } | |
656 | $ok = 1; | |
657 | } | |
de29acd5 | 658 | cmp_ok($ok,'==',1,'label on until() last'); |
36c66720 | 659 | |
de29acd5 | 660 | TEST28: { |
36c66720 RH |
661 | |
662 | $ok = 0; | |
663 | ||
664 | my $first_time = 1; | |
665 | LABEL28: for(1) { | |
666 | if (!$first_time) { | |
667 | $ok = 1; | |
668 | last TEST28; | |
669 | } | |
670 | $ok = 0; | |
671 | $first_time = 0; | |
672 | redo LABEL28; | |
673 | last TEST28; | |
674 | } | |
675 | continue { | |
676 | $ok = 0; | |
677 | last TEST28; | |
678 | } | |
679 | $ok = 0; | |
680 | } | |
de29acd5 | 681 | cmp_ok($ok,'==',1,'label on for(@array)'); |
36c66720 | 682 | |
de29acd5 | 683 | TEST29: { |
36c66720 RH |
684 | |
685 | $ok = 0; | |
686 | ||
687 | my $first_time = 1; | |
688 | my $been_in_continue = 0; | |
689 | LABEL29: for(1,2) { | |
690 | if (!$first_time) { | |
691 | $ok = $been_in_continue; | |
692 | last TEST29; | |
693 | } | |
694 | $ok = 0; | |
695 | $first_time = 0; | |
696 | next LABEL29; | |
697 | last TEST29; | |
698 | } | |
699 | continue { | |
700 | $been_in_continue = 1; | |
701 | } | |
702 | $ok = 0; | |
703 | } | |
de29acd5 | 704 | cmp_ok($ok,'==',1,'label on for(@array) successful next'); |
36c66720 | 705 | |
de29acd5 | 706 | TEST30: { |
36c66720 RH |
707 | |
708 | $ok = 0; | |
709 | ||
710 | my $first_time = 1; | |
711 | my $been_in_loop = 0; | |
712 | my $been_in_continue = 0; | |
713 | LABEL30: for(1) { | |
714 | $been_in_loop = 1; | |
715 | if (!$first_time) { | |
716 | $ok = 0; | |
717 | last TEST30; | |
718 | } | |
719 | $ok = 0; | |
720 | $first_time = 0; | |
721 | next LABEL30; | |
722 | last TEST30; | |
723 | } | |
724 | continue { | |
725 | $been_in_continue = 1; | |
726 | } | |
727 | $ok = $been_in_loop && $been_in_continue; | |
728 | } | |
de29acd5 | 729 | cmp_ok($ok,'==',1,'label on for(@array) unsuccessful next'); |
36c66720 | 730 | |
de29acd5 | 731 | TEST31: { |
36c66720 RH |
732 | |
733 | $ok = 0; | |
734 | ||
735 | my $first_time = 1; | |
736 | LABEL31: for(1..10) { | |
737 | if (!$first_time) { | |
738 | $ok = 0; | |
739 | last TEST31; | |
740 | } | |
741 | $ok = 0; | |
742 | $first_time = 0; | |
743 | last LABEL31; | |
744 | last TEST31; | |
745 | } | |
746 | continue { | |
747 | $ok=0; | |
748 | last TEST31; | |
749 | } | |
750 | $ok = 1; | |
751 | } | |
de29acd5 | 752 | cmp_ok($ok,'==',1,'label on for(@array) last'); |
36c66720 | 753 | |
de29acd5 | 754 | TEST32: { |
36c66720 RH |
755 | |
756 | $ok = 0; | |
757 | ||
758 | LABEL32: for(my $first_time = 1; 1;) { | |
759 | if (!$first_time) { | |
760 | $ok = 1; | |
761 | last TEST32; | |
762 | } | |
763 | $ok = 0; | |
764 | $first_time=0; | |
765 | ||
766 | redo LABEL32; | |
767 | last TEST32; | |
768 | } | |
769 | $ok = 0; | |
770 | } | |
de29acd5 | 771 | cmp_ok($ok,'==',1,'label on for(;;)'); |
36c66720 | 772 | |
de29acd5 | 773 | TEST33: { |
36c66720 RH |
774 | |
775 | $ok = 0; | |
776 | ||
777 | LABEL33: for(my $first_time = 1; 1; $first_time=0) { | |
778 | if (!$first_time) { | |
779 | $ok = 1; | |
780 | last TEST33; | |
781 | } | |
782 | $ok = 0; | |
783 | next LABEL33; | |
784 | last TEST33; | |
785 | } | |
786 | $ok = 0; | |
787 | } | |
de29acd5 | 788 | cmp_ok($ok,'==',1,'label on for(;;) successful next'); |
36c66720 | 789 | |
de29acd5 | 790 | TEST34: { |
36c66720 RH |
791 | |
792 | $ok = 0; | |
793 | ||
794 | my $x=1; | |
795 | my $been_in_loop = 0; | |
796 | LABEL34: for(my $first_time = 1; $x--;) { | |
797 | $been_in_loop = 1; | |
798 | if (!$first_time) { | |
799 | $ok = 0; | |
800 | last TEST34; | |
801 | } | |
802 | $ok = 0; | |
803 | $first_time = 0; | |
804 | next LABEL34; | |
805 | last TEST34; | |
806 | } | |
807 | $ok = $been_in_loop; | |
808 | } | |
de29acd5 | 809 | cmp_ok($ok,'==',1,'label on for(;;) unsuccessful next'); |
36c66720 | 810 | |
de29acd5 | 811 | TEST35: { |
36c66720 RH |
812 | |
813 | $ok = 0; | |
814 | ||
815 | LABEL35: for(my $first_time = 1; 1; last TEST16) { | |
816 | if (!$first_time) { | |
817 | $ok = 0; | |
818 | last TEST35; | |
819 | } | |
820 | $ok = 0; | |
821 | $first_time = 0; | |
822 | last LABEL35; | |
823 | last TEST35; | |
824 | } | |
825 | $ok = 1; | |
826 | } | |
de29acd5 | 827 | cmp_ok($ok,'==',1,'label on for(;;) last'); |
36c66720 | 828 | |
de29acd5 | 829 | TEST36: { |
36c66720 RH |
830 | |
831 | $ok = 0; | |
832 | my $first_time = 1; | |
833 | ||
834 | LABEL36: { | |
835 | if (!$first_time) { | |
836 | $ok = 1; | |
837 | last TEST36; | |
838 | } | |
839 | $ok = 0; | |
840 | $first_time=0; | |
841 | ||
842 | redo LABEL36; | |
843 | last TEST36; | |
844 | } | |
845 | continue { | |
846 | $ok = 0; | |
847 | last TEST36; | |
848 | } | |
849 | $ok = 0; | |
850 | } | |
de29acd5 | 851 | cmp_ok($ok,'==',1,'label on bare block'); |
36c66720 | 852 | |
de29acd5 | 853 | TEST37: { |
36c66720 RH |
854 | |
855 | $ok = 0; | |
856 | LABEL37: { | |
857 | next LABEL37; | |
858 | last TEST37; | |
859 | } | |
860 | continue { | |
861 | $ok = 1; | |
862 | last TEST37; | |
863 | } | |
864 | $ok = 0; | |
865 | } | |
de29acd5 | 866 | cmp_ok($ok,'==',1,'label on bare block next'); |
36c66720 | 867 | |
de29acd5 | 868 | TEST38: { |
36c66720 RH |
869 | |
870 | $ok = 0; | |
871 | LABEL38: { | |
872 | last LABEL38; | |
873 | last TEST38; | |
874 | } | |
875 | continue { | |
876 | $ok = 0; | |
877 | last TEST38; | |
878 | } | |
879 | $ok = 1; | |
880 | } | |
de29acd5 | 881 | cmp_ok($ok,'==',1,'label on bare block last'); |
36c66720 RH |
882 | |
883 | TEST39: { | |
884 | $ok = 0; | |
885 | my ($x, $y, $z) = (1,1,1); | |
886 | one39: while ($x--) { | |
887 | $ok = 0; | |
888 | two39: while ($y--) { | |
889 | $ok = 0; | |
890 | three39: while ($z--) { | |
891 | next two39; | |
892 | } | |
893 | continue { | |
894 | $ok = 0; | |
895 | last TEST39; | |
896 | } | |
897 | } | |
898 | continue { | |
899 | $ok = 1; | |
900 | last TEST39; | |
901 | } | |
902 | $ok = 0; | |
903 | } | |
904 | } | |
de29acd5 | 905 | cmp_ok($ok,'==',1,'nested constructs'); |
264cef28 MS |
906 | |
907 | sub test_last_label { last TEST40 } | |
908 | ||
909 | TEST40: { | |
910 | $ok = 1; | |
911 | test_last_label(); | |
912 | $ok = 0; | |
913 | } | |
de29acd5 | 914 | cmp_ok($ok,'==',1,'dynamically scoped label'); |
264cef28 MS |
915 | |
916 | sub test_last { last } | |
917 | ||
918 | TEST41: { | |
919 | $ok = 1; | |
920 | test_last(); | |
921 | $ok = 0; | |
922 | } | |
de29acd5 | 923 | cmp_ok($ok,'==',1,'dynamically scoped'); |
936c78b5 DM |
924 | |
925 | ||
926 | # [perl #27206] Memory leak in continue loop | |
927 | # Ensure that the temporary object is freed each time round the loop, | |
928 | # rather then all 10 of them all being freed right at the end | |
929 | ||
930 | { | |
931 | my $n=10; my $late_free = 0; | |
932 | sub X::DESTROY { $late_free++ if $n < 0 }; | |
933 | { | |
934 | ($n-- && bless {}, 'X') && redo; | |
935 | } | |
de29acd5 | 936 | cmp_ok($late_free,'==',0,"bug 27206: redo memory leak"); |
936c78b5 DM |
937 | |
938 | $n = 10; $late_free = 0; | |
939 | { | |
940 | ($n-- && bless {}, 'X') && redo; | |
941 | } | |
942 | continue { } | |
de29acd5 | 943 | cmp_ok($late_free,'==',0,"bug 27206: redo with continue memory leak"); |
936c78b5 DM |
944 | } |
945 | ||
de29acd5 | 946 | # ensure that redo doesn't clear a lexical declared in the condition |
a034e688 DM |
947 | |
948 | { | |
949 | my $i = 1; | |
950 | while (my $x = $i) { | |
951 | $i++; | |
952 | redo if $i == 2; | |
de29acd5 | 953 | cmp_ok($x,'==',1,"while/redo lexical life"); |
a034e688 DM |
954 | last; |
955 | } | |
956 | $i = 1; | |
957 | until (! (my $x = $i)) { | |
958 | $i++; | |
959 | redo if $i == 2; | |
de29acd5 | 960 | cmp_ok($x,'==',1,"until/redo lexical life"); |
a034e688 DM |
961 | last; |
962 | } | |
963 | for ($i = 1; my $x = $i; ) { | |
964 | $i++; | |
965 | redo if $i == 2; | |
de29acd5 | 966 | cmp_ok($x,'==',1,"for/redo lexical life"); |
a034e688 DM |
967 | last; |
968 | } | |
969 | ||
970 | } | |
6e585ca0 DM |
971 | |
972 | { | |
6e585ca0 DM |
973 | $a37725[3] = 1; # use package var |
974 | $i = 2; | |
975 | for my $x (reverse @a37725) { | |
976 | $x = $i++; | |
977 | } | |
7d8b9a6b | 978 | cmp_ok("@a37725",'eq',"5 4 3 2",'bug 37725: reverse with empty slots bug'); |
6e585ca0 DM |
979 | } |
980 | ||
f83b46a0 DM |
981 | # [perl #21469] bad things happened with for $x (...) { *x = *y } |
982 | ||
983 | { | |
984 | my $i = 1; | |
985 | $x_21469 = 'X'; | |
986 | $y1_21469 = 'Y1'; | |
987 | $y2_21469 = 'Y2'; | |
988 | $y3_21469 = 'Y3'; | |
989 | for $x_21469 (1,2,3) { | |
990 | is($x_21469, $i, "bug 21469: correct at start of loop $i"); | |
991 | *x_21469 = (*y1_21469, *y2_21469, *y3_21469)[$i-1]; | |
992 | is($x_21469, "Y$i", "bug 21469: correct at tail of loop $i"); | |
993 | $i++; | |
994 | } | |
995 | is($x_21469, 'X', "bug 21469: X okay at end of loop"); | |
996 | } | |
eade7155 BF |
997 | |
998 | # [perl #112316] Wrong behavior regarding labels with same prefix | |
999 | { | |
1000 | my $fail; | |
1001 | CATCH: { | |
1002 | CATCHLOOP: { | |
1003 | last CATCH; | |
1004 | } | |
1005 | $fail = 1; | |
1006 | } | |
1007 | ok(!$fail, "perl 112316: Labels with the same prefix don't get mixed up."); | |
1008 | } | |
317f3b66 JL |
1009 | |
1010 | # [perl #73618] | |
1011 | { | |
1012 | sub foo_73618_0 { | |
1013 | while (0) { } | |
1014 | } | |
1015 | sub bar_73618_0 { | |
1016 | my $i = 0; | |
1017 | while ($i) { } | |
1018 | } | |
1019 | sub foo_73618_undef { | |
1020 | while (undef) { } | |
1021 | } | |
1022 | sub bar_73618_undef { | |
1023 | my $i = undef; | |
1024 | while ($i) { } | |
1025 | } | |
1026 | sub foo_73618_emptystring { | |
1027 | while ("") { } | |
1028 | } | |
1029 | sub bar_73618_emptystring { | |
1030 | my $i = ""; | |
1031 | while ($i) { } | |
1032 | } | |
1033 | sub foo_73618_0float { | |
1034 | while (0.0) { } | |
1035 | } | |
1036 | sub bar_73618_0float { | |
1037 | my $i = 0.0; | |
1038 | while ($i) { } | |
1039 | } | |
1040 | sub foo_73618_0string { | |
1041 | while ("0") { } | |
1042 | } | |
1043 | sub bar_73618_0string { | |
1044 | my $i = "0"; | |
1045 | while ($i) { } | |
1046 | } | |
1047 | sub foo_73618_until { | |
1048 | until (1) { } | |
1049 | } | |
1050 | sub bar_73618_until { | |
1051 | my $i = 1; | |
1052 | until ($i) { } | |
1053 | } | |
1054 | ||
1055 | is(scalar(foo_73618_0()), scalar(bar_73618_0()), | |
1056 | "constant optimization doesn't change return value"); | |
1057 | is(scalar(foo_73618_undef()), scalar(bar_73618_undef()), | |
1058 | "constant optimization doesn't change return value"); | |
1059 | is(scalar(foo_73618_emptystring()), scalar(bar_73618_emptystring()), | |
1060 | "constant optimization doesn't change return value"); | |
1061 | is(scalar(foo_73618_0float()), scalar(bar_73618_0float()), | |
1062 | "constant optimization doesn't change return value"); | |
1063 | is(scalar(foo_73618_0string()), scalar(bar_73618_0string()), | |
1064 | "constant optimization doesn't change return value"); | |
1065 | { local $TODO = "until is still wrongly optimized"; | |
1066 | is(scalar(foo_73618_until()), scalar(bar_73618_until()), | |
1067 | "constant optimization doesn't change return value"); | |
1068 | } | |
1069 | } | |
1f039d60 FC |
1070 | |
1071 | # [perl #113684] | |
1072 | last_113684: | |
1073 | { | |
1074 | label1: | |
1075 | { | |
1076 | my $label = "label1"; | |
1077 | eval { last $label }; | |
1078 | fail("last with non-constant label"); | |
1079 | last last_113684; | |
1080 | } | |
1081 | pass("last with non-constant label"); | |
1082 | } | |
1083 | next_113684: | |
1084 | { | |
1085 | label2: | |
1086 | { | |
1087 | my $label = "label2"; | |
1088 | eval { next $label }; | |
1089 | fail("next with non-constant label"); | |
1090 | next next_113684; | |
1091 | } | |
1092 | pass("next with non-constant label"); | |
1093 | } | |
1094 | redo_113684: | |
1095 | { | |
1096 | my $count; | |
1097 | label3: | |
1098 | { | |
1099 | if ($count++) { | |
1100 | pass("redo with non-constant label"); last redo_113684 | |
1101 | } | |
1102 | my $label = "label3"; | |
1103 | eval { redo $label }; | |
1104 | fail("redo with non-constant label"); | |
1105 | } | |
1106 | } | |
0c0c317c FC |
1107 | |
1108 | # [perl #3112] | |
1109 | # The original report, which produced a Bizarre copy | |
1110 | @a = (); | |
1111 | eval { | |
1112 | for (1) { | |
1113 | push @a, last; | |
1114 | } | |
1115 | }; | |
1116 | is @a, 0, 'push @a, last; does not push'; | |
1117 | is $@, "", 'no error, either'; | |
1118 | # And my japh, which relied on the misbehaviour | |
1119 | is do{{&{sub{"Just another Perl hacker,\n"}},last}}, undef, | |
1120 | 'last returns nothing'; |