X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=de3487998fee0b78748993f1816249eb149bc973;hb=8ead3603a48f891846d351cca41dd2b5647ab9b9;hp=27d94bcc46d88b64e6830b495af815c7e30b56ae;hpb=69dc4b30f4725ad5f212d45d3c856ac1caaacf17;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 27d94bc..de34879 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -155,19 +155,20 @@ PP(pp_regcomp)
 	   ly this hack can be replaced with the approach described at
 	   http://www.nntp.perl.org/group/perl.perl5.porters/2007/03
 	   /msg122415.html some day. */
-	OP *matchop = pm->op_next;
-	SV *lhs;
-	const bool was_tainted = PL_tainted;
-	if (matchop->op_flags & OPf_STACKED)
+	if(pm->op_type == OP_MATCH) {
+	 SV *lhs;
+	 const bool was_tainted = PL_tainted;
+	 if (pm->op_flags & OPf_STACKED)
 	    lhs = TOPs;
-	else if (matchop->op_private & OPpTARGET_MY)
-	    lhs = PAD_SV(matchop->op_targ);
-	else lhs = DEFSV;
-	SvGETMAGIC(lhs);
-	/* Restore the previous value of PL_tainted (which may have been
-	   modified by get-magic), to avoid incorrectly setting the
-	   RXf_TAINTED flag further down. */
-	PL_tainted = was_tainted;
+	 else if (pm->op_private & OPpTARGET_MY)
+	    lhs = PAD_SV(pm->op_targ);
+	 else lhs = DEFSV;
+	 SvGETMAGIC(lhs);
+	 /* Restore the previous value of PL_tainted (which may have been
+	    modified by get-magic), to avoid incorrectly setting the
+	    RXf_TAINTED flag further down. */
+	 PL_tainted = was_tainted;
+	}
 
 	re = reg_temp_copy(NULL, re);
 	ReREFCNT_dec(PM_GETRE(pm));
@@ -1333,13 +1334,16 @@ S_dopoptolabel(pTHX_ const char *label)
 	case CXt_LOOP_LAZYSV:
 	case CXt_LOOP_FOR:
 	case CXt_LOOP_PLAIN:
-	    if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
+	  {
+	    const char *cx_label = CxLABEL(cx);
+	    if (!cx_label || strNE(label, cx_label) ) {
 		DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
-			(long)i, CxLABEL(cx)));
+			(long)i, cx_label));
 		continue;
 	    }
 	    DEBUG_l( Perl_deb(aTHX_ "(Found label #%ld %s)\n", (long)i, label));
 	    return i;
+	  }
 	}
     }
     return i;
@@ -1878,7 +1882,7 @@ PP(pp_dbstate)
 	    /* don't do recursive DB::DB call */
 	    return NORMAL;
 
-	ENTER_with_name("sub");
+	ENTER;
 	SAVETMPS;
 
 	SAVEI32(PL_debug);
@@ -1893,7 +1897,7 @@ PP(pp_dbstate)
 	    (void)(*CvXSUB(cv))(aTHX_ cv);
 	    CvDEPTH(cv)--;
 	    FREETMPS;
-	    LEAVE_with_name("sub");
+	    LEAVE;
 	    return NORMAL;
 	}
 	else {
@@ -2413,9 +2417,11 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
 	OP *kid;
 	/* First try all the kids at this level, since that's likeliest. */
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
-	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
-		    CopLABEL(kCOP) && strEQ(CopLABEL(kCOP), label))
-		return kid;
+	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
+		const char *kid_label = CopLABEL(kCOP);
+		if (kid_label && strEQ(kid_label, label))
+		    return kid;
+	    }
 	}
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 	    if (kid == PL_lastgotoprobe)
@@ -2554,7 +2560,7 @@ PP(pp_goto)
 		PUSHMARK(mark);
 		PUTBACK;
 		(void)(*CvXSUB(cv))(aTHX_ cv);
-		LEAVE_with_name("sub");
+		LEAVE;
 		return retop;
 	    }
 	    else {
@@ -2825,6 +2831,20 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
+/*
+=for apidoc docatch
+
+Check for the cases 0 or 3 of cur_env.je_ret, only used inside an eval context.
+
+0 is used as continue inside eval,
+
+3 is used for a die caught by an inner eval - continue inner loop
+
+See cop.h: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
+establish a local jmpenv to handle exception traps.
+
+=cut
+*/
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
@@ -2876,13 +2896,20 @@ S_docatch(pTHX_ OP *o)
     return NULL;
 }
 
+/* James Bond: Do you expect me to talk?
+   Auric Goldfinger: No, Mr. Bond. I expect you to die.
+
+   This code is an ugly hack, doesn't work with lexicals in subroutines that are
+   called more than once, and is only used by regcomp.c, for (?{}) blocks.
+
+   Currently it is not used outside the core code. Best if it stays that way.
+*/
 OP *
 Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 /* sv Text to convert to OP tree. */
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {
-    /* FIXME - how much of this code is common with pp_entereval?  */
     dVAR; dSP;				/* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;
@@ -3270,21 +3297,21 @@ PP(pp_require)
 			SVfARG(vnormal(PL_patchlevel)));
 		}
 		else { /* probably 'use 5.10' or 'use 5.8' */
-		    SV * hintsv = newSV(0);
+		    SV *hintsv;
 		    I32 second = 0;
 
 		    if (av_len(lav)>=1) 
 			second = SvIV(*av_fetch(lav,1,0));
 
 		    second /= second >= 600  ? 100 : 10;
-		    hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.%d",
-		    	(int)first, (int)second,0);
+		    hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.0",
+					   (int)first, (int)second);
 		    upg_version(hintsv, TRUE);
 
 		    DIE(aTHX_ "Perl %"SVf" required (did you mean %"SVf"?)"
 		    	"--this is only %"SVf", stopped",
 			SVfARG(vnormal(req)),
-			SVfARG(vnormal(hintsv)),
+			SVfARG(vnormal(sv_2mortal(hintsv))),
 			SVfARG(vnormal(PL_patchlevel)));
 		}
 	    }