A new try from Dave Mitchell for [perl #23265].

p4raw-id: //depot/perl@20631

diff --git a/pad.c b/pad.c
index 90d9979..06f0417 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -257,11 +257,19 @@ Perl_pad_undef(pTHX_ CV* cv)
                    && CvOUTSIDE(innercv) == cv)
                {
                    assert(CvWEAKOUTSIDE(innercv));
-                   CvWEAKOUTSIDE_off(innercv);
-                   CvOUTSIDE(innercv) = outercv;
-                   CvOUTSIDE_SEQ(innercv) = seq;
-                   SvREFCNT_inc(outercv);
+                   /* don't relink to grandfather if he's being freed */
+                   if (outercv && SvREFCNT(outercv)) {
+                       CvWEAKOUTSIDE_off(innercv);
+                       CvOUTSIDE(innercv) = outercv;
+                       CvOUTSIDE_SEQ(innercv) = seq;
+                       SvREFCNT_inc(outercv);
+                   }
+                   else {
+                       CvOUTSIDE(innercv) = Nullcv;
+                   }
+
                }
+
            }
        }
     }

diff --git a/t/op/closure.t b/t/op/closure.t
index dd7b50c..763e2a7 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..184\n";
+print "1..185\n";
 
 my $test = 1;
 sub test (&) {
@@ -641,4 +641,27 @@ 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" };