diff options
Diffstat (limited to 'op.c')
-rw-r--r-- | op.c | 45 |
1 files changed, 40 insertions, 5 deletions
@@ -4365,6 +4365,10 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) void Perl_cv_undef(pTHX_ CV *cv) { + CV *outsidecv; + CV *freecv = Nullcv; + bool is_eval = CvEVAL(cv) && !CvGV(cv); /* is this eval"" ? */ + #ifdef USE_5005THREADS if (CvMUTEXP(cv)) { MUTEX_DESTROY(CvMUTEXP(cv)); @@ -4400,13 +4404,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); @@ -4415,10 +4420,38 @@ 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; + AV *padlist = CvPADLIST(cv); + I32 ix; + if (is_eval) { + /* inner references to eval's cv must be fixed up */ + AV *comppad_name = (AV*)AvARRAY(padlist)[0]; + AV *comppad = (AV*)AvARRAY(padlist)[1]; + SV **namepad = AvARRAY(comppad_name); + SV **curpad = AvARRAY(comppad); + 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 (innercv && 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) @@ -4433,6 +4466,8 @@ Perl_cv_undef(pTHX_ CV *cv) } CvPADLIST(cv) = Nullav; } + else if (freecv) + SvREFCNT_dec(freecv); if (CvXSUB(cv)) { CvXSUB(cv) = 0; } |