From 110af9080c3bd18406d1518c3c9e8cde8aa72e18 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 12 Nov 2012 16:04:07 -0800
Subject: [PATCH] Stop goto &sub from leaking when it croaks

---
 pp_ctl.c      | 7 +++++++
 t/op/svleak.t | 6 +++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 22e1cea..0df8b0c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2799,13 +2799,17 @@ PP(pp_goto)
 	    FREETMPS;
 	    cxix = dopoptosub(cxstack_ix);
 	    if (cxix < 0)
+	    {
+		SvREFCNT_dec(cv);
 		DIE(aTHX_ "Can't goto subroutine outside a subroutine");
+	    }
 	    if (cxix < cxstack_ix)
 		dounwind(cxix);
 	    TOPBLOCK(cx);
 	    SPAGAIN;
 	    /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
 	    if (CxTYPE(cx) == CXt_EVAL) {
+		SvREFCNT_dec(cv);
 		if (CxREALEVAL(cx))
 		/* diag_listed_as: Can't goto subroutine from an eval-%s */
 		    DIE(aTHX_ "Can't goto subroutine from an eval-string");
@@ -2814,7 +2818,10 @@ PP(pp_goto)
 		    DIE(aTHX_ "Can't goto subroutine from an eval-block");
 	    }
 	    else if (CxMULTICALL(cx))
+	    {
+		SvREFCNT_dec(cv);
 		DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
+	    }
 	    if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
 		AV* av = cx->blk_sub.argarray;
 
diff --git a/t/op/svleak.t b/t/op/svleak.t
index ceaf480..16461b9 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 60;
+plan tests => 63;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -72,6 +72,10 @@ leak(5, 1, sub {push @a,1;},       "basic check 3 of leak test infrastructure");
 
 eleak(2, 0, 'sub{<*>}');
 
+eleak(2, 0, 'goto sub {}', 'goto &sub in eval');
+eleak(2, 0, '() = sort { goto sub {} } 1,2', 'goto &sub in sort');
+eleak(2, 0, '/(?{ goto sub {} })/', 'goto &sub in regexp');
+
 sub TIEARRAY	{ bless [], $_[0] }
 sub FETCH	{ $_[0]->[$_[1]] }
 sub STORE	{ $_[0]->[$_[1]] = $_[2] }
-- 
2.7.4