diff options
| -rw-r--r-- | pp_ctl.c | 50 | ||||
| -rw-r--r-- | t/op/eval.t | 13 |
2 files changed, 61 insertions, 2 deletions
@@ -3752,7 +3752,55 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) if (PL_unitcheckav) { OP *es = PL_eval_start; - call_list(PL_scopestack_ix, PL_unitcheckav); + if (in_require) { + call_list(PL_scopestack_ix, PL_unitcheckav); + } else { + /* TODO: are we sure we shouldn't do JMPENV_PUSH in + * when `in_require` is true? */ + int ret=0; + dJMPENV; + JMPENV_PUSH(ret); + switch (ret) { + case 0: + /* + * Doesn't seem like PUSHMARK(SP)/ENTER + * is needed here. */ + + call_list(PL_scopestack_ix, PL_unitcheckav); + /* Nor LEAVE here. */ + break; + case 3: { + /* call_list failed and threw an error */ + + /* Restore PL_OP */ + PL_op = saveop; + + SV *errsv = ERRSV; + if (!*(SvPV_nolen_const(errsv))) { + /* This happens when using: + * eval qq# UNITCHECK { die "\x00"; } #; + */ + sv_setpvs(errsv, "Unit check error"); + } + + /* We're returning so POP our JMPENV */ + /* NOTE: in `S_try_yyparse` the default for ret=3 is to + * break which falls back to the `JMPENV_POP` + * after the switch. In this code we're returning + * early so we must POP it outrself. */ + JMPENV_POP; + + if (gimme != G_LIST) PUSHs(&PL_sv_undef); + PUTBACK; + return FALSE; + } + default: + JMPENV_POP; + JMPENV_JUMP(ret); + NOT_REACHED; /* NOTREACHED */ + } + JMPENV_POP; + } PL_eval_start = es; } diff --git a/t/op/eval.t b/t/op/eval.t index 9add15f34b..71d48556a3 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc('../lib'); } -plan(tests => 146); +plan(tests => 149); eval 'pass();'; @@ -716,3 +716,14 @@ pass("eval in freed package does not crash"); ::is($x,2,'BEGIN really did nothing'); } + +{ + # make sure that none of these segfault. + foreach my $line ( + 'eval "UNITCHECK { eval q(UNITCHECK { die; }); print q(A-) }";', + 'eval "UNITCHECK { eval q(BEGIN { die; }); print q(A-) }";', + 'eval "BEGIN { eval q(UNITCHECK { die; }); print q(A-) }";', + ) { + fresh_perl_is($line . ' print "ok";', "A-ok", {}, "No segfault: $line"); + } +} |