pp_goto: SvREFCNT_dec(oldcv) *after* undef test

pp_goto does a LEAVE, then checks that the new CV hasn't been undefed
by the LEAVE. If it has, it croaks.

Move the decrementing of the old CV's ref count and depth to *after*
this check, since the POPSUB done during the croak unwind will do the
decrement also. Otherwise the old sub will be doubly freed.

diff --git a/pp_ctl.c b/pp_ctl.c
index 5765326..e24b7c5 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2748,11 +2748,6 @@ PP(pp_goto)
            oldsave = PL_scopestack[cx->blk_oldscopesp - 1];
            LEAVE_SCOPE(oldsave);
 
-           if (CxTYPE(cx) == CXt_SUB) {
-               CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth;
-                SvREFCNT_dec_NN(cx->blk_sub.cv);
-            }
-
            /* A destructor called during LEAVE_SCOPE could have undefined
             * our precious cv.  See bug #99850. */
            if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2767,6 +2762,11 @@ PP(pp_goto)
                DIE(aTHX_ "Goto undefined subroutine");
            }
 
+           if (CxTYPE(cx) == CXt_SUB) {
+               CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth;
+                SvREFCNT_dec_NN(cx->blk_sub.cv);
+            }
+
            /* Now do some callish stuff. */
            SAVETMPS;
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */

diff --git a/t/op/goto.t b/t/op/goto.t
index d1e88d7..73a6b95 100644 (file)
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 96;
+plan tests => 97;
 our $TODO;
 
 my $deprecated = 0;
@@ -216,6 +216,30 @@ package _99850 {
 like $@, qr/^Goto undefined subroutine &_99850::reftype at /,
    'goto &foo undefining &foo on sub cleanup';
 
+# When croaking after discovering that the new CV you're about to goto is
+# undef, make sure that the old CV isn't doubly freed.
+
+package Do_undef {
+    my $count;
+
+    # creating a new closure here encourages any prematurely freed
+    # CV to be reallocated
+    sub DESTROY { undef &undef_sub; my $x = sub { $count } }
+
+    sub f {
+        $count++;
+        my $guard = bless []; # trigger DESTROY during goto
+        *undef_sub = sub {};
+        goto &undef_sub
+    }
+
+    for (1..10) {
+        eval { f() };
+    }
+    ::is($count, 10, "goto undef_sub safe");
+}
+
+
 # bug #22181 - this used to coredump or make $x undefined, due to
 # erroneous popping of the inner BLOCK context