In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3a0fe090c1f24f4a3748d00616b87eb4c8dd4475?hp=b949b68f22c917863062bdb655e0e956abeca90d>
- Log ----------------------------------------------------------------- commit 3a0fe090c1f24f4a3748d00616b87eb4c8dd4475 Author: Zefram <[email protected]> Date: Sun Jan 22 03:20:08 2017 +0000 handle errors in gen_constant_list When the attempt to constant-fold a list generates an error, that error should not be signalled at compile time, but merely abort the attempt at constant folding, so that the error will occur naturally at runtime. This is achieved by wrapping the compile-time execution in gen_constant_list() in a fake eval block. This brings it in line with the scalar fold_constants(). Fixes [perl #129320]. ----------------------------------------------------------------------- Summary of changes: op.c | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++-------- t/comp/fold.t | 11 ++++++++- 2 files changed, 72 insertions(+), 10 deletions(-) diff --git a/op.c b/op.c index 118c519cb8..d2fd198ddf 100644 --- a/op.c +++ b/op.c @@ -4620,27 +4620,80 @@ static OP * S_gen_constant_list(pTHX_ OP *o) { dVAR; - OP *curop; - const SSize_t oldtmps_floor = PL_tmps_floor; + OP *curop, *old_next; + SV * const oldwarnhook = PL_warnhook; + SV * const olddiehook = PL_diehook; + COP *old_curcop; + U8 oldwarn = PL_dowarn; SV **svp; AV *av; + I32 old_cxix; + COP not_compiling; + int ret = 0; + dJMPENV; list(o); if (PL_parser && PL_parser->error_count) return o; /* Don't attempt to run with errors */ curop = LINKLIST(o); + old_next = o->op_next; o->op_next = 0; CALL_PEEP(curop); S_prune_chain_head(&curop); PL_op = curop; - Perl_pp_pushmark(aTHX); - CALLRUNOPS(aTHX); - PL_op = curop; - assert (!(curop->op_flags & OPf_SPECIAL)); - assert(curop->op_type == OP_RANGE); - Perl_pp_anonlist(aTHX); - PL_tmps_floor = oldtmps_floor; + + old_cxix = cxstack_ix; + create_eval_scope(NULL, G_FAKINGEVAL); + + old_curcop = PL_curcop; + StructCopy(old_curcop, ¬_compiling, COP); + PL_curcop = ¬_compiling; + /* The above ensures that we run with all the correct hints of the + current COP, but that IN_PERL_RUNTIME is true. */ + assert(IN_PERL_RUNTIME); + PL_warnhook = PERL_WARNHOOK_FATAL; + PL_diehook = NULL; + JMPENV_PUSH(ret); + + /* Effective $^W=1. */ + if ( ! (PL_dowarn & G_WARN_ALL_MASK)) + PL_dowarn |= G_WARN_ON; + + switch (ret) { + case 0: + Perl_pp_pushmark(aTHX); + CALLRUNOPS(aTHX); + PL_op = curop; + assert (!(curop->op_flags & OPf_SPECIAL)); + assert(curop->op_type == OP_RANGE); + Perl_pp_anonlist(aTHX); + break; + case 3: + CLEAR_ERRSV(); + o->op_next = old_next; + break; + default: + JMPENV_POP; + PL_warnhook = oldwarnhook; + PL_diehook = olddiehook; + Perl_croak(aTHX_ "panic: gen_constant_list JMPENV_PUSH returned %d", + ret); + } + + JMPENV_POP; + PL_dowarn = oldwarn; + PL_warnhook = oldwarnhook; + PL_diehook = olddiehook; + PL_curcop = old_curcop; + + if (cxstack_ix > old_cxix) { + assert(cxstack_ix == old_cxix + 1); + assert(CxTYPE(CX_CUR()) == CXt_EVAL); + delete_eval_scope(); + } + if (ret) + return o; OpTYPE_set(o, OP_RV2AV); o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */ diff --git a/t/comp/fold.t b/t/comp/fold.t index 4fa0734bee..a875b5bdef 100644 --- a/t/comp/fold.t +++ b/t/comp/fold.t @@ -4,7 +4,7 @@ # we've not yet verified that use works. # use strict; -print "1..30\n"; +print "1..34\n"; my $test = 0; # Historically constant folding was performed by evaluating the ops, and if @@ -180,3 +180,12 @@ is "@values", "4 4", is $w, 1, '1+undef_constant is not folded outside warninsg scope'; BEGIN { $^W = 1 } } + +$a = eval 'my @z; @z = 0..~0 if 0; 3'; +is ($a, 3, "list constant folding doesn't signal compile-time error"); +is ($@, '', 'no error'); + +$b = 0; +$a = eval 'my @z; @z = 0..~0 if $b; 3'; +is ($a, 3, "list constant folding doesn't signal compile-time error"); +is ($@, '', 'no error'); -- Perl5 Master Repository
