diff options
| author | David Mitchell <davem@iabyn.com> | 2016-06-30 10:12:06 +0100 |
|---|---|---|
| committer | David Mitchell <davem@iabyn.com> | 2016-07-01 09:35:14 +0100 |
| commit | 8c86f0238ecb5f32c2e7fba36e3edfdb54069068 (patch) | |
| tree | 3174d5aeb604bc4585057ec303dc370b5cb8cb11 /pp_ctl.c | |
| parent | 2a1e0dfedad09204e5328c32f1fcf915153a191c (diff) | |
| download | perl-8c86f0238ecb5f32c2e7fba36e3edfdb54069068.tar.gz | |
die_unwind(): mortalise, not mortalcopy the err SV
The error string needs to be preserved while unwinding the stacks,
but doing a simple sv_2mortal() and bumping the reference count seems
sufficient, rather than making a complete copy.
Also, avoid the mortalised SV's buffer from being stolen by using the
SV_NOSTEAL flag rather than unsetting SvTEMP.
Finally, add some basic comments above Perl_die_unwind() explaining what
it's for.
Diffstat (limited to 'pp_ctl.c')
| -rw-r--r-- | pp_ctl.c | 18 |
1 files changed, 13 insertions, 5 deletions
@@ -1636,17 +1636,26 @@ S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action) } +/* die_unwind(): this is the final destination for the various croak() + * functions. If we're in an eval, unwind the context and other stacks + * back to the top-most CXt_EVAL and set $@ to msv; otherwise print msv + * to STDERR and initiate an exit. Note that if the CXt_EVAL popped back + * to is a require the exception will be rethrown, as requires don't + * actually trap exceptions. + */ void Perl_die_unwind(pTHX_ SV *msv) { - SV *exceptsv = sv_mortalcopy(msv); + SV *exceptsv = msv; U8 in_eval = PL_in_eval; PERL_ARGS_ASSERT_DIE_UNWIND; if (in_eval) { I32 cxix; + exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv)); + /* * Historically, perl used to set ERRSV ($@) early in the die * process and rely on it not getting clobbered during unwinding. @@ -1676,10 +1685,9 @@ Perl_die_unwind(pTHX_ SV *msv) * perls 5.13.{1..7} which had late setting of $@ without this * early-setting hack. */ - if (!(in_eval & EVAL_KEEPERR)) { - SvTEMP_off(exceptsv); - sv_setsv(ERRSV, exceptsv); - } + if (!(in_eval & EVAL_KEEPERR)) + sv_setsv_flags(ERRSV, exceptsv, + (SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL)); if (in_eval & EVAL_KEEPERR) { Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf, |