Integrate perlhist entries for 5.8.6 and its perldelta to blead

[perl5.git] / t / op / closure.t

diff --git a/t/op/closure.t b/t/op/closure.t
index 4e8694e..574656b 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..177\n";
+print "1..187\n";
 
 my $test = 1;
 sub test (&) {
@@ -255,7 +255,7 @@ END_MARK_ONE
 
          $code .=  <<"END_MARK_TWO" if $nc_attempt;
     return if index(\$msg, 'will not stay shared') != -1;
-    return if index(\$msg, 'may be unavailable') != -1;
+    return if index(\$msg, 'is not available') != -1;
 END_MARK_TWO
 
          $code .= <<"END_MARK_THREE";          # Backwhack a lot!
@@ -510,11 +510,33 @@ END
 
 }
 
-# The following dumps core with perl <= 5.8.0
+# The following dumps core with perl <= 5.8.0 (bugid 9535) ...
 BEGIN { $vanishing_pad = sub { eval $_[0] } }
 $some_var = 123;
 test { $vanishing_pad->( '$some_var' ) == 123 };
 
+# ... and here's another coredump variant - this time we explicitly
+# delete the sub rather than using a BEGIN ...
+
+sub deleteme { $a = sub { eval '$newvar' } }
+deleteme();
+*deleteme = sub {}; # delete the sub
+$newvar = 123; # realloc the SV of the freed CV
+test { $a->() == 123 };
+
+# ... and a further coredump variant - the fixup of the anon sub's
+# CvOUTSIDE pointer when the middle eval is freed, wasn't good enough to
+# survive the outer eval also being freed.
+
+$x = 123;
+$a = eval q(
+    eval q[
+       sub { eval '$x' }
+    ]
+);
+@a = ('\1\1\1\1\1\1\1') x 100; # realloc recently-freed CVs
+test { $a->() == 123 };
+
 # this coredumped on <= 5.8.0 because evaling the closure caused
 # an SvFAKE to be added to the outer anon's pad, which was then grown.
 my $outer;
@@ -549,3 +571,130 @@ test {1};
 }
 fake();
 
+# undefining a sub shouldn't alter visibility of outer lexicals
+
+{
+    $x = 1;
+    my $x = 2;
+    sub tmp { sub { eval '$x' } }
+    my $a = tmp();
+    undef &tmp;
+    test { $a->() == 2 };
+}
+
+# handy class: $x = Watch->new(\$foo,'bar')
+# causes 'bar' to be appended to $foo when $x is destroyed
+sub Watch::new { bless [ $_[1], $_[2] ], $_[0] }
+sub Watch::DESTROY { ${$_[0][0]} .= $_[0][1] }
+
+
+# bugid 1028:
+# nested anon subs (and associated lexicals) not freed early enough
+
+sub linger {
+    my $x = Watch->new($_[0], '2');
+    sub {
+       $x;
+       my $y;
+       sub { $y; };
+    };
+}
+{
+    my $watch = '1';
+    linger(\$watch);
+    test { $watch eq '12' }
+}
+
+# bugid 10085
+# obj not freed early enough
+
+sub linger2 { 
+    my $obj = Watch->new($_[0], '2');
+    sub { sub { $obj } };
+}   
+{
+    my $watch = '1';
+    linger2(\$watch);
+    test { $watch eq '12' }
+}
+
+# bugid 16302 - named subs didn't capture lexicals on behalf of inner subs
+
+{
+    my $x = 1;
+    sub f16302 {
+       sub {
+           test { defined $x and $x == 1 }
+       }->();
+    }
+}
+f16302();
+
+# The presence of an eval should turn cloneless anon subs into clonable
+# subs - otherwise the CvOUTSIDE of that sub may be wrong
+
+{
+    my %a;
+    for my $x (7,11) {
+       $a{$x} = sub { $x=$x; sub { eval '$x' } };
+    }
+    test { $a{7}->()->() + $a{11}->()->() == 18 };
+}
+
+require './test.pl'; # for runperl()
+
+{
+   # bugid #23265 - this used to coredump during destruction of PL_maincv
+   # and its children
+
+    my $progfile = "b23265.pl";
+    open(T, ">$progfile") or die "$0: $!\n";
+    print T << '__EOF__';
+        print
+            sub {$_[0]->(@_)} -> (
+                sub {
+                    $_[1]
+                        ?  $_[0]->($_[0], $_[1] - 1) .  sub {"x"}->()
+                        : "y"
+                },   
+                2
+            )
+            , "\n"
+        ;
+__EOF__
+    close T;
+    my $got = runperl(progfile => $progfile);
+    test { chomp $got; $got eq "yxx" };
+    END { 1 while unlink $progfile }
+}
+
+{
+    # bugid #24914 = used to coredump restoring PL_comppad in the
+    # savestack, due to the early freeing of the anon closure
+
+    my $got = runperl(stderr => 1, prog => 
+'sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qq(ok\n)'
+    );
+    test { $got eq "ok\n" };
+}
+
+# After newsub is redefined outside the BEGIN, it's CvOUTSIDE should point
+# to main rather than BEGIN, and BEGIN should be freed.
+
+{
+    my $flag = 0;
+    sub  X::DESTROY { $flag = 1 }
+    {
+       my $x;
+       BEGIN {$x = \&newsub }
+       sub newsub {};
+       $x = bless {}, 'X';
+    }
+    test { $flag == 1 };
+}
+
+
+
+
+
+