If constant folding fails, don't fold constants, rather than reporting

the error at compile time. This allows illegal constant expressions in
dead code to be ignored.

p4raw-id: //depot/perl@27615

diff --git a/MANIFEST b/MANIFEST
index 60b5dad..e614095 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3118,6 +3118,7 @@ t/comp/colon.t                    See if colons are parsed correctly
 t/comp/cpp.aux                 main file for cpp.t
 t/comp/cpp.t                   See if C preprocessor works
 t/comp/decl.t                  See if declarations work
+t/comp/fold.t                  See if constant folding works
 t/comp/hints.t                 See if %^H works
 t/comp/multiline.t             See if multiline strings work
 t/comp/opsubs.t                        See if q() etc. are not parsed as functions

diff --git a/op.c b/op.c
index 382c2a0..1fd94c2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2121,6 +2121,10 @@ Perl_fold_constants(pTHX_ register OP *o)
     OP *newop;
     I32 type = o->op_type;
     SV *sv;
+    int ret = 0;
+    I32 oldscope;
+    OP *old_next;
+    dJMPENV;
 
     if (PL_opargs[type] & OA_RETSCALAR)
        scalar(o);
@@ -2174,17 +2178,72 @@ Perl_fold_constants(pTHX_ register OP *o)
     }
 
     curop = LINKLIST(o);
+    old_next = o->op_next;
     o->op_next = 0;
     PL_op = curop;
-    CALLRUNOPS(aTHX);
-    sv = *(PL_stack_sp--);
-    if (o->op_targ && sv == PAD_SV(o->op_targ))        /* grab pad temp? */
-       pad_swipe(o->op_targ,  FALSE);
-    else if (SvTEMP(sv)) {                     /* grab mortal temp? */
-       SvREFCNT_inc_simple_void(sv);
-       SvTEMP_off(sv);
+
+    oldscope = PL_scopestack_ix;
+
+       /* we're trying to emulate pp_entertry() here */
+       {
+           register PERL_CONTEXT *cx;
+           const I32 gimme = GIMME_V;
+       
+           ENTER;
+           SAVETMPS;
+       
+           PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
+           PUSHEVAL(cx, 0, 0);
+           PL_eval_root = PL_op;             /* Only needed so that goto works right. */
+       
+           PL_in_eval = EVAL_INEVAL;
+           sv_setpvn(ERRSV,"",0);
+       }
+    JMPENV_PUSH(ret);
+
+    switch (ret) {
+    case 0:
+       CALLRUNOPS(aTHX);
+       sv = *(PL_stack_sp--);
+       if (o->op_targ && sv == PAD_SV(o->op_targ))     /* grab pad temp? */
+           pad_swipe(o->op_targ,  FALSE);
+       else if (SvTEMP(sv)) {                  /* grab mortal temp? */
+           SvREFCNT_inc_simple_void(sv);
+           SvTEMP_off(sv);
+       }
+       break;
+    case 3:
+       /* Something tried to die.  Abandon constant folding.  */
+       /* Pretend the error never happened.  */
+       sv_setpvn(ERRSV,"",0);
+       o->op_next = old_next;
+       break;
+    default:
+       JMPENV_POP;
+       /* Don't expect 1 (setjmp failed) or 2 (something called my_exit)  */
+       Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
+    }
+
+    JMPENV_POP;
+    if (PL_scopestack_ix > oldscope) {
+       SV **newsp;
+       PMOP *newpm;
+       I32 gimme;
+       register PERL_CONTEXT *cx;
+       I32 optype;
+       
+       POPBLOCK(cx,newpm);
+           POPEVAL(cx);
+           PL_curpm = newpm;
+           LEAVE;
+           PERL_UNUSED_VAR(newsp);
+           PERL_UNUSED_VAR(gimme);
+           PERL_UNUSED_VAR(optype);
     }
 
+    if (ret)
+       goto nope;
+
 #ifndef PERL_MAD
     op_free(o);
 #endif
@@ -2195,7 +2254,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     op_getmad(o,newop,'f');
     return newop;
 
-  nope:
+ nope:
     return o;
 }
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index fa290e3..7594aac 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2921,6 +2921,11 @@ data.
 (P) The internal do_trans routines were called with invalid operational
 data.
 
+=item panic: fold_constants JMPENV_PUSH returned %d
+
+(P) While attemtping folding constants an exception other than an C<eval>
+failure was caught.
+
 =item panic: frexp
 
 (P) The library function frexp() failed, making printf("%f") impossible.

diff --git a/pod/perltodo.pod b/pod/perltodo.pod
index 091ac3a..28faab1 100644 (file)
--- a/pod/perltodo.pod
+++ b/pod/perltodo.pod
@@ -527,13 +527,6 @@ program if you pass the process ID. It would be good to do this with the Perl
 debugger on a running Perl program, although I'm not sure how it would be
 done." ssh and screen do this with named pipes in /tmp. Maybe we can too.
 
-=head2 Constant folding
-
-The peephole optimiser should trap errors during constant folding, and give
-up on the folding, rather than bailing out at compile time.  It is quite
-possible that the unfoldable constant is in unreachable code, eg something
-akin to C<$a = 0/0 if 0;>
-
 =head2 LVALUE functions for lists
 
 The old perltodo notes that lvalue functions don't work for list or hash