X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=58ab34ccda41c9af62f77ca9cb2f0e0734c4d848;hb=9f8d30d514938e706a878aae5fd5b902550604e2;hp=78e1c99585fbdff4f40050bc2c772ea8347a39b2;hpb=5f05dabc4054964aa3b10f44f8468547f051cdf8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 78e1c99..58ab34c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -109,6 +109,8 @@ PP(pp_substcont)
 	if (cx->sb_iters > cx->sb_maxiters)
 	    DIE("Substitution loop");
 
+	if (!cx->sb_rxtainted)
+	    cx->sb_rxtainted = SvTAINTED(TOPs);
 	sv_catsv(dstr, POPs);
 	if (rx->subbase)
 	    Safefree(rx->subbase);
@@ -131,6 +133,8 @@ PP(pp_substcont)
 
 	    (void)SvPOK_only(targ);
 	    SvSETMAGIC(targ);
+	    if (cx->sb_rxtainted)
+		SvTAINTED_on(targ);
 	    PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
 	    LEAVE_SCOPE(cx->sb_oldsave);
 	    POPSUBST(cx);
@@ -148,6 +152,7 @@ PP(pp_substcont)
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0];
     cx->sb_subbase = rx->subbase;
+    cx->sb_rxtainted |= rx->exec_tainted;
 
     rx->subbase = Nullch;	/* so recursion works */
     RETURNOP(pm->op_pmreplstart);
@@ -607,10 +612,9 @@ PP(pp_sort)
     while (MARK < SP) {	/* This may or may not shift down one here. */
 	/*SUPPRESS 560*/
 	if (*up = *++MARK) {			/* Weed out nulls. */
-	    if (!SvPOK(*up))
+	    SvTEMP_off(*up);
+	    if (!sortcop && !SvPOK(*up))
 		(void)sv_2pv(*up, &na);
-	    else
-		SvTEMP_off(*up);
 	    up++;
 	}
     }
@@ -1249,11 +1253,8 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    if (op->op_flags & OPf_STACKED) {
-	AV* av = (AV*)POPs;
-	cx->blk_loop.iterary = av;
-	cx->blk_loop.iterix = -1;
-    }
+    if (op->op_flags & OPf_STACKED)
+	cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
     else {
 	cx->blk_loop.iterary = curstack;
 	AvFILL(curstack) = sp - stack_base;
@@ -1585,6 +1586,7 @@ PP(pp_goto)
 		EXTEND(stack_sp, items); /* @_ could have been extended. */
 		Copy(AvARRAY(av), stack_sp, items, SV*);
 		stack_sp += items;
+		SvREFCNT_dec(GvAV(defgv));
 		GvAV(defgv) = cx->blk_sub.savearray;
 		AvREAL_off(av);
 		av_clear(av);
@@ -1626,8 +1628,7 @@ PP(pp_goto)
 		    (void)SvREFCNT_inc(cv);
 		else {	/* save temporaries on recursion? */
 		    if (CvDEPTH(cv) == 100 && dowarn)
-			warn("Deep recursion on subroutine \"%s\"",
-			    GvENAME(CvGV(cv)));
+			sub_crush_depth(cv);
 		    if (CvDEPTH(cv) > AvFILL(padlist)) {
 			AV *newpad = newAV();
 			SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
@@ -1677,7 +1678,7 @@ PP(pp_goto)
 
 		    cx->blk_sub.savearray = GvAV(defgv);
 		    cx->blk_sub.argarray = av;
-		    GvAV(defgv) = cx->blk_sub.argarray;
+		    GvAV(defgv) = (AV*)SvREFCNT_inc(av);
 		    ++mark;
 
 		    if (items >= AvMAX(av) + 1) {
@@ -1703,12 +1704,13 @@ PP(pp_goto)
 		    }
 		}
 		if (perldb && curstash != debstash) {
-		    /* &xsub is not copying @_ */
+		    /*
+		     * We do not care about using sv to call CV;
+		     * it's for informational purposes only.
+		     */
 		    SV *sv = GvSV(DBsub);
 		    save_item(sv);
 		    gv_efullname3(sv, CvGV(cv), Nullch);
-		    /* We do not care about using sv to call CV,
-		     * just for info. */
 		}
 		RETURNOP(CvSTART(cv));
 	    }
@@ -1900,6 +1902,7 @@ int gimme;
     dSP;
     OP *saveop = op;
     HV *newstash;
+    CV *caller;
     AV* comppadlist;
 
     in_eval = 1;
@@ -1916,9 +1919,11 @@ int gimme;
     SAVEI32(min_intro_pending);
     SAVEI32(max_intro_pending);
 
+    caller = compcv;
     SAVESPTR(compcv);
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
+    CvUNIQUE_on(compcv);
 
     comppad = newAV();
     comppad_name = newAV();
@@ -1933,6 +1938,10 @@ int gimme;
     av_store(comppadlist, 0, (SV*)comppad_name);
     av_store(comppadlist, 1, (SV*)comppad);
     CvPADLIST(compcv) = comppadlist;
+
+    if (saveop->op_type != OP_REQUIRE)
+	CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
+
     SAVEFREESV(compcv);
 
     /* make sure we compile in the right package */