diff options
| -rw-r--r-- | cv.h | 5 | ||||
| -rw-r--r-- | op.c | 24 | ||||
| -rw-r--r-- | perl.c | 1 | ||||
| -rw-r--r-- | pp.c | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | pp_hot.c | 11 |
6 files changed, 38 insertions, 14 deletions
@@ -47,6 +47,7 @@ struct xpvcv { #define CVf_CLONED 0x02 /* a clone of one of those */ #define CVf_ANON 0x04 /* CvGV() can't be trusted */ #define CVf_OLDSTYLE 0x08 +#define CVf_UNIQUE 0x10 /* can't be cloned */ #define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE) #define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE) @@ -63,3 +64,7 @@ struct xpvcv { #define CvOLDSTYLE(cv) (CvFLAGS(cv) & CVf_OLDSTYLE) #define CvOLDSTYLE_on(cv) (CvFLAGS(cv) |= CVf_OLDSTYLE) #define CvOLDSTYLE_off(cv) (CvFLAGS(cv) &= ~CVf_OLDSTYLE) + +#define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE) +#define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE) +#define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE) @@ -195,7 +195,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) depth = CvDEPTH(cv); if (!depth) { - if (newoff && (CvANON(cv) || CvGV(cv))) + if (newoff && !CvUNIQUE(cv)) return 0; /* don't clone inactive sub's stack frame */ depth = 1; } @@ -210,14 +210,16 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) SvNVX(sv) = (double)curcop->cop_seq; SvIVX(sv) = 999999999; /* A ref, intro immediately */ SvFLAGS(sv) |= SVf_FAKE; - /* "It's closures all the way down." */ - CvCLONE_on(compcv); - if (cv != startcv) { - CV *bcv; - for (bcv = startcv; - bcv && bcv != cv && !CvCLONE(bcv); - bcv = CvOUTSIDE(bcv)) - CvCLONE_on(bcv); + if (!CvUNIQUE(cv)) { + /* "It's closures all the way down." */ + CvCLONE_on(compcv); + if (cv != startcv) { + CV *bcv; + for (bcv = startcv; + bcv && bcv != cv && !CvCLONE(bcv); + bcv = CvOUTSIDE(bcv)) + CvCLONE_on(bcv); + } } } av_store(comppad, newoff, SvREFCNT_inc(oldsv)); @@ -2798,11 +2800,13 @@ CV* cv; cv, (CvANON(cv) ? "ANON" : (cv == main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" : CvGV(cv) ? GvNAME(CvGV(cv)) : "?mystery?"), outside, (!outside ? "null" : CvANON(outside) ? "ANON" : (outside == main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" : CvGV(outside) ? GvNAME(CvGV(outside)) : "?mystery?")); for (ix = 1; ix <= AvFILL(pad); ix++) { @@ -2830,6 +2834,8 @@ CV* outside; AV* comppadlist; CV* cv; + assert(!CvUNIQUE(proto)); + ENTER; SAVESPTR(curpad); SAVESPTR(comppad); @@ -562,6 +562,7 @@ setuid perl scripts securely.\n"); compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); + CvUNIQUE_on(compcv); comppad = newAV(); av_push(comppad, Nullsv); @@ -248,8 +248,11 @@ PP(pp_rv2cv) /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */ /* (But not in defined().) */ CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL)); - - if (!cv) + if (cv) { + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + } + else cv = (CV*)&sv_undef; SETs((SV*)cv); RETURN; @@ -1926,7 +1926,7 @@ int gimme; SAVESPTR(compcv); compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); - CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller); + CvUNIQUE_on(compcv); comppad = newAV(); comppad_name = newAV(); @@ -1941,6 +1941,8 @@ int gimme; av_store(comppadlist, 0, (SV*)comppad_name); av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller); + SAVEFREESV(compcv); /* make sure we compile in the right package */ @@ -1682,7 +1682,8 @@ PP(pp_entersub) register CV *cv; register CONTEXT *cx; I32 gimme; - I32 hasargs = (op->op_flags & OPf_STACKED) != 0; + bool hasargs = (op->op_flags & OPf_STACKED) != 0; + bool may_clone = TRUE; if (!sv) DIE("Not a CODE reference"); @@ -1702,14 +1703,17 @@ PP(pp_entersub) break; } cv = (CV*)SvRV(sv); - if (SvTYPE(cv) == SVt_PVCV) + if (SvTYPE(cv) == SVt_PVCV) { + may_clone = FALSE; break; + } /* FALL THROUGH */ case SVt_PVHV: case SVt_PVAV: DIE("Not a CODE reference"); case SVt_PVCV: cv = (CV*)sv; + may_clone = FALSE; break; case SVt_PVGV: if (!(cv = GvCV((GV*)sv))) @@ -1720,6 +1724,9 @@ PP(pp_entersub) ENTER; SAVETMPS; + if (may_clone && cv && CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + retry: if (!cv) DIE("Not a CODE reference"); |