X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=2f2876bac982c87e3c0ae3c54030e32d548b3af8;hb=19b95bf092bc6fdb9455fe107fc46111b0a1ec31;hp=e88dbb1052f0870e92829a6c7146b84f63835e35;hpb=da51bb9b4f7f527464b5e38aca8bcb956de1bbbc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index e88dbb1..2f2876b 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -39,7 +39,14 @@ PP(pp_const)
 {
     dVAR;
     dSP;
-    XPUSHs(cSVOP_sv);
+    if ( PL_op->op_flags & OPf_SPECIAL )
+        /* This is a const op added to hold the hints hash for
+           pp_entereval. The hash can be modified by the code
+           being eval'ed, so we return a copy instead. */
+        XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
+    else
+        /* Normal const. */
+        XPUSHs(cSVOP_sv);
     RETURN;
 }
 
@@ -123,8 +130,11 @@ PP(pp_sassign)
     else if (PL_op->op_private & OPpASSIGN_STATE) {
 	if (SvPADSTALE(right))
 	    SvPADSTALE_off(right);
-	else
+	else {
+	    (void)POPs;
+	    PUSHs(right);
 	    RETURN; /* ignore assignment */
+	}
     }
     if (PL_tainting && PL_tainted && !SvTAINTED(left))
 	TAINT_NOT;
@@ -788,7 +798,7 @@ PP(pp_rv2av)
     static const char an_array[] = "an ARRAY";
     static const char a_hash[] = "a HASH";
     const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
-    const U32 type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
+    const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
 
     if (SvROK(sv)) {
       wasref:
@@ -900,6 +910,7 @@ PP(pp_rv2av)
     else if (gimme == G_SCALAR) {
 	dTARGET;
     TARG = Perl_hv_scalar(aTHX_ (HV*)sv);
+	SPAGAIN;
 	SETTARG;
     }
     }
@@ -961,6 +972,12 @@ PP(pp_aassign)
     int duplicates = 0;
     SV **firsthashrelem = NULL;	/* "= 0" keeps gcc 2.95 quiet  */
 
+    if (PL_op->op_private & OPpASSIGN_STATE) {
+	if (SvPADSTALE(*firstlelem))
+	    SvPADSTALE_off(*firstlelem);
+	else
+	    RETURN; /* ignore assignment */
+    }
 
     PL_delaymagic = DM_DELAY;		/* catch simultaneous items */
     gimme = GIMME_V;
@@ -978,12 +995,6 @@ PP(pp_aassign)
 	    }
 	}
     }
-    if (PL_op->op_private & OPpASSIGN_STATE) {
-	if (SvPADSTALE(*firstlelem))
-	    SvPADSTALE_off(*firstlelem);
-	else
-	    RETURN; /* ignore assignment */
-    }
 
     relem = firstrelem;
     lelem = firstlelem;
@@ -1172,7 +1183,8 @@ PP(pp_qr)
     if (pm->op_pmdynflags & PMdf_TAINTED)
         SvTAINTED_on(rv);
     sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
-    RETURNX(PUSHs(rv));
+    XPUSHs(rv);
+    RETURN;
 }
 
 PP(pp_match)
@@ -1237,19 +1249,19 @@ PP(pp_match)
 
     /* XXXX What part of this is needed with true \G-support? */
     if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
-	rx->startp[0] = -1;
+	rx->offs[0].start = -1;
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
 	    if (mg && mg->mg_len >= 0) {
 		if (!(rx->extflags & RXf_GPOS_SEEN))
-		    rx->endp[0] = rx->startp[0] = mg->mg_len;
+		    rx->offs[0].end = rx->offs[0].start = mg->mg_len;
 		else if (rx->extflags & RXf_ANCH_GPOS) {
 		    r_flags |= REXEC_IGNOREPOS;
-		    rx->endp[0] = rx->startp[0] = mg->mg_len;
+		    rx->offs[0].end = rx->offs[0].start = mg->mg_len;
 		} else if (rx->extflags & RXf_GPOS_FLOAT) 
 		    gpos = mg->mg_len;
 		else 
-		    rx->endp[0] = rx->startp[0] = mg->mg_len;
+		    rx->offs[0].end = rx->offs[0].start = mg->mg_len;
 		minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0;
 		update_minmatch = 0;
 	    }
@@ -1265,8 +1277,8 @@ PP(pp_match)
 	r_flags |= REXEC_SCREAM;
 
 play_it_again:
