X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=8e3bf706da72866916d3f3f77e7f23dfee89e1b4;hb=dcb4812c733545a68ef39b77c2dc4f7d440de203;hp=72deac4524f54b683b3a6c9a0c76c3561f04e947;hpb=3666098248b43282bda1153dae2f4c1e4af38d09;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 72deac4..8e3bf70 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -250,9 +250,13 @@ PP(pp_aelemfast)
 {
     djSP;
     AV *av = GvAV((GV*)cSVOP->op_sv);
-    SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
+    U32 lval = op->op_flags & OPf_MOD;
+    SV** svp = av_fetch(av, op->op_private, lval);
+    SV *sv = (svp ? *svp : &sv_undef);
     EXTEND(SP, 1);
-    PUSHs(svp ? *svp : &sv_undef);
+    if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }
 
@@ -626,7 +630,6 @@ PP(pp_aassign)
 		hv_clear(hash);
 
 		while (relem < lastrelem) {	/* gobble up all the rest */
-		    STRLEN len;
 		    HE *didstore;
 		    if (*relem)
 			sv = *(relem++);
@@ -645,21 +648,36 @@ PP(pp_aassign)
 		    }
 		    TAINT_NOT;
 		}
-		if (relem == lastrelem && dowarn) {
-		    if (relem == firstrelem &&
-			SvROK(*relem) &&
-			( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
-			  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
-			warn("Reference found where even-sized list expected");
-		    else
-			warn("Odd number of elements in hash assignment");
+		if (relem == lastrelem) {
+		    if (*relem) {
+			HE *didstore;
+			if (dowarn) {
+			    if (relem == firstrelem &&
+				SvROK(*relem) &&
+				( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+				  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+				warn("Reference found where even-sized list expected");
+			    else
+				warn("Odd number of elements in hash assignment");
+			}
+			tmpstr = NEWSV(29,0);
+			didstore = hv_store_ent(hash,*relem,tmpstr,0);
+			if (magic) {
+			    if (SvSMAGICAL(tmpstr))
+				mg_set(tmpstr);
+			    if (!didstore)
+				SvREFCNT_dec(tmpstr);
+			}
+			TAINT_NOT;
+		    }
+		    relem++;
 		}
 	    }
 	    break;
 	default:
 	    if (SvTHINKFIRST(sv)) {
 		if (SvREADONLY(sv) && curcop != &compiling) {
-		    if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
+		    if (!SvIMMORTAL(sv))
 			DIE(no_modify);
 		    if (relem <= lastrelem)
 			relem++;
@@ -772,6 +790,7 @@ PP(pp_match)
     I32 safebase;
     char *truebase;
     register REGEXP *rx = pm->op_pmregexp;
+    bool rxtainted;
     I32 gimme = GIMME;
     STRLEN len;
     I32 minmatch = 0;
@@ -790,6 +809,8 @@ PP(pp_match)
     strend = s + len;
     if (!s)
 	DIE("panic: do_match");
+    rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+		 (tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
     if (pm->op_pmdynflags & PMdf_USED) {
@@ -855,7 +876,7 @@ play_it_again:
 	    }
 	    else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min,
 				     (unsigned char*)strend, 
-				     rx->check_substr)))
+				     rx->check_substr, 0)))
 		goto nope;
 	    else if ((rx->reganch & ROPT_CHECK_ALL) && !sawampersand)
 		goto yup;
@@ -896,6 +917,8 @@ play_it_again:
     /*NOTREACHED*/
 
   gotcha:
+    if (rxtainted)
+	RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
     if (gimme == G_ARRAY) {
 	I32 iters, i, len;
@@ -949,6 +972,8 @@ play_it_again:
     }
 
 yup:					/* Confirmed by check_substr */
+    if (rxtainted)
+	RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
     ++BmUSEFUL(rx->check_substr);
     curpm = pm;
@@ -1027,8 +1052,11 @@ do_readline(void)
 		    IoFLAGS(io) &= ~IOf_START;
 		    IoLINES(io) = 0;
 		    if (av_len(GvAVn(last_in_gv)) < 0) {
-			SV *tmpstr = newSVpv("-", 1); /* assume stdin */
-			av_push(GvAVn(last_in_gv), tmpstr);
+			do_open(last_in_gv,"-",1,FALSE,0,0,Nullfp);
+			sv_setpvn(GvSV(last_in_gv), "-", 1);
+			SvSETMAGIC(GvSV(last_in_gv));
+			fp = IoIFP(io);
+			goto have_fp;
 		    }
 		}
 		fp = nextargv(last_in_gv);
@@ -1176,6 +1204,7 @@ do_readline(void)
 	}
 	RETURN;
     }
