Skip to content

Commit

Permalink
narrower localisation of PL_compcv around eval
Browse files Browse the repository at this point in the history
PL_compcv used to be localised around the entire string eval process,
and hence at runtime of the evaled code would refer to the evaled code
rather than code of a surrounding compilation.  This interfered with the
ability of string-evaled code in a BEGIN block to affect the surrounding
compilation, in a similar way to the localisation of $^H and %^H that
was fixed in f45b078.

Similar to the fix there, this change moves the localisation of PL_compcv
inside the new evalcomp scope.  A couple of things were relying on
PL_compcv to find the running code when in a string-eval scope; they now
need to find it from cx->blk_eval.cv, which was already being populated.
  • Loading branch information
Zefram committed Nov 19, 2011
1 parent fde6729 commit 676a678
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 14 deletions.
2 changes: 1 addition & 1 deletion dump.c
Original file line number Diff line number Diff line change
Expand Up @@ -2195,7 +2195,7 @@ S_deb_curcv(pTHX_ const I32 ix)
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
return cx->blk_sub.cv;
else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
return PL_compcv;
return cx->blk_eval.cv;
else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
return PL_main_cv;
else if (ix <= 0)
Expand Down
31 changes: 18 additions & 13 deletions pp_ctl.c
Original file line number Diff line number Diff line change
Expand Up @@ -3410,7 +3410,7 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
return cv;
}
else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
return PL_compcv;
return cx->blk_eval.cv;
}
}
return PL_main_cv;
Expand Down Expand Up @@ -3470,31 +3470,31 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
COP * const oldcurcop = PL_curcop;
bool in_require = (saveop && saveop->op_type == OP_REQUIRE);
int yystatus;
CV *evalcv;

PL_in_eval = (in_require
? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
: EVAL_INEVAL);

PUSHMARK(SP);

SAVESPTR(PL_compcv);
PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvEVAL_on(PL_compcv);
evalcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvEVAL_on(evalcv);
assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
cxstack[cxstack_ix].blk_eval.cv = evalcv;
cxstack[cxstack_ix].blk_gimme = gimme;

CvOUTSIDE_SEQ(PL_compcv) = seq;
CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
CvOUTSIDE_SEQ(evalcv) = seq;
CvOUTSIDE(evalcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));

/* set up a scratch pad */

CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
CvPADLIST(evalcv) = pad_new(padnew_SAVE);
PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */


if (!PL_madskills)
SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */
SAVEMORTALIZESV(evalcv); /* must remain until end of current statement */

/* make sure we compile in the right package */

Expand All @@ -3515,6 +3515,10 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
PL_madskills = 0;
#endif

if (!startop) ENTER_with_name("evalcomp");
SAVESPTR(PL_compcv);
PL_compcv = evalcv;

/* try to compile it */

PL_eval_root = NULL;
Expand All @@ -3525,7 +3529,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
CLEAR_ERRSV();

if (!startop) {
ENTER_with_name("evalcomp");
SAVEHINTS();
if (in_require) {
PL_hints = 0;
Expand Down Expand Up @@ -3668,7 +3671,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)

/* compiled okay, so do it */

CvDEPTH(PL_compcv) = 1;
CvDEPTH(evalcv) = 1;
SP = PL_stack_base + POPMARK; /* pop original mark */
PL_op = saveop; /* The caller may need it. */
PL_parser->lex_state = LEX_NOTPARSING; /* $^S needs this. */
Expand Down Expand Up @@ -4292,22 +4295,24 @@ PP(pp_leaveeval)
const U8 save_flags = PL_op -> op_flags;
I32 optype;
SV *namesv;
CV *evalcv;

PERL_ASYNC_CHECK();
POPBLOCK(cx,newpm);
POPEVAL(cx);
namesv = cx->blk_eval.old_namesv;
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;

TAINT_NOT;
SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
gimme, SVs_TEMP);
PL_curpm = newpm; /* Don't pop $1 et al till now */

#ifdef DEBUGGING
assert(CvDEPTH(PL_compcv) == 1);
assert(CvDEPTH(evalcv) == 1);
#endif
CvDEPTH(PL_compcv) = 0;
CvDEPTH(evalcv) = 0;

if (optype == OP_REQUIRE &&
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
Expand Down

0 comments on commit 676a678

Please sign in to comment.