This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #37725] perl segfaults on reversed array reference
[perl5.git] / t / op / loopctl.t
index 2ed9df1..a8e2310 100644 (file)
@@ -31,7 +31,7 @@
 #
 #  -- .robin. <robin@kitsite.com>  2001-03-13
 
-print "1..41\n";
+print "1..47\n";
 
 my $ok;
 
@@ -944,3 +944,64 @@ TEST41: {
     $ok = 0;
 }
 print ($ok ? "ok 41\n" : "not ok 41\n");
+
+
+# [perl #27206] Memory leak in continue loop
+# Ensure that the temporary object is freed each time round the loop,
+# rather then all 10 of them all being freed right at the end
+
+{
+    my $n=10; my $late_free = 0;
+    sub X::DESTROY { $late_free++ if $n < 0 };
+    {
+       ($n-- && bless {}, 'X') && redo;
+    }
+    print $late_free ? "not " : "", "ok 42 - redo memory leak\n";
+
+    $n = 10; $late_free = 0;
+    {
+       ($n-- && bless {}, 'X') && redo;
+    }
+    continue { }
+    print $late_free ? "not " : "", "ok 43 - redo with continue memory leak\n";
+}
+
+
+# ensure that redo doesn't clear a lexical delcared in the condition
+
+{
+    my $i = 1;
+    while (my $x = $i) {
+       $i++;
+       redo if $i == 2;
+       print $x == 1 ? "" : "not ", "ok 44 - while/redo lexical life\n";
+       last;
+    }
+    $i = 1;
+    until (! (my $x = $i)) {
+       $i++;
+       redo if $i == 2;
+       print $x == 1 ? "" : "not ", "ok 45 - until/redo lexical life\n";
+       last;
+    }
+    for ($i = 1; my $x = $i; ) {
+       $i++;
+       redo if $i == 2;
+       print $x == 1 ? "" : "not ", "ok 46 - for/redo lexical life\n";
+       last;
+    }
+
+}
+
+{
+    # [perl #37725]
+
+    $a37725[3] = 1; # use package var
+    $i = 2;
+    for my $x (reverse @a37725) {
+       $x = $i++;
+    }
+    print "@a37725" == "5 4 3 2" ? "" : "not ",
+       "ok 47 - reverse with empty slots (@a37725)\n";
+}
+