This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
while (my $x ...) { ...; redo } shouldn't undef $x.
[perl5.git] / t / op / loopctl.t
CommitLineData
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
33
a034e688 34print "1..46\n";
36c66720
RH
35
36my $ok;
37
38## while() loop without a label
39
40TEST1: { # redo
41
42 $ok = 0;
43
44 my $x = 1;
45 my $first_time = 1;
46 while($x--) {
47 if (!$first_time) {
48 $ok = 1;
49 last TEST1;
50 }
51 $ok = 0;
52 $first_time = 0;
53 redo;
54 last TEST1;
55 }
56 continue {
57 $ok = 0;
58 last TEST1;
59 }
60 $ok = 0;
61}
62print ($ok ? "ok 1\n" : "not ok 1\n");
63
64TEST2: { # next (succesful)
65
66 $ok = 0;
67
68 my $x = 2;
69 my $first_time = 1;
70 my $been_in_continue = 0;
71 while($x--) {
72 if (!$first_time) {
73 $ok = $been_in_continue;
74 last TEST2;
75 }
76 $ok = 0;
77 $first_time = 0;
78 next;
79 last TEST2;
80 }
81 continue {
82 $been_in_continue = 1;
83 }
84 $ok = 0;
85}
86print ($ok ? "ok 2\n" : "not ok 2\n");
87
88TEST3: { # next (unsuccesful)
89
90 $ok = 0;
91
92 my $x = 1;
93 my $first_time = 1;
94 my $been_in_loop = 0;
95 my $been_in_continue = 0;
96 while($x--) {
97 $been_in_loop = 1;
98 if (!$first_time) {
99 $ok = 0;
100 last TEST3;
101 }
102 $ok = 0;
103 $first_time = 0;
104 next;
105 last TEST3;
106 }
107 continue {
108 $been_in_continue = 1;
109 }
110 $ok = $been_in_loop && $been_in_continue;
111}
112print ($ok ? "ok 3\n" : "not ok 3\n");
113
114TEST4: { # last
115
116 $ok = 0;
117
118 my $x = 1;
119 my $first_time = 1;
120 while($x++) {
121 if (!$first_time) {
122 $ok = 0;
123 last TEST4;
124 }
125 $ok = 0;
126 $first_time = 0;
127 last;
128 last TEST4;
129 }
130 continue {
131 $ok = 0;
132 last TEST4;
133 }
134 $ok = 1;
135}
136print ($ok ? "ok 4\n" : "not ok 4\n");
137
138
139## until() loop without a label
140
141TEST5: { # redo
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}
163print ($ok ? "ok 5\n" : "not ok 5\n");
164
165TEST6: { # next (succesful)
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}
187print ($ok ? "ok 6\n" : "not ok 6\n");
188
189TEST7: { # next (unsuccesful)
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}
213print ($ok ? "ok 7\n" : "not ok 7\n");
214
215TEST8: { # last
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}
237print ($ok ? "ok 8\n" : "not ok 8\n");
238
239## for(@array) loop without a label
240
241TEST9: { # redo
242
243 $ok = 0;
244
245 my $first_time = 1;
246 for(1) {
247 if (!$first_time) {
248 $ok = 1;
249 last TEST9;
250 }
251 $ok = 0;
252 $first_time = 0;
253 redo;
254 last TEST9;
255 }
256 continue {
257 $ok = 0;
258 last TEST9;
259 }
260 $ok = 0;
261}
262print ($ok ? "ok 9\n" : "not ok 9\n");
263
264TEST10: { # next (succesful)
265
266 $ok = 0;
267
268 my $first_time = 1;
269 my $been_in_continue = 0;
270 for(1,2) {
271 if (!$first_time) {
272 $ok = $been_in_continue;
273 last TEST10;
274 }
275 $ok = 0;
276 $first_time = 0;
277 next;
278 last TEST10;
279 }
280 continue {
281 $been_in_continue = 1;
282 }
283 $ok = 0;
284}
285print ($ok ? "ok 10\n" : "not ok 10\n");
286
287TEST11: { # next (unsuccesful)
288
289 $ok = 0;
290
291 my $first_time = 1;
292 my $been_in_loop = 0;
293 my $been_in_continue = 0;
294 for(1) {
295 $been_in_loop = 1;
296 if (!$first_time) {
297 $ok = 0;
298 last TEST11;
299 }
300 $ok = 0;
301 $first_time = 0;
302 next;
303 last TEST11;
304 }
305 continue {
306 $been_in_continue = 1;
307 }
308 $ok = $been_in_loop && $been_in_continue;
309}
310print ($ok ? "ok 11\n" : "not ok 11\n");
311
312TEST12: { # last
313
314 $ok = 0;
315
316 my $first_time = 1;
317 for(1..10) {
318 if (!$first_time) {
319 $ok = 0;
320 last TEST12;
321 }
322 $ok = 0;
323 $first_time = 0;
324 last;
325 last TEST12;
326 }
327 continue {
328 $ok=0;
329 last TEST12;
330 }
331 $ok = 1;
332}
333print ($ok ? "ok 12\n" : "not ok 12\n");
334
335## for(;;) loop without a label
336
337TEST13: { # redo
338
339 $ok = 0;
340
341 for(my $first_time = 1; 1;) {
342 if (!$first_time) {
343 $ok = 1;
344 last TEST13;
345 }
346 $ok = 0;
347 $first_time=0;
348
349 redo;
350 last TEST13;
351 }
352 $ok = 0;
353}
354print ($ok ? "ok 13\n" : "not ok 13\n");
355
356TEST14: { # next (successful)
357
358 $ok = 0;
359
360 for(my $first_time = 1; 1; $first_time=0) {
361 if (!$first_time) {
362 $ok = 1;
363 last TEST14;
364 }
365 $ok = 0;
366 next;
367 last TEST14;
368 }
369 $ok = 0;
370}
371print ($ok ? "ok 14\n" : "not ok 14\n");
372
373TEST15: { # next (unsuccesful)
374
375 $ok = 0;
376
377 my $x=1;
378 my $been_in_loop = 0;
379 for(my $first_time = 1; $x--;) {
380 $been_in_loop = 1;
381 if (!$first_time) {
382 $ok = 0;
383 last TEST15;
384 }
385 $ok = 0;
386 $first_time = 0;
387 next;
388 last TEST15;
389 }
390 $ok = $been_in_loop;
391}
392print ($ok ? "ok 15\n" : "not ok 15\n");
393
394TEST16: { # last
395
396 $ok = 0;
397
398 for(my $first_time = 1; 1; last TEST16) {
399 if (!$first_time) {
400 $ok = 0;
401 last TEST16;
402 }
403 $ok = 0;
404 $first_time = 0;
405 last;
406 last TEST16;
407 }
408 $ok = 1;
409}
410print ($ok ? "ok 16\n" : "not ok 16\n");
411
412## bare block without a label
413
414TEST17: { # redo
415
416 $ok = 0;
417 my $first_time = 1;
418
419 {
420 if (!$first_time) {
421 $ok = 1;
422 last TEST17;
423 }
424 $ok = 0;
425 $first_time=0;
426
427 redo;
428 last TEST17;
429 }
430 continue {
431 $ok = 0;
432 last TEST17;
433 }
434 $ok = 0;
435}
436print ($ok ? "ok 17\n" : "not ok 17\n");
437
438TEST18: { # next
439
440 $ok = 0;
441 {
442 next;
443 last TEST18;
444 }
445 continue {
446 $ok = 1;
447 last TEST18;
448 }
449 $ok = 0;
450}
451print ($ok ? "ok 18\n" : "not ok 18\n");
452
453TEST19: { # last
454
455 $ok = 0;
456 {
457 last;
458 last TEST19;
459 }
460 continue {
461 $ok = 0;
462 last TEST19;
463 }
464 $ok = 1;
465}
466print ($ok ? "ok 19\n" : "not ok 19\n");
467
468
469### Now do it all again with labels
470
471## while() loop with a label
472
473TEST20: { # redo
474
475 $ok = 0;
476
477 my $x = 1;
478 my $first_time = 1;
479 LABEL20: while($x--) {
480 if (!$first_time) {
481 $ok = 1;
482 last TEST20;
483 }
484 $ok = 0;
485 $first_time = 0;
486 redo LABEL20;
487 last TEST20;
488 }
489 continue {
490 $ok = 0;
491 last TEST20;
492 }
493 $ok = 0;
494}
495print ($ok ? "ok 20\n" : "not ok 20\n");
496
497TEST21: { # next (succesful)
498
499 $ok = 0;
500
501 my $x = 2;
502 my $first_time = 1;
503 my $been_in_continue = 0;
504 LABEL21: while($x--) {
505 if (!$first_time) {
506 $ok = $been_in_continue;
507 last TEST21;
508 }
509 $ok = 0;
510 $first_time = 0;
511 next LABEL21;
512 last TEST21;
513 }
514 continue {
515 $been_in_continue = 1;
516 }
517 $ok = 0;
518}
519print ($ok ? "ok 21\n" : "not ok 21\n");
520
521TEST22: { # next (unsuccesful)
522
523 $ok = 0;
524
525 my $x = 1;
526 my $first_time = 1;
527 my $been_in_loop = 0;
528 my $been_in_continue = 0;
529 LABEL22: while($x--) {
530 $been_in_loop = 1;
531 if (!$first_time) {
532 $ok = 0;
533 last TEST22;
534 }
535 $ok = 0;
536 $first_time = 0;
537 next LABEL22;
538 last TEST22;
539 }
540 continue {
541 $been_in_continue = 1;
542 }
543 $ok = $been_in_loop && $been_in_continue;
544}
545print ($ok ? "ok 22\n" : "not ok 22\n");
546
547TEST23: { # last
548
549 $ok = 0;
550
551 my $x = 1;
552 my $first_time = 1;
553 LABEL23: while($x++) {
554 if (!$first_time) {
555 $ok = 0;
556 last TEST23;
557 }
558 $ok = 0;
559 $first_time = 0;
560 last LABEL23;
561 last TEST23;
562 }
563 continue {
564 $ok = 0;
565 last TEST23;
566 }
567 $ok = 1;
568}
569print ($ok ? "ok 23\n" : "not ok 23\n");
570
571
572## until() loop with a label
573
574TEST24: { # redo
575
576 $ok = 0;
577
578 my $x = 0;
579 my $first_time = 1;
580 LABEL24: until($x++) {
581 if (!$first_time) {
582 $ok = 1;
583 last TEST24;
584 }
585 $ok = 0;
586 $first_time = 0;
587 redo LABEL24;
588 last TEST24;
589 }
590 continue {
591 $ok = 0;
592 last TEST24;
593 }
594 $ok = 0;
595}
596print ($ok ? "ok 24\n" : "not ok 24\n");
597
598TEST25: { # next (succesful)
599
600 $ok = 0;
601
602 my $x = 0;
603 my $first_time = 1;
604 my $been_in_continue = 0;
605 LABEL25: until($x++ >= 2) {
606 if (!$first_time) {
607 $ok = $been_in_continue;
608 last TEST25;
609 }
610 $ok = 0;
611 $first_time = 0;
612 next LABEL25;
613 last TEST25;
614 }
615 continue {
616 $been_in_continue = 1;
617 }
618 $ok = 0;
619}
620print ($ok ? "ok 25\n" : "not ok 25\n");
621
622TEST26: { # next (unsuccesful)
623
624 $ok = 0;
625
626 my $x = 0;
627 my $first_time = 1;
628 my $been_in_loop = 0;
629 my $been_in_continue = 0;
630 LABEL26: until($x++) {
631 $been_in_loop = 1;
632 if (!$first_time) {
633 $ok = 0;
634 last TEST26;
635 }
636 $ok = 0;
637 $first_time = 0;
638 next LABEL26;
639 last TEST26;
640 }
641 continue {
642 $been_in_continue = 1;
643 }
644 $ok = $been_in_loop && $been_in_continue;
645}
646print ($ok ? "ok 26\n" : "not ok 26\n");
647
648TEST27: { # last
649
650 $ok = 0;
651
652 my $x = 0;
653 my $first_time = 1;
654 LABEL27: until($x++ == 10) {
655 if (!$first_time) {
656 $ok = 0;
657 last TEST27;
658 }
659 $ok = 0;
660 $first_time = 0;
661 last LABEL27;
662 last TEST27;
663 }
664 continue {
665 $ok = 0;
666 last TEST8;
667 }
668 $ok = 1;
669}
670print ($ok ? "ok 27\n" : "not ok 27\n");
671
672## for(@array) loop with a label
673
674TEST28: { # redo
675
676 $ok = 0;
677
678 my $first_time = 1;
679 LABEL28: for(1) {
680 if (!$first_time) {
681 $ok = 1;
682 last TEST28;
683 }
684 $ok = 0;
685 $first_time = 0;
686 redo LABEL28;
687 last TEST28;
688 }
689 continue {
690 $ok = 0;
691 last TEST28;
692 }
693 $ok = 0;
694}
695print ($ok ? "ok 28\n" : "not ok 28\n");
696
697TEST29: { # next (succesful)
698
699 $ok = 0;
700
701 my $first_time = 1;
702 my $been_in_continue = 0;
703 LABEL29: for(1,2) {
704 if (!$first_time) {
705 $ok = $been_in_continue;
706 last TEST29;
707 }
708 $ok = 0;
709 $first_time = 0;
710 next LABEL29;
711 last TEST29;
712 }
713 continue {
714 $been_in_continue = 1;
715 }
716 $ok = 0;
717}
718print ($ok ? "ok 29\n" : "not ok 29\n");
719
720TEST30: { # next (unsuccesful)
721
722 $ok = 0;
723
724 my $first_time = 1;
725 my $been_in_loop = 0;
726 my $been_in_continue = 0;
727 LABEL30: for(1) {
728 $been_in_loop = 1;
729 if (!$first_time) {
730 $ok = 0;
731 last TEST30;
732 }
733 $ok = 0;
734 $first_time = 0;
735 next LABEL30;
736 last TEST30;
737 }
738 continue {
739 $been_in_continue = 1;
740 }
741 $ok = $been_in_loop && $been_in_continue;
742}
743print ($ok ? "ok 30\n" : "not ok 30\n");
744
745TEST31: { # last
746
747 $ok = 0;
748
749 my $first_time = 1;
750 LABEL31: for(1..10) {
751 if (!$first_time) {
752 $ok = 0;
753 last TEST31;
754 }
755 $ok = 0;
756 $first_time = 0;
757 last LABEL31;
758 last TEST31;
759 }
760 continue {
761 $ok=0;
762 last TEST31;
763 }
764 $ok = 1;
765}
766print ($ok ? "ok 31\n" : "not ok 31\n");
767
768## for(;;) loop with a label
769
770TEST32: { # redo
771
772 $ok = 0;
773
774 LABEL32: for(my $first_time = 1; 1;) {
775 if (!$first_time) {
776 $ok = 1;
777 last TEST32;
778 }
779 $ok = 0;
780 $first_time=0;
781
782 redo LABEL32;
783 last TEST32;
784 }
785 $ok = 0;
786}
787print ($ok ? "ok 32\n" : "not ok 32\n");
788
789TEST33: { # next (successful)
790
791 $ok = 0;
792
793 LABEL33: for(my $first_time = 1; 1; $first_time=0) {
794 if (!$first_time) {
795 $ok = 1;
796 last TEST33;
797 }
798 $ok = 0;
799 next LABEL33;
800 last TEST33;
801 }
802 $ok = 0;
803}
804print ($ok ? "ok 33\n" : "not ok 33\n");
805
806TEST34: { # next (unsuccesful)
807
808 $ok = 0;
809
810 my $x=1;
811 my $been_in_loop = 0;
812 LABEL34: for(my $first_time = 1; $x--;) {
813 $been_in_loop = 1;
814 if (!$first_time) {
815 $ok = 0;
816 last TEST34;
817 }
818 $ok = 0;
819 $first_time = 0;
820 next LABEL34;
821 last TEST34;
822 }
823 $ok = $been_in_loop;
824}
825print ($ok ? "ok 34\n" : "not ok 34\n");
826
827TEST35: { # last
828
829 $ok = 0;
830
831 LABEL35: for(my $first_time = 1; 1; last TEST16) {
832 if (!$first_time) {
833 $ok = 0;
834 last TEST35;
835 }
836 $ok = 0;
837 $first_time = 0;
838 last LABEL35;
839 last TEST35;
840 }
841 $ok = 1;
842}
843print ($ok ? "ok 35\n" : "not ok 35\n");
844
845## bare block with a label
846
847TEST36: { # redo
848
849 $ok = 0;
850 my $first_time = 1;
851
852 LABEL36: {
853 if (!$first_time) {
854 $ok = 1;
855 last TEST36;
856 }
857 $ok = 0;
858 $first_time=0;
859
860 redo LABEL36;
861 last TEST36;
862 }
863 continue {
864 $ok = 0;
865 last TEST36;
866 }
867 $ok = 0;
868}
869print ($ok ? "ok 36\n" : "not ok 36\n");
870
871TEST37: { # next
872
873 $ok = 0;
874 LABEL37: {
875 next LABEL37;
876 last TEST37;
877 }
878 continue {
879 $ok = 1;
880 last TEST37;
881 }
882 $ok = 0;
883}
884print ($ok ? "ok 37\n" : "not ok 37\n");
885
886TEST38: { # last
887
888 $ok = 0;
889 LABEL38: {
890 last LABEL38;
891 last TEST38;
892 }
893 continue {
894 $ok = 0;
895 last TEST38;
896 }
897 $ok = 1;
898}
899print ($ok ? "ok 38\n" : "not ok 38\n");
900
901### Now test nested constructs
902
903TEST39: {
904 $ok = 0;
905 my ($x, $y, $z) = (1,1,1);
906 one39: while ($x--) {
907 $ok = 0;
908 two39: while ($y--) {
909 $ok = 0;
910 three39: while ($z--) {
911 next two39;
912 }
913 continue {
914 $ok = 0;
915 last TEST39;
916 }
917 }
918 continue {
919 $ok = 1;
920 last TEST39;
921 }
922 $ok = 0;
923 }
924}
925print ($ok ? "ok 39\n" : "not ok 39\n");
264cef28
MS
926
927
928### Test that loop control is dynamicly scoped.
929
930sub test_last_label { last TEST40 }
931
932TEST40: {
933 $ok = 1;
934 test_last_label();
935 $ok = 0;
936}
937print ($ok ? "ok 40\n" : "not ok 40\n");
938
939sub test_last { last }
940
941TEST41: {
942 $ok = 1;
943 test_last();
944 $ok = 0;
945}
946print ($ok ? "ok 41\n" : "not ok 41\n");
936c78b5
DM
947
948
949# [perl #27206] Memory leak in continue loop
950# Ensure that the temporary object is freed each time round the loop,
951# rather then all 10 of them all being freed right at the end
952
953{
954 my $n=10; my $late_free = 0;
955 sub X::DESTROY { $late_free++ if $n < 0 };
956 {
957 ($n-- && bless {}, 'X') && redo;
958 }
959 print $late_free ? "not " : "", "ok 42 - redo memory leak\n";
960
961 $n = 10; $late_free = 0;
962 {
963 ($n-- && bless {}, 'X') && redo;
964 }
965 continue { }
966 print $late_free ? "not " : "", "ok 43 - redo with continue memory leak\n";
967}
968
969
a034e688
DM
970# ensure that redo doesn't clear a lexical delcared in the condition
971
972{
973 my $i = 1;
974 while (my $x = $i) {
975 $i++;
976 redo if $i == 2;
977 print $x == 1 ? "" : "not ", "ok 44 - while/redo lexical life\n";
978 last;
979 }
980 $i = 1;
981 until (! (my $x = $i)) {
982 $i++;
983 redo if $i == 2;
984 print $x == 1 ? "" : "not ", "ok 45 - until/redo lexical life\n";
985 last;
986 }
987 for ($i = 1; my $x = $i; ) {
988 $i++;
989 redo if $i == 2;
990 print $x == 1 ? "" : "not ", "ok 46 - for/redo lexical life\n";
991 last;
992 }
993
994}