-    if (global && rx->startp[0] != -1) {
-	t = s = rx->endp[0] + truebase - rx->gofs;
+    if (global && rx->offs[0].start != -1) {
+	t = s = rx->offs[0].end + truebase - rx->gofs;
 	if ((s + rx->minlen) > strend || s < truebase)
 	    goto nope;
 	if (update_minmatch++)
@@ -1313,10 +1325,10 @@ play_it_again:
 	EXTEND_MORTAL(nparens + i);
 	for (i = !i; i <= nparens; i++) {
 	    PUSHs(sv_newmortal());
-	    if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
-		const I32 len = rx->endp[i] - rx->startp[i];
-		s = rx->startp[i] + truebase;
-	        if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
+	    if ((rx->offs[i].start != -1) && rx->offs[i].end != -1 ) {
+		const I32 len = rx->offs[i].end - rx->offs[i].start;
+		s = rx->offs[i].start + truebase;
+	        if (rx->offs[i].end < 0 || rx->offs[i].start < 0 ||
 		    len < 0 || len > strend - s)
 		    DIE(aTHX_ "panic: pp_match start/end pointers");
 		sv_setpvn(*SP, s, len);
@@ -1337,16 +1349,17 @@ play_it_again:
 		    mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
 				     &PL_vtbl_mglob, NULL, 0);
 		}
-		if (rx->startp[0] != -1) {
-		    mg->mg_len = rx->endp[0];
-		    if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
+		if (rx->offs[0].start != -1) {
+		    mg->mg_len = rx->offs[0].end;
+		    if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
 			mg->mg_flags |= MGf_MINMATCH;
 		    else
 			mg->mg_flags &= ~MGf_MINMATCH;
 		}
 	    }
-	    had_zerolen = (rx->startp[0] != -1
-			   && rx->startp[0] + rx->gofs == (UV)rx->endp[0]);
+	    had_zerolen = (rx->offs[0].start != -1
+			   && (rx->offs[0].start + rx->gofs
+			       == (UV)rx->offs[0].end));
 	    PUTBACK;			/* EVAL blocks may use stack */
 	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	    goto play_it_again;
@@ -1371,9 +1384,9 @@ play_it_again:
 		mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
 				 &PL_vtbl_mglob, NULL, 0);
 	    }
-	    if (rx->startp[0] != -1) {
-		mg->mg_len = rx->endp[0];
-		if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
+	    if (rx->offs[0].start != -1) {
+		mg->mg_len = rx->offs[0].end;
+		if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
 		    mg->mg_flags |= MGf_MINMATCH;
 		else
 		    mg->mg_flags &= ~MGf_MINMATCH;
@@ -1397,13 +1410,13 @@ yup:					/* Confirmed by INTUIT */
     if (global) {
 	/* FIXME - should rx->subbeg be const char *?  */
 	rx->subbeg = (char *) truebase;
-	rx->startp[0] = s - truebase;
+	rx->offs[0].start = s - truebase;
 	if (RX_MATCH_UTF8(rx)) {
 	    char * const t = (char*)utf8_hop((U8*)s, rx->minlenret);
-	    rx->endp[0] = t - truebase;
+	    rx->offs[0].end = t - truebase;
 	}
 	else {
-	    rx->endp[0] = s - truebase + rx->minlenret;
+	    rx->offs[0].end = s - truebase + rx->minlenret;
 	}
 	rx->sublen = strend - truebase;
 	goto gotcha;
@@ -1432,12 +1445,12 @@ yup:					/* Confirmed by INTUIT */
 	}
 	rx->sublen = strend - t;
 	RX_MATCH_COPIED_on(rx);
-	off = rx->startp[0] = s - t;
-	rx->endp[0] = off + rx->minlenret;
+	off = rx->offs[0].start = s - t;
+	rx->offs[0].end = off + rx->minlenret;
     }
     else {			/* startp/endp are used by @- @+. */
-	rx->startp[0] = s - truebase;
-	rx->endp[0] = s - truebase + rx->minlenret;
+	rx->offs[0].start = s - truebase;
+	rx->offs[0].end = s - truebase + rx->minlenret;
     }
     /* including rx->nparens in the below code seems highly suspicious.
        -dmq */
@@ -1943,8 +1956,7 @@ PP(pp_iter)
 	if (lv)
 	    SvREFCNT_dec(LvTARG(lv));
 	else {
-	    lv = cx->blk_loop.iterlval = newSV(0);
-	    sv_upgrade(lv, SVt_PVLV);
+	    lv = cx->blk_loop.iterlval = newSV_type(SVt_PVLV);
 	    LvTYPE(lv) = 'y';
 	    sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
 	}
@@ -2127,8 +2139,8 @@ PP(pp_subst)
 	SvSCREAM_off(TARG);	/* disable possible screamer */
 	if (once) {
 	    rxtainted |= RX_MATCH_TAINTED(rx);
-	    m = orig + rx->startp[0];
-	    d = orig + rx->endp[0];
+	    m = orig + rx->offs[0].start;
+	    d = orig + rx->offs[0].end;
 	    s = orig;
 	    if (m - s > strend - d) {  /* faster to shorten from end */
 		if (clen) {
@@ -2170,7 +2182,7 @@ PP(pp_subst)
 		if (iters++ > maxiters)
 		    DIE(aTHX_ "Substitution loop");
 		rxtainted |= RX_MATCH_TAINTED(rx);
-		m = rx->startp[0] + orig;
+		m = rx->offs[0].start + orig;
 		if ((i = m - s)) {
 		    if (s != d)
 			Move(s, d, i, char);
@@ -2180,7 +2192,7 @@ PP(pp_subst)
 		    Copy(c, d, clen, char);
 		    d += clen;
 		}
-		s = rx->endp[0] + orig;
+		s = rx->offs[0].end + orig;
 	    } while (CALLREGEXEC(rx, s, strend, orig, s == m,
 				 TARG, NULL,
 				 /* don't match same null twice */
@@ -2243,12 +2255,12 @@ PP(pp_subst)
 		s = orig + (m - s);
 		strend = s + (strend - m);
 	    }
-	    m = rx->startp[0] + orig;
+	    m = rx->offs[0].start + orig;
 	    if (doutf8 && !SvUTF8(dstr))
 		sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
             else
 		sv_catpvn(dstr, s, m-s);
-	    s = rx->endp[0] + orig;
+	    s = rx->offs[0].end + orig;
 	    if (clen)
 		sv_catpvn(dstr, c, clen);
 	    if (once)
@@ -3012,6 +3024,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 		     && SvOBJECT(ob))))
     {
 	Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
+		   (SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" :
 		   name);
     }