From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 27 Mar 2006 19:25:02 +0000 (+0000)
Subject: If constant folding fails, don't fold constants, rather than reporting
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b7f7fd0bbdc7d1d714e682f9a3250ab7d97ac560;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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