This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate perlhist entries for 5.8.6 and its perldelta to blead
[perl5.git] / t / op / closure.t
index 763e2a7..574656b 100755 (executable)
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..185\n";
+print "1..187\n";
 
 my $test = 1;
 sub test (&) {
@@ -641,27 +641,60 @@ f16302();
     test { $a{7}->()->() + $a{11}->()->() == 18 };
 }
 
-# bugid #23265 - this used to coredump during destruction of PL_maincv
-# and its children
-
-require './test.pl';
-
-my $got = runperl(
-    prog => q[
-       print
-           sub {$_[0]->(@_)} -> (
-               sub {
-                   $_[1]
-                       ?  $_[0]->($_[0], $_[1] - 1) .  sub {"x"}->()
-                       : "y"
-               },   
-               2
-           )
-           , "\n"
-       ;            
-    
-    ],
-    stderr => 1
-);
-test { $got eq "yxx\n" };
+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 };
+}
+
+
+
+
+