X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=f726ab79bdaa66a56f8f74cc608c6a9122f7d2b6;hb=fa76202e3aa22e9755f1a461416769c368b47afc;hp=4c5387910388d5080a0022cfba59511636c23662;hpb=4bb101f2758f169969171dfe6b70f68a406dcc1e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 4c53879..f726ab7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -98,7 +98,7 @@ PP(pp_regcomp)
 	    memNE(PM_GETRE(pm)->precomp, t, len))
 	{
 	    if (PM_GETRE(pm)) {
-		ReREFCNT_dec(PM_GETRE(pm));
+	        ReREFCNT_dec(PM_GETRE(pm));
 		PM_SETRE(pm, Null(REGEXP*));	/* crucial if regcomp aborts */
 	    }
 	    if (PL_op->op_flags & OPf_SPECIAL)
@@ -159,6 +159,15 @@ PP(pp_substcont)
     register REGEXP *rx = cx->sb_rx;
     SV *nsv = Nullsv;
 
+    { 
+      REGEXP *old = PM_GETRE(pm);
+      if(old != rx) {
+	if(old) 
+	  ReREFCNT_dec(old);
+	PM_SETRE(pm,rx);
+      }
+    }
+
     rxres_restore(&cx->sb_rxres, rx);
     RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ));
 
@@ -213,6 +222,7 @@ PP(pp_substcont)
 	    SvTAINT(targ);
 
 	    LEAVE_SCOPE(cx->sb_oldsave);
+	    ReREFCNT_dec(rx);
 	    POPSUBST(cx);
 	    RETURNOP(pm->op_next);
 	}
@@ -248,6 +258,7 @@ PP(pp_substcont)
 	    sv_pos_b2u(sv, &i);
 	mg->mg_len = i;
     }
+    ReREFCNT_inc(rx);
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
@@ -2234,6 +2245,8 @@ PP(pp_goto)
 		    AvFLAGS(av) = AVf_REIFY;
 		    PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
 		}
+		else
+		    CLEAR_ARGARRAY(av);
 	    }
 	    else if (CvXSUB(cv)) {	/* put GvAV(defgv) back onto stack */
 		AV* av;
@@ -2389,7 +2402,7 @@ PP(pp_goto)
 	    switch (CxTYPE(cx)) {
 	    case CXt_EVAL:
 		leaving_eval = TRUE;
-                if (CxREALEVAL(cx)) {
+                if (!CxTRYBLOCK(cx)) {
 		    gotoprobe = (last_eval_cx ?
 				last_eval_cx->blk_eval.old_eval_root :
 				PL_eval_root);
@@ -2923,8 +2936,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 }
 
 STATIC PerlIO *
-S_doopen_pmc(pTHX_ const char *name, const char *mode)
+S_doopen_pm(pTHX_ const char *name, const char *mode)
 {
+#ifndef PERL_DISABLE_PMC
     STRLEN namelen = strlen(name);
     PerlIO *fp;
 
@@ -2952,6 +2966,9 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode)
 	fp = PerlIO_open(name, mode);
     }
     return fp;
+#else
+    return PerlIO_open(name, mode);
+#endif /* !PERL_DISABLE_PMC */
 }
 
 PP(pp_require)
@@ -3050,7 +3067,7 @@ PP(pp_require)
 
     if (path_is_absolute(name)) {
 	tryname = name;
-	tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
+	tryrsfp = doopen_pm(name,PERL_SCRIPT_MODE);
     }
 #ifdef MACOS_TRADITIONAL
     if (!tryrsfp) {
@@ -3059,7 +3076,7 @@ PP(pp_require)
 	MacPerl_CanonDir(name, newname, 1);
 	if (path_is_absolute(newname)) {
 	    tryname = newname;
-	    tryrsfp = doopen_pmc(newname,PERL_SCRIPT_MODE);
+	    tryrsfp = doopen_pm(newname,PERL_SCRIPT_MODE);
 	}
     }
 #endif
@@ -3214,7 +3231,7 @@ PP(pp_require)
 #endif
 		    TAINT_PROPER("require");
 		    tryname = SvPVX(namesv);
-		    tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
+		    tryrsfp = doopen_pm(tryname, PERL_SCRIPT_MODE);
 		    if (tryrsfp) {
 			if (tryname[0] == '.' && tryname[1] == '/')
 			    tryname += 2;
@@ -3560,11 +3577,20 @@ S_doparseform(pTHX_ SV *sv)
     U16 *linepc = 0;
     register I32 arg;
     bool ischop;
+    int maxops = 2; /* FF_LINEMARK + FF_END) */
 
     if (len == 0)
 	Perl_croak(aTHX_ "Null picture in formline");
 
-    New(804, fops, (send - s)*3+10, U16);    /* Almost certainly too long... */
+    /* estimate the buffer size needed */
+    for (base = s; s <= send; s++) {
+	if (*s == '\n' || *s == '@' || *s == '^')
+	    maxops += 10;
+    }
+    s = base;
+    base = Nullch;
+
+    New(804, fops, maxops, U16);
     fpc = fops;
 
     if (s < send) {
@@ -3727,6 +3753,7 @@ S_doparseform(pTHX_ SV *sv)
     }
     *fpc++ = FF_END;
 
+    assert (fpc <= fops + maxops); /* ensure our buffer estimate was valid */
     arg = fpc - fops;
     { /* need to jump to the next word */
         int z;