This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid leaks when calling mg_set() in leave_scope()
authorDavid Mitchell <davem@iabyn.com>
Fri, 11 Dec 2015 12:06:39 +0000 (12:06 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 11 Dec 2015 12:14:57 +0000 (12:14 +0000)
In leave_scope() in places like SAVEt_SV, it does stuff like

    if (SvSMAGICAL(...))
        mg_set(...)
    SvREFCNT_dec_NN(ARG0_SV)

If mg_set() dies (e.g. it calls STORE() and STORE() dies), then ARG0_SV
would leak. Fix this by putting ARG0_SV back in the save stack in this
case.

A similar thing applies to SAVEt_AV and SAVEt_HV, but I couldn't
think of a simple test for those, as tied array and hashes don't have
set magic (just RMG).

Also, SAVEt_AV and SAVEt_HV share a lot of common code, so I made
SAVEt_HV goto into the SAVEt_AV code block for the common part.

scope.c
t/op/svleak.t

diff --git a/scope.c b/scope.c
index 7df465f..e5687f4 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -841,9 +841,18 @@ Perl_leave_scope(pTHX_ I32 base)
            *svp = ARG0_SV;
            SvREFCNT_dec(sv);
             if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
+                /* mg_set could die, skipping the freeing of ARG0_SV and
+                 * refsv; Ensure that they're always freed in that case */
+                dSS_ADD;
+                SS_ADD_PTR(ARG0_SV);
+                SS_ADD_UV(SAVEt_FREESV);
+                SS_ADD_PTR(refsv);
+                SS_ADD_UV(SAVEt_FREESV);
+                SS_ADD_END(4);
                 PL_localizing = 2;
                 mg_set(ARG0_SV);
                 PL_localizing = 0;
+                break;
             }
            SvREFCNT_dec_NN(ARG0_SV);
            SvREFCNT_dec(refsv);
@@ -898,23 +907,25 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_AV:                          /* array reference */
            SvREFCNT_dec(GvAV(ARG1_GV));
            GvAV(ARG1_GV) = ARG0_AV;
+          avhv_common:
             if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
+                /* mg_set might die, so make sure ARG1 isn't leaked */
+                dSS_ADD;
+                SS_ADD_PTR(ARG1_SV);
+                SS_ADD_UV(SAVEt_FREESV);
+                SS_ADD_END(2);
                 PL_localizing = 2;
                 mg_set(ARG0_SV);
                 PL_localizing = 0;
+                break;
             }
            SvREFCNT_dec_NN(ARG1_GV);
            break;
        case SAVEt_HV:                          /* hash reference */
            SvREFCNT_dec(GvHV(ARG1_GV));
            GvHV(ARG1_GV) = ARG0_HV;
-            if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
-                PL_localizing = 2;
-                mg_set(ARG0_SV);
-                PL_localizing = 0;
-            }
-           SvREFCNT_dec_NN(ARG1_GV);
-           break;
+            goto avhv_common;
+
        case SAVEt_INT_SMALL:
            *(int*)ARG0_PTR = (int)(uv >> SAVE_TIGHT_SHIFT);
            break;
index 076f2bf..4c7a493 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 129;
+plan tests => 130;
 
 # 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
@@ -493,3 +493,27 @@ $x = $mdr::a[0]{foo}{$mdr::k}{$mdr::i};
 $x = $mdr::h[0]{foo}{$mdr::k}{$mdr::i};
 $x = $mdr::r->[0]{foo}{$mdr::k}{$mdr::i};
 EOF
+
+# un-localizing a tied (or generally magic) item could leak if the things
+# called by mg_set() died
+
+{
+    package MG_SET;
+
+    sub TIESCALAR {  bless [] }
+    sub FETCH { 1; }
+    my $do_die = 0;
+    sub STORE { die if $do_die; }
+
+    sub f {
+        local $s;
+        tie $s, 'MG_SET';
+        local $s;
+        $do_die = 1;
+    }
+    sub g {
+        eval { my $x = f(); };
+    }
+
+    ::leak(5,0, \&g, "MG_SET");
+}