diff options
| -rw-r--r-- | op.c | 42 | ||||
| -rw-r--r-- | t/run/kill_perl.t | 10 |
2 files changed, 47 insertions, 5 deletions
@@ -4216,6 +4216,9 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) void Perl_cv_undef(pTHX_ CV *cv) { + CV *outsidecv; + CV *freecv = Nullcv; + #ifdef USE_5005THREADS if (CvMUTEXP(cv)) { MUTEX_DESTROY(CvMUTEXP(cv)); @@ -4251,13 +4254,14 @@ Perl_cv_undef(pTHX_ CV *cv) } SvPOK_off((SV*)cv); /* forget prototype */ CvGV(cv) = Nullgv; + outsidecv = CvOUTSIDE(cv); /* Since closure prototypes have the same lifetime as the containing * CV, they don't hold a refcount on the outside CV. This avoids * the refcount loop between the outer CV (which keeps a refcount to * the closure prototype in the pad entry for pp_anoncode()) and the * closure prototype, and the ensuing memory leak. --GSAR */ if (!CvANON(cv) || CvCLONED(cv)) - SvREFCNT_dec(CvOUTSIDE(cv)); + freecv = outsidecv; CvOUTSIDE(cv) = Nullcv; if (CvCONST(cv)) { SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr); @@ -4266,10 +4270,36 @@ Perl_cv_undef(pTHX_ CV *cv) if (CvPADLIST(cv)) { /* may be during global destruction */ if (SvREFCNT(CvPADLIST(cv))) { - I32 i = AvFILLp(CvPADLIST(cv)); - while (i >= 0) { - SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); - SV* sv = svp ? *svp : Nullsv; + /* inner references to cv must be fixed up */ + AV *padlist = CvPADLIST(cv); + AV *comppad_name = (AV*)AvARRAY(padlist)[0]; + AV *comppad = (AV*)AvARRAY(padlist)[1]; + SV **namepad = AvARRAY(comppad_name); + SV **curpad = AvARRAY(comppad); + I32 ix; + for (ix = AvFILLp(comppad_name); ix > 0; ix--) { + SV *namesv = namepad[ix]; + if (namesv && namesv != &PL_sv_undef + && *SvPVX(namesv) == '&') + { + CV *innercv = (CV*)curpad[ix]; + if (SvTYPE(innercv) == SVt_PVCV + && CvOUTSIDE(innercv) == cv) + { + CvOUTSIDE(innercv) = outsidecv; + if (!CvANON(innercv) || CvCLONED(innercv)) { + (void)SvREFCNT_inc(outsidecv); + if (SvREFCNT(cv)) + SvREFCNT_dec(cv); + } + } + } + } + if (freecv) + SvREFCNT_dec(freecv); + ix = AvFILLp(padlist); + while (ix >= 0) { + SV* sv = AvARRAY(padlist)[ix--]; if (!sv) continue; if (sv == (SV*)PL_comppad_name) @@ -4284,6 +4314,8 @@ Perl_cv_undef(pTHX_ CV *cv) } CvPADLIST(cv) = Nullav; } + else if (freecv) + SvREFCNT_dec(freecv); if (CvXSUB(cv)) { CvXSUB(cv) = 0; } diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t index 6345a793a4..09e7d9c6d2 100644 --- a/t/run/kill_perl.t +++ b/t/run/kill_perl.t @@ -629,6 +629,16 @@ EOT EXPECT ok ######## +# test that closures generated by eval"" hold on to the CV of the eval"" +# for their entire lifetime +$code = eval q[ + sub { eval '$x = "ok 1\n"'; } +]; +&{$code}(); +print $x; +EXPECT +ok 1 +######## # This test is here instead of pragma/locale.t because # the bug depends on in the internal state of the locale # settings and pragma/locale messes up that state pretty badly. |