Skip to content

Commit 676a678

Browse files
author
Zefram
committed
narrower localisation of PL_compcv around eval
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.
1 parent fde6729 commit 676a678

File tree

2 files changed

+19
-14
lines changed

2 files changed

+19
-14
lines changed

dump.c

+1-1
Original file line numberDiff line numberDiff line change
@@ -2195,7 +2195,7 @@ S_deb_curcv(pTHX_ const I32 ix)
21952195
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
21962196
return cx->blk_sub.cv;
21972197
else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
2198-
return PL_compcv;
2198+
return cx->blk_eval.cv;
21992199
else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
22002200
return PL_main_cv;
22012201
else if (ix <= 0)

pp_ctl.c

+18-13
Original file line numberDiff line numberDiff line change
@@ -3410,7 +3410,7 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
34103410
return cv;
34113411
}
34123412
else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
3413-
return PL_compcv;
3413+
return cx->blk_eval.cv;
34143414
}
34153415
}
34163416
return PL_main_cv;
@@ -3470,31 +3470,31 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
34703470
COP * const oldcurcop = PL_curcop;
34713471
bool in_require = (saveop && saveop->op_type == OP_REQUIRE);
34723472
int yystatus;
3473+
CV *evalcv;
34733474

34743475
PL_in_eval = (in_require
34753476
? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
34763477
: EVAL_INEVAL);
34773478

34783479
PUSHMARK(SP);
34793480

3480-
SAVESPTR(PL_compcv);
3481-
PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
3482-
CvEVAL_on(PL_compcv);
3481+
evalcv = MUTABLE_CV(newSV_type(SVt_PVCV));
3482+
CvEVAL_on(evalcv);
34833483
assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
3484-
cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
3484+
cxstack[cxstack_ix].blk_eval.cv = evalcv;
34853485
cxstack[cxstack_ix].blk_gimme = gimme;
34863486

3487-
CvOUTSIDE_SEQ(PL_compcv) = seq;
3488-
CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
3487+
CvOUTSIDE_SEQ(evalcv) = seq;
3488+
CvOUTSIDE(evalcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
34893489

34903490
/* set up a scratch pad */
34913491

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

34953495

34963496
if (!PL_madskills)
3497-
SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */
3497+
SAVEMORTALIZESV(evalcv); /* must remain until end of current statement */
34983498

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

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

3518+
if (!startop) ENTER_with_name("evalcomp");
3519+
SAVESPTR(PL_compcv);
3520+
PL_compcv = evalcv;
3521+
35183522
/* try to compile it */
35193523

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

35273531
if (!startop) {
3528-
ENTER_with_name("evalcomp");
35293532
SAVEHINTS();
35303533
if (in_require) {
35313534
PL_hints = 0;
@@ -3668,7 +3671,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
36683671

36693672
/* compiled okay, so do it */
36703673

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

42964300
PERL_ASYNC_CHECK();
42974301
POPBLOCK(cx,newpm);
42984302
POPEVAL(cx);
42994303
namesv = cx->blk_eval.old_namesv;
43004304
retop = cx->blk_eval.retop;
4305+
evalcv = cx->blk_eval.cv;
43014306

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

43074312
#ifdef DEBUGGING
4308-
assert(CvDEPTH(PL_compcv) == 1);
4313+
assert(CvDEPTH(evalcv) == 1);
43094314
#endif
4310-
CvDEPTH(PL_compcv) = 0;
4315+
CvDEPTH(evalcv) = 0;
43114316

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

0 commit comments

Comments
 (0)