This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #27206] Memory leak in continue loop
[perl5.git] / t / op / loopctl.t
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
34 print "1..43\n";
35
36 my $ok;
37
38 ## while() loop without a label
39
40 TEST1: { # 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 }
62 print ($ok ? "ok 1\n" : "not ok 1\n");
63
64 TEST2: { # 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 }
86 print ($ok ? "ok 2\n" : "not ok 2\n");
87
88 TEST3: { # 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 }
112 print ($ok ? "ok 3\n" : "not ok 3\n");
113
114 TEST4: { # 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 }
136 print ($ok ? "ok 4\n" : "not ok 4\n");
137
138
139 ## until() loop without a label
140
141 TEST5: { # 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 }
163 print ($ok ? "ok 5\n" : "not ok 5\n");
164
165 TEST6: { # 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 }
187 print ($ok ? "ok 6\n" : "not ok 6\n");
188
189 TEST7: { # 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 }
213 print ($ok ? "ok 7\n" : "not ok 7\n");
214
215 TEST8: { # 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 }
237 print ($ok ? "ok 8\n" : "not ok 8\n");
238
239 ## for(@array) loop without a label
240
241 TEST9: { # 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 }
262 print ($ok ? "ok 9\n" : "not ok 9\n");
263
264 TEST10: { # 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 }
285 print ($ok ? "ok 10\n" : "not ok 10\n");
286
287 TEST11: { # 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 }
310 print ($ok ? "ok 11\n" : "not ok 11\n");
311
312 TEST12: { # 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 }
333 print ($ok ? "ok 12\n" : "not ok 12\n");
334
335 ## for(;;) loop without a label
336
337 TEST13: { # 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 }
354 print ($ok ? "ok 13\n" : "not ok 13\n");
355
356 TEST14: { # 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 }
371 print ($ok ? "ok 14\n" : "not ok 14\n");
372
373 TEST15: { # 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 }
392 print ($ok ? "ok 15\n" : "not ok 15\n");
393
394 TEST16: { # 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 }
410 print ($ok ? "ok 16\n" : "not ok 16\n");
411
412 ## bare block without a label
413
414 TEST17: { # 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 }
436 print ($ok ? "ok 17\n" : "not ok 17\n");
437
438 TEST18: { # 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 }
451 print ($ok ? "ok 18\n" : "not ok 18\n");
452
453 TEST19: { # 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 }
466 print ($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
473 TEST20: { # 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 }
495 print ($ok ? "ok 20\n" : "not ok 20\n");
496
497 TEST21: { # 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 }
519 print ($ok ? "ok 21\n" : "not ok 21\n");
520
521 TEST22: { # 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 }
545 print ($ok ? "ok 22\n" : "not ok 22\n");
546
547 TEST23: { # 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 }
569 print ($ok ? "ok 23\n" : "not ok 23\n");
570
571
572 ## until() loop with a label
573
574 TEST24: { # 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 }
596 print ($ok ? "ok 24\n" : "not ok 24\n");
597
598 TEST25: { # 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 }
620 print ($ok ? "ok 25\n" : "not ok 25\n");
621
622 TEST26: { # 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 }
646 print ($ok ? "ok 26\n" : "not ok 26\n");
647
648 TEST27: { # 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 }
670 print ($ok ? "ok 27\n" : "not ok 27\n");
671
672 ## for(@array) loop with a label
673
674 TEST28: { # 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 }
695 print ($ok ? "ok 28\n" : "not ok 28\n");
696
697 TEST29: { # 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 }
718 print ($ok ? "ok 29\n" : "not ok 29\n");
719
720 TEST30: { # 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 }
743 print ($ok ? "ok 30\n" : "not ok 30\n");
744
745 TEST31: { # 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 }
766 print ($ok ? "ok 31\n" : "not ok 31\n");
767
768 ## for(;;) loop with a label
769
770 TEST32: { # 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 }
787 print ($ok ? "ok 32\n" : "not ok 32\n");
788
789 TEST33: { # 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 }
804 print ($ok ? "ok 33\n" : "not ok 33\n");
805
806 TEST34: { # 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 }
825 print ($ok ? "ok 34\n" : "not ok 34\n");
826
827 TEST35: { # 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 }
843 print ($ok ? "ok 35\n" : "not ok 35\n");
844
845 ## bare block with a label
846
847 TEST36: { # 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 }
869 print ($ok ? "ok 36\n" : "not ok 36\n");
870
871 TEST37: { # 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 }
884 print ($ok ? "ok 37\n" : "not ok 37\n");
885
886 TEST38: { # 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 }
899 print ($ok ? "ok 38\n" : "not ok 38\n");
900
901 ### Now test nested constructs
902
903 TEST39: {
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 }
925 print ($ok ? "ok 39\n" : "not ok 39\n");
926
927
928 ### Test that loop control is dynamicly scoped.
929
930 sub test_last_label { last TEST40 }
931
932 TEST40: {
933     $ok = 1;
934     test_last_label();
935     $ok = 0;
936 }
937 print ($ok ? "ok 40\n" : "not ok 40\n");
938
939 sub test_last { last }
940
941 TEST41: {
942     $ok = 1;
943     test_last();
944     $ok = 0;
945 }
946 print ($ok ? "ok 41\n" : "not ok 41\n");
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