In perl.git, the branch maint-5.12 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/691367f8ef160b3a115f819740efc779931f80dc?hp=69d3e0cf7e09cf7b85af962849cdf01814c0789a>
- Log ----------------------------------------------------------------- commit 691367f8ef160b3a115f819740efc779931f80dc Author: Vincent Pit <[email protected]> Date: Sun Apr 25 17:53:28 2010 +0200 Save the popped cx->blk_eval.old_namesv before calling LEAVE It's fine to still refer to cx members between POPEVAL and LEAVE, but there are a few places where the namesv is read after LEAVE happens. This is bad because LEAVE can call arbitrary code ; in particular, it can call a destructor that does call_sv(cv, G_EVAL), in which case the old eval context cx gets overwritten by the new one and cx->blk_eval.old_namesv points to garbage. ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 42 ++++++++++++++++++++++++++++++------------ 1 files changed, 30 insertions(+), 12 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 61793dd..e72049a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1619,6 +1619,7 @@ Perl_die_where(pTHX_ SV *msv) if (cxix >= 0) { I32 optype; + SV *namesv; register PERL_CONTEXT *cx; SV **newsp; @@ -1634,6 +1635,7 @@ Perl_die_where(pTHX_ SV *msv) my_exit(1); } POPEVAL(cx); + namesv = cx->blk_eval.old_namesv; if (gimme == G_SCALAR) *++newsp = &PL_sv_undef; @@ -1649,8 +1651,8 @@ Perl_die_where(pTHX_ SV *msv) if (optype == OP_REQUIRE) { const char* const msg = SvPVx_nolen_const(ERRSV); - SV * const nsv = cx->blk_eval.old_namesv; - (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), + (void)hv_store(GvHVn(PL_incgv), + SvPVX_const(namesv), SvCUR(namesv), &PL_sv_undef, 0); DIE(aTHX_ "%sCompilation failed in require", *msg ? msg : "Unknown error\n"); @@ -2112,6 +2114,7 @@ PP(pp_return) SV **newsp; PMOP *newpm; I32 optype = 0; + SV *namesv; SV *sv; OP *retop = NULL; @@ -2154,6 +2157,7 @@ PP(pp_return) if (!(PL_in_eval & EVAL_KEEPERR)) clear_errsv = TRUE; POPEVAL(cx); + namesv = cx->blk_eval.old_namesv; retop = cx->blk_eval.retop; if (CxTRYBLOCK(cx)) break; @@ -2162,9 +2166,10 @@ PP(pp_return) (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { /* Unassume the success we assumed earlier. */ - SV * const nsv = cx->blk_eval.old_namesv; - (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); - DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv)); + (void)hv_delete(GvHVn(PL_incgv), + SvPVX_const(namesv), SvCUR(namesv), + G_DISCARD); + DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv)); } break; case CXt_FORMAT: @@ -3109,8 +3114,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) CLEAR_ERRSV(); if (yyparse() || PL_parser->error_count || !PL_eval_root) { SV **newsp; /* Used by POPBLOCK. */ - PERL_CONTEXT *cx = &cxstack[cxstack_ix]; + PERL_CONTEXT *cx = NULL; I32 optype = 0; /* Might be reset by POPEVAL. */ + SV *namesv = NULL; const char *msg; PL_op = saveop; @@ -3122,15 +3128,23 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) if (!startop) { POPBLOCK(cx,PL_curpm); POPEVAL(cx); + namesv = cx->blk_eval.old_namesv; } lex_end(); LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */ msg = SvPVx_nolen_const(ERRSV); if (optype == OP_REQUIRE) { - const SV * const nsv = cx->blk_eval.old_namesv; - (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), - &PL_sv_undef, 0); + if (!cx) { + /* If cx is still NULL, it means that we didn't go in the + * POPEVAL branch. */ + cx = &cxstack[cxstack_ix]; + assert(CxTYPE(cx) == CXt_EVAL); + namesv = cx->blk_eval.old_namesv; + } + (void)hv_store(GvHVn(PL_incgv), + SvPVX_const(namesv), SvCUR(namesv), + &PL_sv_undef, 0); Perl_croak(aTHX_ "%sCompilation failed in require", *msg ? msg : "Unknown error\n"); } @@ -3828,9 +3842,11 @@ PP(pp_leaveeval) OP *retop; const U8 save_flags = PL_op -> op_flags; I32 optype; + SV *namesv; POPBLOCK(cx,newpm); POPEVAL(cx); + namesv = cx->blk_eval.old_namesv; retop = cx->blk_eval.retop; TAINT_NOT; @@ -3871,9 +3887,11 @@ PP(pp_leaveeval) !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp)) { /* Unassume the success we assumed earlier. */ - SV * const nsv = cx->blk_eval.old_namesv; - (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); - retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv)); + (void)hv_delete(GvHVn(PL_incgv), + SvPVX_const(namesv), SvCUR(namesv), + G_DISCARD); + retop = Perl_die(aTHX_ "%"SVf" did not return a true value", + SVfARG(namesv)); /* die_where() did LEAVE, or we won't be here */ } else { -- Perl5 Master Repository
