summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2002-01-25 16:28:40 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2002-01-25 16:28:40 +0000
commit9e53291561fb0b9587025e8b98535441b489e207 (patch)
treea7c3b4efcd28a275e352efba839f19fb45cbd87b /op.c
parent71e41b3a4c997410fc99bbdf7f8cdcb35863d5be (diff)
downloadperl-9e53291561fb0b9587025e8b98535441b489e207.tar.gz
Integrate changes 13474+13478+13584 from maintperl;
anon sub leakage. p4raw-id: //depot/perl@14418 p4raw-edited: from //depot/maint-5.6/perl@14417 'ignore' op.c (@13478..)
Diffstat (limited to 'op.c')
-rw-r--r--op.c45
1 files changed, 40 insertions, 5 deletions
diff --git a/op.c b/op.c
index bd53644b4b..e68e4317fd 100644
--- a/op.c
+++ b/op.c
@@ -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;
}