Stop format closure fatal warnings from leaking
authorFather Chrysostomos <sprout@cpan.org>
Fri, 30 Nov 2012 17:50:35 +0000 (09:50 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 1 Dec 2012 02:02:36 +0000 (18:02 -0800)
pad.c
t/op/svleak.t

diff --git a/pad.c b/pad.c
index dd348f7..dee5c1c 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1968,7 +1968,7 @@ the immediately surrounding code.
 static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
 
 static void
-S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
+S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 {
     dVAR;
     I32 ix;
@@ -2018,6 +2018,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     ENTER;
     SAVESPTR(PL_compcv);
     PL_compcv = cv;
+    if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */
 
     if (CvHASEVAL(cv))
        CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
@@ -2112,6 +2113,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
                S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv);
        }
 
+    if (newcv) SvREFCNT_inc_simple_void_NN(cv);
     LEAVE;
 }
 
@@ -2119,6 +2121,7 @@ static CV *
 S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
 {
     dVAR;
+    const bool newcv = !cv;
 
     assert(!CvUNIQUE(proto));
 
@@ -2144,7 +2147,7 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
     if (SvMAGIC(proto))
        mg_copy((SV *)proto, (SV *)cv, 0, 0);
 
-    if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside);
+    if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside, newcv);
 
     DEBUG_Xv(
        PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
index 914ab10..59ff7f8 100644 (file)
@@ -95,10 +95,10 @@ eleak(2, 0, "$all XS::APItest::newCONSTSUB(\\%main::=>name=>0=>1)",
      'newCONSTSUB sub redefinition with fatal warnings');
 eleak(2, 0, "$f 'misc'; my\$a,my\$a", 'double my with fatal warnings');
 eleak(2, 0, "$f 'misc'; our\$a,our\$a", 'double our with fatal warnings');
-$::TODO = 'still leaks';
 eleak(2, 0, "$f 'closure';
              sub foo { my \$x; format=\n\@\n\$x\n.\n} write; ",
      'format closing over unavailable var with fatal warnings');
+$::TODO = 'still leaks';
 eleak(2, 0, "$all /(?{})?/ ", '(?{})? with fatal warnings');
 eleak(2, 0, "$all /(?{})+/ ", '(?{})+ with fatal warnings');
 eleak(2, 0, "$all /[\\i]/ ", 'invalid charclass escape with fatal warns');