X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=7fa9c06933a7c8d9de35e6d30a017628e00a479f;hb=97ea268b1482091665a2c54da30873227f203194;hp=6c4f2ff84d8d64fdcf750fce115dc6e63bf33b94;hpb=19692e8d256164f96817d6df6ecee26c3cda4ae9;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 6c4f2ff..7fa9c06 100644
--- a/pp.c
+++ b/pp.c
@@ -17,6 +17,8 @@
 #include "perl.h"
 #include "keywords.h"
 
+#include "reentr.h"
+
 /* variations on pp_null */
 
 /* XXX I can't imagine anyone who doesn't have this actually _needs_
@@ -62,7 +64,7 @@ PP(pp_padav)
 	EXTEND(SP, maxarg);
 	if (SvMAGICAL(TARG)) {
 	    U32 i;
-	    for (i=0; i < maxarg; i++) {
+	    for (i=0; i < (U32)maxarg; i++) {
 		SV **svp = av_fetch((AV*)TARG, i, FALSE);
 		SP[i+1] = (svp) ? *svp : &PL_sv_undef;
 	    }
@@ -954,6 +956,8 @@ PP(pp_pow)
                             result *= base;
                             /* Only bother to clear the bit if it is set.  */
                             power &= ~bit;
+                           /* Avoid squaring base again if we're done. */
+                           if (power == 0) break;
                         }
                     }
                     SP--;
@@ -1185,7 +1189,7 @@ PP(pp_divide)
                     }
                     /* 2s complement assumption */
                     if (result <= (UV)IV_MIN)
-                        SETi( -result );
+                        SETi( -(IV)result );
                     else {
                         /* It's exact but too negative for IV. */
                         SETn( -(NV)result );
@@ -2680,7 +2684,7 @@ S_seed(pTHX)
     u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
 #else
 #  ifdef HAS_GETTIMEOFDAY
-    gettimeofday(&when,(struct timezone *) 0);
+    PerlProc_gettimeofday(&when,NULL);
     u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
 #  else
     (void)time(&when);
@@ -3161,7 +3165,7 @@ PP(pp_index)
 	sv_pos_u2b(big, &offset, 0);
     if (offset < 0)
 	offset = 0;
-    else if (offset > biglen)
+    else if (offset > (I32)biglen)
 	offset = biglen;
     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
       (unsigned char*)tmps + biglen, little, 0)))
@@ -3202,7 +3206,7 @@ PP(pp_rindex)
     }
     if (offset < 0)
 	offset = 0;
-    else if (offset > blen)
+    else if (offset > (I32)blen)
 	offset = blen;
     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
 			  tmps2, tmps2 + llen)))
@@ -3257,7 +3261,7 @@ PP(pp_chr)
     (void)SvUPGRADE(TARG,SVt_PV);
 
     if (value > 255 && !IN_BYTES) {
-	SvGROW(TARG, UNISKIP(value)+1);
+	SvGROW(TARG, (STRLEN)UNISKIP(value)+1);
 	tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
 	SvCUR_set(TARG, tmps - SvPVX(TARG));
 	*tmps = '\0';
@@ -3270,7 +3274,7 @@ PP(pp_chr)
     SvGROW(TARG,2);
     SvCUR_set(TARG, 1);
     tmps = SvPVX(TARG);
-    *tmps++ = value;
+    *tmps++ = (char)value;
     *tmps = '\0';
     (void)SvPOK_only(TARG);
     if (PL_encoding)
@@ -3303,12 +3307,12 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #   endif
+    SETs(TARG);
+    RETURN;
 #else
     DIE(aTHX_
       "The crypt() function is unimplemented due to excessive paranoia.");
 #endif
-    SETs(TARG);
-    RETURN;
 }
 
 PP(pp_ucfirst)
@@ -3383,7 +3387,7 @@ PP(pp_lcfirst)
 	
 	tend = uvchr_to_utf8(tmpbuf, uv);
 
-	if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
+	if (!SvPADTMP(sv) || (STRLEN)(tend - tmpbuf) != ulen || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
 	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
@@ -3823,17 +3827,38 @@ PP(pp_hslice)
     register HV *hv = (HV*)POPs;
     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    bool localizing = PL_op->op_private & OPpLVAL_INTRO ? TRUE : FALSE;
+    bool other_magic = FALSE;
+
+    if (localizing) {
+        MAGIC *mg;
+        HV *stash;
 
-    if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
+        other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
+            ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
+             /* Try to preserve the existenceness of a tied hash
+              * element by using EXISTS and DELETE if possible.
+              * Fallback to FETCH and STORE otherwise */
+             && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
+             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
+             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+    }
+
+    if (!realhv && localizing)
 	DIE(aTHX_ "Can't localize pseudo-hash element");
 
     if (realhv || SvTYPE(hv) == SVt_PVAV) {
 	while (++MARK <= SP) {
 	    SV *keysv = *MARK;
 	    SV **svp;
-	    I32 preeminent = SvRMAGICAL(hv) ? 1 :
-				realhv ? hv_exists_ent(hv, keysv, 0)
-				       : avhv_exists_ent((AV*)hv, keysv, 0);
+	    bool preeminent = FALSE;
+
+            if (localizing) {
+                preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
+                    realhv ? hv_exists_ent(hv, keysv, 0)
+                    : avhv_exists_ent((AV*)hv, keysv, 0);
+            }
+
 	    if (realhv) {
 		HE *he = hv_fetch_ent(hv, keysv, lval, 0);
 		svp = he ? &HeVAL(he) : 0;
@@ -3846,7 +3871,7 @@ PP(pp_hslice)
 		    STRLEN n_a;
 		    DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
 		}
-		if (PL_op->op_private & OPpLVAL_INTRO) {
+		if (localizing) {
 		    if (preeminent)
 		        save_helem(hv, keysv, svp);
 		    else {
@@ -4304,7 +4329,7 @@ PP(pp_reverse)
 			while (down > up) {
 			    tmp = *up;
 			    *up++ = *down;
-			    *down-- = tmp;
+			    *down-- = (char)tmp;
 			}
 		    }
 		}
@@ -4314,7 +4339,7 @@ PP(pp_reverse)
 	    while (down > up) {
 		tmp = *up;
 		*up++ = *down;
-		*down-- = tmp;
+		*down-- = (char)tmp;
 	    }
 	    (void)SvPOK_only_UTF8(TARG);
 	}
@@ -4544,7 +4569,7 @@ PP(pp_split)
 		(void)SvUTF8_on(dstr);
 	    XPUSHs(dstr);
 	    if (rx->nparens) {
-		for (i = 1; i <= rx->nparens; i++) {
+		for (i = 1; i <= (I32)rx->nparens; i++) {
 		    s = rx->startp[i] + orig;
 		    m = rx->endp[i] + orig;