X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=e998e211e9bdb42938d1d17d7518ff3004b45c48;hb=9e5bbba0de25c01ae9355c7a97e237602a37e9f3;hp=95dc5fd15e0f8564ccda8d03d5a3e86c0cdca314;hpb=777f7c561610dee641c77666e5a4a0d9ac1d4230;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 95dc5fd..e998e21 100644
--- a/pp.c
+++ b/pp.c
@@ -132,7 +132,7 @@ PP(pp_padhv)
 
 /* Translations. */
 
-const char S_no_symref_sv[] =
+static const char S_no_symref_sv[] =
     "Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use";
 
 PP(pp_rv2gv)
@@ -207,7 +207,7 @@ PP(pp_rv2gv)
 	    }
 	    else {
 		if (PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(aTHX_ S_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
+		    DIE(aTHX_ S_no_symref_sv, sv, (SvPOK(sv) && SvCUR(sv)>32 ? "..." : ""), "a symbol");
 		if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
 		    == OPpDONT_INIT_GV) {
 		    /* We are the target of a coderef assignment.  Return
@@ -237,7 +237,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
 
     if (PL_op->op_private & HINT_STRICT_REFS) {
 	if (SvOK(sv))
-	    Perl_die(aTHX_ S_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
+	    Perl_die(aTHX_ S_no_symref_sv, sv, (SvPOK(sv) && SvCUR(sv)>32 ? "..." : ""), what);
 	else
 	    Perl_die(aTHX_ PL_no_usym, what);
     }
@@ -1030,7 +1030,7 @@ PP(pp_pow)
 			   on same algorithm as above */
 			register UV result = 1;
 			register UV base = baseuv;
-			const bool odd_power = (bool)(power & 1);
+			const bool odd_power = cBOOL(power & 1);
 			if (odd_power) {
 			    result *= base;
 			}
@@ -2485,14 +2485,14 @@ PP(pp_negate)
 
 PP(pp_not)
 {
-    dVAR; dSP; tryAMAGICunSET(not);
+    dVAR; dSP; tryAMAGICunSET_var(not_amg);
     *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
     return NORMAL;
 }
 
 PP(pp_complement)
 {
-    dVAR; dSP; dTARGET; tryAMAGICun(compl);
+    dVAR; dSP; dTARGET; tryAMAGICun_var(compl_amg);
     {
       dTOPss;
       SvGETMAGIC(sv);
@@ -3139,12 +3139,12 @@ PP(pp_substr)
 	UV pos1_uv = pos1_iv-arybase;
 	/* Overflow can occur when $[ < 0 */
 	if (arybase < 0 && pos1_uv < (UV)pos1_iv)
-	    goto BOUND_FAIL;
+	    goto bound_fail;
 	pos1_iv = pos1_uv;
 	pos1_is_uv = 1;
     }
     else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) {
-	goto BOUND_FAIL;  /* $[=3; substr($_,2,...) */
+	goto bound_fail;  /* $[=3; substr($_,2,...) */
     }
     else { /* pos < $[ */
 	if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */
@@ -3159,7 +3159,7 @@ PP(pp_substr)
     }
     if (pos1_is_uv || pos1_iv > 0) {
 	if ((UV)pos1_iv > curlen)
-	    goto BOUND_FAIL;
+	    goto bound_fail;
     }
 
     if (num_args > 2) {
@@ -3189,7 +3189,7 @@ PP(pp_substr)
 
     if (!pos2_is_uv && pos2_iv < 0) {
 	if (!pos1_is_uv && pos1_iv < 0)
-	    goto BOUND_FAIL;
+	    goto bound_fail;
 	pos2_iv = 0;
     }
     else if (!pos1_is_uv && pos1_iv < 0)
@@ -3204,10 +3204,10 @@ PP(pp_substr)
 	/* pos1_iv and pos2_iv both in 0..curlen, so the cast is safe */
 	const STRLEN pos = (STRLEN)( (UV)pos1_iv );
 	const STRLEN len = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv );
-	STRLEN byte_pos = pos;
 	STRLEN byte_len = len;
-	if (utf8_curlen)
-	    sv_pos_u2b_proper(sv, &byte_pos, &byte_len);
+	STRLEN byte_pos = utf8_curlen
+	    ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
+
 	tmps += byte_pos;
 	/* we either return a PV or an LV. If the TARG hasn't been used
 	 * before, or is of that type, reuse it; otherwise use a mortal
@@ -3277,7 +3277,7 @@ PP(pp_substr)
     PUSHs(TARG);		/* avoid SvSETMAGIC here */
     RETURN;
 
-BOUND_FAIL:
+bound_fail:
     if (lvalue || repl)
 	Perl_croak(aTHX_ "substr outside of string");
     Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
@@ -3439,6 +3439,7 @@ PP(pp_sprintf)
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     if (SvTAINTED(MARK[1]))
 	TAINT_PROPER("sprintf");
+    SvTAINTED_off(TARG);
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
     SP = ORIGMARK;
@@ -5325,7 +5326,8 @@ PP(pp_shift)
 {
     dVAR;
     dSP;
-    AV * const av = MUTABLE_AV(POPs);
+    AV * const av = PL_op->op_flags & OPf_SPECIAL
+	? MUTABLE_AV(GvAV(PL_defgv)) : MUTABLE_AV(POPs);
     SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
     EXTEND(SP, 1);
     assert (sv);
@@ -5418,12 +5420,15 @@ PP(pp_reverse)
 	    }
 	    else {
 		SV **begin = AvARRAY(av);
-		SV **end   = begin + AvFILLp(av);
 
-		while (begin < end) {
-		    register SV * const tmp = *begin;
-		    *begin++ = *end;
-		    *end--   = tmp;
+		if (begin) {
+		    SV **end   = begin + AvFILLp(av);
+
+		    while (begin < end) {
+			register SV * const tmp = *begin;
+			*begin++ = *end;
+			*end--   = tmp;
+		    }
 		}
 	    }
 	}