avoid leaking @_ in goto

pp_goto temporarily bumps the reference count of @_ while doing
LEAVE_SCOPE(), to stop it getting prematurelly freed. If something
dies during the save stack unwinding, it will leak.
Instead, make it mortal.

diff --git a/pp_ctl.c b/pp_ctl.c
index 51555d5..7b1a068 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2747,10 +2747,9 @@ PP(pp_goto)
                else CLEAR_ARGARRAY(av);
            }
 
-            /* protect @_ during save stack unwind. We donate this
-             * refcount later to the callee’s pad for the non-XS case;
-             * otherwise we decrement it later. */
-           SvREFCNT_inc_simple_void(arg);
+            /* protect @_ during save stack unwind. */
+            if (arg)
+                SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
 
            assert(PL_scopestack_ix == cx->blk_oldscopesp);
            oldsave = PL_scopestack[cx->blk_oldscopesp - 1];
@@ -2766,7 +2765,6 @@ PP(pp_goto)
             * our precious cv.  See bug #99850. */
            if (!CvROOT(cv) && !CvXSUB(cv)) {
                const GV * const gv = CvGV(cv);
-               SvREFCNT_dec(arg);
                if (gv) {
                    SV * const tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
@@ -2816,7 +2814,6 @@ PP(pp_goto)
                    }
                }
                SP += items;
-               SvREFCNT_dec(arg);
                if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                    /* Restore old @_ */
                     POP_SAVEARRAY();
@@ -2861,6 +2858,7 @@ PP(pp_goto)
                    if (arg) {
                        SvREFCNT_dec(PAD_SVl(0));
                        PAD_SVl(0) = (SV *)arg;
+                        SvREFCNT_inc_simple_void_NN(arg);
                    }
 
                    /* GvAV(PL_defgv) might have been modified on scope
@@ -2871,7 +2869,7 @@ PP(pp_goto)
                        SvREFCNT_dec(av);
                    }
                }
-               else SvREFCNT_dec(arg);
+
                if (PERLDB_SUB) {       /* Checking curstash breaks DProf. */
                    Perl_get_db_sub(aTHX_ NULL, cv);
                    if (PERLDB_GOTO) {

diff --git a/t/op/svleak.t b/t/op/svleak.t
index 4c7a493..595bf3e 100644 (file)
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 130;
+plan tests => 131;
 
 # 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
@@ -517,3 +517,23 @@ EOF
 
     ::leak(5,0, \&g, "MG_SET");
 }
+
+# check that @_ isn't leaked when dieing while goto'ing a new sub
+
+{
+    package my_goto;
+    sub TIEARRAY { bless [] }
+    sub FETCH { 1 }
+    sub STORE { die if $_[0][0]; $_[0][0] = 1 }
+
+    sub f { eval { g() } }
+    sub g {
+        my @a;
+        tie @a, "my_goto";
+        local $a[0];
+        goto &h;
+    }
+    sub h {}
+
+    ::leak(5, 0, \&f, q{goto shouldn't leak @_});
+}