[perl #107000] Don’t leak if hh copying dies

When %^H is copied on entering a new scope, if it happens to have been
tied it can die.  This was resulting in leaks, because no protections
were added to handle that case.

The two things that were leaking were the new hash in hv_copy_hints_hv
and the new value (for an element) in newSVsv.

By fixing newSVsv itself, this also fixes any potential leaks when
other pieces of code call newSVsv on explosive values.

diff --git a/hv.c b/hv.c
index 14f3399..d542462 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1462,6 +1462,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
        const I32 riter = HvRITER_get(ohv);
        HE * const eiter = HvEITER_get(ohv);
 
+       ENTER;
+       SAVEFREESV(hv);
+
        while (hv_max && hv_max + 1 >= hv_fill * 2)
            hv_max = hv_max / 2;
        HvMAX(hv) = hv_max;
@@ -1483,6 +1486,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
        }
        HvRITER_set(ohv, riter);
        HvEITER_set(ohv, eiter);
+
+       SvREFCNT_inc_simple_void_NN(hv);
+       LEAVE;
     }
     hv_magic(hv, NULL, PERL_MAGIC_hints);
     return hv;

diff --git a/sv.c b/sv.c
index 1d42afb..8ba2116 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8709,11 +8709,12 @@ Perl_newSVsv(pTHX_ register SV *const old)
        Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
        return NULL;
     }
+    /* Do this here, otherwise we leak the new SV if this croaks. */
+    SvGETMAGIC(old);
     new_SV(sv);
-    /* SV_GMAGIC is the default for sv_setv()
-       SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+    /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
        with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
-    sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
+    sv_setsv_flags(sv, old, SV_NOSTEAL);
     return sv;
 }
 

diff --git a/t/op/svleak.t b/t/op/svleak.t
index d975cf1..82d7e16 100644 (file)
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 31;
+plan tests => 32;
 
 # 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
@@ -217,3 +217,22 @@ leak(2, 0, sub {
     eval {@a = ($x)};
 }, 'array assignment does not leak');
 
+# [perl #107000]
+package hhtie {
+    sub TIEHASH { bless [] }
+    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
+    sub FETCH    { die if $explosive; $_[0][0]{$_[1]} }
+    sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} }
+    sub NEXTKEY  { each %{$_[0][0]} }
+}
+leak(2,!!$Config{mad}, sub {
+    eval q`
+       BEGIN {
+           $hhtie::explosive = 0;
+           tie %^H, hhtie;
+           $^H{foo} = bar;
+           $hhtie::explosive = 1;
+       }
+       { 1; }
+    `;
+}, 'hint-hash copying does not leak');