summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--cv.h5
-rw-r--r--op.c24
-rw-r--r--perl.c1
-rw-r--r--pp.c7
-rw-r--r--pp_ctl.c4
-rw-r--r--pp_hot.c11
6 files changed, 38 insertions, 14 deletions
diff --git a/cv.h b/cv.h
index b08cf5c1d0..d94fb45b62 100644
--- a/cv.h
+++ b/cv.h
@@ -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)
diff --git a/op.c b/op.c
index 3ab85b3545..eecde67660 100644
--- a/op.c
+++ b/op.c
@@ -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);
diff --git a/perl.c b/perl.c
index d4c626c7f5..aa6a1a4d8b 100644
--- a/perl.c
+++ b/perl.c
@@ -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);
diff --git a/pp.c b/pp.c
index e071ee3c07..db4276e5a1 100644
--- a/pp.c
+++ b/pp.c
@@ -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;
diff --git a/pp_ctl.c b/pp_ctl.c
index 332ae4831d..1350de4196 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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 */
diff --git a/pp_hot.c b/pp_hot.c
index 41ad9f4893..9633d54e88 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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");