From cd17cc2e752d3e7e4d2cbdac9869cc7de3e9b075 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Thu, 25 Jun 2015 16:08:02 +0100
Subject: [PATCH] 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.
---
 pp_ctl.c    | 10 +++++-----
 t/op/goto.t | 26 +++++++++++++++++++++++++-
 2 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 5765326..e24b7c5 100644
--- 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
--- 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
 
-- 
1.8.3.1