Stop goto &sub from leaking when it croaks
authorFather Chrysostomos <sprout@cpan.org>
Tue, 13 Nov 2012 00:04:07 +0000 (16:04 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 13 Nov 2012 08:01:33 +0000 (00:01 -0800)
pp_ctl.c
t/op/svleak.t

index 22e1cea..0df8b0c 100644 (file)
--- 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;
 
index ceaf480..16461b9 100644 (file)
@@ -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] }