+  have_fp:
     if (gimme == G_SCALAR) {
 	sv = TARG;
 	if (SvROK(sv))
@@ -1290,6 +1319,7 @@ PP(pp_helem)
     HV *hv = (HV*)POPs;
     U32 lval = op->op_flags & OPf_MOD;
     U32 defer = op->op_private & OPpLVAL_DEFER;
+    SV *sv;
 
     if (SvTYPE(hv) == SVt_PVHV) {
 	he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
@@ -1326,7 +1356,16 @@ PP(pp_helem)
 	else if (op->op_private & OPpDEREF)
 	    vivify_ref(*svp, op->op_private & OPpDEREF);
     }
-    PUSHs(svp ? *svp : &sv_undef);
+    sv = (svp ? *svp : &sv_undef);
+    /* This makes C<local $tied{foo} = $tied{foo}> possible.
+     * Pushing the magical RHS on to the stack is useless, since
+     * that magic is soon destined to be misled by the local(),
+     * and thus the later pp_sassign() will fail to mg_get() the
+     * old value.  This should also cure problems with delayed
+     * mg_get()s.  GSAR 98-07-03 */
+    if (!lval && SvGMAGICAL(sv))
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }
 
@@ -1399,6 +1438,31 @@ PP(pp_iter)
 	DIE("panic: pp_iter");
 
     av = cx->blk_loop.iterary;
+    if (SvTYPE(av) != SVt_PVAV) {
+	/* iterate ($min .. $max) */
+	if (cx->blk_loop.iterlval) {
+	    /* string increment */
+	    register SV* cur = cx->blk_loop.iterlval;
+	    STRLEN maxlen;
+	    char *max = SvPV((SV*)av, maxlen);
+	    if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
+		sv_setsv(*cx->blk_loop.itervar, cur);
+		if (strEQ(SvPVX(cur), max))
+		    sv_setiv(cur, 0); /* terminate next time */
+		else
+		    sv_inc(cur);
+		RETPUSHYES;
+	    }
+	    RETPUSHNO;
+	}
+	/* integer increment */
+	if (cx->blk_loop.iterix > cx->blk_loop.itermax)
+	    RETPUSHNO;
+	sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+	RETPUSHYES;
+    }
+
+    /* iterate array */
     if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
 	RETPUSHNO;
 
@@ -1477,7 +1541,10 @@ PP(pp_subst)
     s = SvPV(TARG, len);
     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
 	force_on_match = 1;
-    rxtainted = tainted << 1;
+    rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
+		 (tainted && (pm->op_pmflags & PMf_RETAINT)));
+    if (tainted)
+	rxtainted |= 2;
     TAINT_NOT;
 
   force_it:
@@ -1513,7 +1580,7 @@ PP(pp_subst)
 	    }
 	    else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min, 
 				     (unsigned char*)strend,
-				     rx->check_substr)))
+				     rx->check_substr, 0)))
 		goto nope;
 	    if (s && rx->check_offset_max < s - m) {
 		++BmUSEFUL(rx->check_substr);
@@ -1774,9 +1841,19 @@ PP(pp_leavesub)
     TAINT_NOT;
     if (gimme == G_SCALAR) {
 	MARK = newsp + 1;
-	if (MARK <= SP)
-	    *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
-	else {
+	if (MARK <= SP) {
+	    if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+		if (SvTEMP(TOPs)) {
+		    *MARK = SvREFCNT_inc(TOPs);
+		    FREETMPS;
+		    sv_2mortal(*MARK);
+		} else {
+		    FREETMPS;
+		    *MARK = sv_mortalcopy(TOPs);
+		}
+	    } else
+		*MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
+	} else {
 	    MEXTEND(MARK, 0);
 	    *MARK = &sv_undef;
 	}
@@ -2105,7 +2182,7 @@ PP(pp_entersub)
 		curcopdb = NULL;
 	    }
 	    /* Do we need to open block here? XXXX */
-	    (void)(*CvXSUB(cv))(cv _THIS);
+	    (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
 
 	    /* Enforce some sanity in scalar context. */
 	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
@@ -2261,6 +2338,7 @@ PP(pp_aelem)
     AV* av = (AV*)POPs;
     U32 lval = op->op_flags & OPf_MOD;
     U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+    SV *sv;
 
     if (elem > 0)
 	elem -= curcop->cop_arybase;
@@ -2287,7 +2365,10 @@ PP(pp_aelem)
 	else if (op->op_private & OPpDEREF)
 	    vivify_ref(*svp, op->op_private & OPpDEREF);
     }
-    PUSHs(svp ? *svp : &sv_undef);
+    sv = (svp ? *svp : &sv_undef);
+    if (!lval && SvGMAGICAL(sv))	/* see note in pp_helem() */
+	sv = sv_mortalcopy(sv);
+    PUSHs(sv);
     RETURN;
 }