X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=3ab629e1a415613d89c6f1f28881fc0956c318b2;hb=23fb6509afc63cde7930e13c21f5617c860fa149;hp=a0729e972a26e00067e9bf4932453c722b5ee70e;hpb=6fdb5f96460dfb69dad11dd7111abf8ec1263bb1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index a0729e9..3ab629e 100644
--- a/pp.c
+++ b/pp.c
@@ -1074,9 +1074,13 @@ PP(pp_divide)
 #else
                 /* Otherwise we only attempt it if either or both operands
                    would not be preserved by an NV.  If both fit in NVs
-                   we fall through to the NV divide code below.  */
-                && ((left > ((UV)1 << NV_PRESERVES_UV_BITS))
-                    || (right > ((UV)1 << NV_PRESERVES_UV_BITS)))
+                   we fall through to the NV divide code below.  However,
+                   as left >= right to ensure integer result here, we know that
+                   we can skip the test on the right operand - right big
+                   enough not to be preserved can't get here unless left is
+                   also too big.  */
+
+                && (left > ((UV)1 << NV_PRESERVES_UV_BITS))
 #endif
                 ) {
                 /* Integer division can't overflow, but it can be imprecise.  */
@@ -1252,10 +1256,33 @@ PP(pp_repeat)
 	MEXTEND(MARK, max);
 	if (count > 1) {
 	    while (SP > MARK) {
+#if 0
+	      /* This code was intended to fix 20010809.028:
+
+	         $x = 'abcd';
+		 for (($x =~ /./g) x 2) {
+		     print chop; # "abcdabcd" expected as output.
+		 }
+
+	       * but that change (#11635) broke this code:
+
+	       $x = [("foo")x2]; # only one "foo" ended up in the anonlist.
+
+	       * I can't think of a better fix that doesn't introduce
+	       * an efficiency hit by copying the SVs. The stack isn't
+	       * refcounted, and mortalisation obviously doesn't
+	       * Do The Right Thing when the stack has more than
+	       * one pointer to the same mortal value.
+	       * .robin.
+	       */
 		if (*SP) {
 		    *SP = sv_2mortal(newSVsv(*SP));
 		    SvREADONLY_on(*SP);
 		}
+#else
+               if (*SP)
+		   SvTEMP_off((*SP));
+#endif
 		SP--;
 	    }
 	    MARK++;
@@ -1494,11 +1521,6 @@ PP(pp_lt)
 		    RETURN;
 		}
 		auv = SvUVX(TOPs);
-		if (auv >= (UV) IV_MAX) {
-		    /* As (b) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_no);
-		    RETURN;
-		}
 		SETs(boolSV(auv < (UV)biv));
 		RETURN;
 	    }
@@ -1515,17 +1537,22 @@ PP(pp_lt)
 		}
 		buv = SvUVX(TOPs);
 		SP--;
-		if (buv > (UV) IV_MAX) {
-		    /* As (a) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_yes);
-		    RETURN;
-		}
 		SETs(boolSV((UV)aiv < buv));
 		RETURN;
 	    }
 	}
     }
 #endif
+#ifndef NV_PRESERVES_UV
+#ifdef PERL_PRESERVE_IVUV
+    else
+#endif
+        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+            SP--;
+            SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
+            RETURN;
+        }
+#endif
     {
       dPOPnv;
       SETs(boolSV(TOPn < value));
@@ -1572,11 +1599,6 @@ PP(pp_gt)
 		    RETURN;
 		}
 		auv = SvUVX(TOPs);
-		if (auv > (UV) IV_MAX) {
-		    /* As (b) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_yes);
-		    RETURN;
-		}
 		SETs(boolSV(auv > (UV)biv));
 		RETURN;
 	    }
@@ -1593,17 +1615,22 @@ PP(pp_gt)
 		}
 		buv = SvUVX(TOPs);
 		SP--;
-		if (buv >= (UV) IV_MAX) {
-		    /* As (a) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_no);
-		    RETURN;
-		}
 		SETs(boolSV((UV)aiv > buv));
 		RETURN;
 	    }
 	}
     }
 #endif
+#ifndef NV_PRESERVES_UV
+#ifdef PERL_PRESERVE_IVUV
+    else
+#endif
+        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+        SP--;
+        SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s)));
+        RETURN;
+    }
+#endif
     {
       dPOPnv;
       SETs(boolSV(TOPn > value));
@@ -1650,11 +1677,6 @@ PP(pp_le)
 		    RETURN;
 		}
 		auv = SvUVX(TOPs);
-		if (auv > (UV) IV_MAX) {
-		    /* As (b) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_no);
-		    RETURN;
-		}
 		SETs(boolSV(auv <= (UV)biv));
 		RETURN;
 	    }
@@ -1671,17 +1693,22 @@ PP(pp_le)
 		}
 		buv = SvUVX(TOPs);
 		SP--;
-		if (buv >= (UV) IV_MAX) {
-		    /* As (a) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_yes);
-		    RETURN;
-		}
 		SETs(boolSV((UV)aiv <= buv));
 		RETURN;
 	    }
 	}
     }
 #endif
+#ifndef NV_PRESERVES_UV
+#ifdef PERL_PRESERVE_IVUV
+    else
+#endif
+        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+        SP--;
+        SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s)));
+        RETURN;
+    }
+#endif
     {
       dPOPnv;
       SETs(boolSV(TOPn <= value));
@@ -1728,11 +1755,6 @@ PP(pp_ge)
 		    RETURN;
 		}
 		auv = SvUVX(TOPs);
-		if (auv >= (UV) IV_MAX) {
-		    /* As (b) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_yes);
-		    RETURN;
-		}
 		SETs(boolSV(auv >= (UV)biv));
 		RETURN;
 	    }
@@ -1749,17 +1771,22 @@ PP(pp_ge)
 		}
 		buv = SvUVX(TOPs);
 		SP--;
-		if (buv > (UV) IV_MAX) {
-		    /* As (a) is an IV, it cannot be > IV_MAX */
-		    SETs(&PL_sv_no);
-		    RETURN;
-		}
 		SETs(boolSV((UV)aiv >= buv));
 		RETURN;
 	    }
 	}
     }
 #endif
+#ifndef NV_PRESERVES_UV
+#ifdef PERL_PRESERVE_IVUV
+    else
+#endif
+        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+        SP--;
+        SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s)));
+        RETURN;
+    }
+#endif
     {
       dPOPnv;
       SETs(boolSV(TOPn >= value));
@@ -1772,7 +1799,8 @@ PP(pp_ne)
     dSP; tryAMAGICbinSET(ne,0);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && SvROK(TOPm1s)) {
-	SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
+        SP--;
+	SETs(boolSV(SvRV(TOPs) != SvRV(TOPp1s)));
 	RETURN;
     }
 #endif
@@ -1784,19 +1812,16 @@ PP(pp_ne)
 	    bool auvok = SvUOK(TOPm1s);
 	    bool buvok = SvUOK(TOPs);
 	
-	    if (!auvok && !buvok) { /* ## IV <=> IV ## */
-		IV aiv = SvIVX(TOPm1s);
-		IV biv = SvIVX(TOPs);
-		
-		SP--;
-		SETs(boolSV(aiv != biv));
-		RETURN;
-	    }
-	    if (auvok && buvok) { /* ## UV != UV ## */
-		UV auv = SvUVX(TOPm1s);
-		UV buv = SvUVX(TOPs);
+	    if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
+                /* Casting IV to UV before comparison isn't going to matter
+                   on 2s complement. On 1s complement or sign&magnitude
+                   (if we have any of them) it could make negative zero
+                   differ from normal zero. As I understand it. (Need to
+                   check - is negative zero implementation defined behaviour
+                   anyway?). NWC  */
+		UV buv = SvUVX(POPs);
+		UV auv = SvUVX(TOPs);
 		
-		SP--;
 		SETs(boolSV(auv != buv));
 		RETURN;
 	    }
@@ -1825,11 +1850,6 @@ PP(pp_ne)
 		    }
 		    uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
 		}
-		/* we know iv is >= 0 */
-		if (uv > (UV) IV_MAX) {
-		    SETs(&PL_sv_yes);
-		    RETURN;
-		}
 		SETs(boolSV((UV)iv != uv));
 		RETURN;
 	    }
@@ -1848,7 +1868,9 @@ PP(pp_ncmp)
     dSP; dTARGET; tryAMAGICbin(ncmp,0);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && SvROK(TOPm1s)) {
-	SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+        UV right = PTR2UV(SvRV(POPs));
+        UV left = PTR2UV(SvRV(TOPs));
+	SETi((left > right) - (left < right));
 	RETURN;
     }
 #endif
@@ -1891,10 +1913,7 @@ PP(pp_ncmp)
 		    value = 1;
 		} else {
 		    leftuv = SvUVX(TOPm1s);
-		    if (leftuv > (UV) IV_MAX) {
-			/* As (b) is an IV, it cannot be > IV_MAX */
-			value = 1;
-		    } else if (leftuv > (UV)rightiv) {
+		    if (leftuv > (UV)rightiv) {
 			value = 1;
 		    } else if (leftuv < (UV)rightiv) {
 			value = -1;
@@ -1912,12 +1931,9 @@ PP(pp_ncmp)
 		    value = -1;
 		} else {
 		    rightuv = SvUVX(TOPs);
-		    if (rightuv > (UV) IV_MAX) {
-			/* As (a) is an IV, it cannot be > IV_MAX */
-			value = -1;
-		    } else if (leftiv > (UV)rightuv) {
+		    if ((UV)leftiv > rightuv) {
 			value = 1;
-		    } else if (leftiv < (UV)rightuv) {
+		    } else if ((UV)leftiv < rightuv) {
 			value = -1;
 		    } else {
 			value = 0;
@@ -2157,15 +2173,22 @@ PP(pp_negate)
 		sv_setsv(TARG, sv);
 		*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
 	    }
-	    else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
-		sv_setpvn(TARG, "-", 1);
-		sv_catsv(TARG, sv);
+	    else if (DO_UTF8(sv)) {
+		SvIV_please(sv);
+		if (SvIOK(sv))
+		    goto oops_its_an_int;
+		if (SvNOK(sv))
+		    sv_setnv(TARG, -SvNV(sv));
+		else {
+		    sv_setpvn(TARG, "-", 1);
+		    sv_catsv(TARG, sv);
+		}
 	    }
 	    else {
-	      SvIV_please(sv);
-	      if (SvIOK(sv))
-		goto oops_its_an_int;
-	      sv_setnv(TARG, -SvNV(sv));
+		SvIV_please(sv);
+		if (SvIOK(sv))
+		  goto oops_its_an_int;
+		sv_setnv(TARG, -SvNV(sv));
 	    }
 	    SETTARG;
 	}
@@ -3073,8 +3096,16 @@ PP(pp_ord)
     SV *argsv = POPs;
     STRLEN len;
     U8 *s = (U8*)SvPVx(argsv, len);
+    SV *tmpsv;
+
+    if (PL_encoding && !DO_UTF8(argsv)) {
+        tmpsv = sv_2mortal(newSVsv(argsv));
+        s = (U8*)Perl_sv_recode_to_utf8(aTHX_ tmpsv, PL_encoding);
+        argsv = tmpsv;
+    }
 
     XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
+    
     RETURN;
 }
 
@@ -3103,15 +3134,18 @@ PP(pp_chr)
     *tmps++ = value;
     *tmps = '\0';
     (void)SvPOK_only(TARG);
+    if (PL_encoding)
+        Perl_sv_recode_to_utf8(aTHX_ TARG, PL_encoding);
     XPUSHs(TARG);
     RETURN;
 }
 
 PP(pp_crypt)
 {
-    dSP; dTARGET; dPOPTOPssrl;
-    STRLEN n_a;
+    dSP; dTARGET;
 #ifdef HAS_CRYPT
+    dPOPTOPssrl;
+    STRLEN n_a;
     STRLEN len;
     char *tmps = SvPV(left, len);
     char *t    = 0;
@@ -3128,11 +3162,11 @@ PP(pp_crypt)
 	 }
 	 tmps = t;
     }
-#ifdef FCRYPT
+#   ifdef FCRYPT
     sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
-#else
+#   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
-#endif
+#   endif
     Safefree(t);
 #else
     DIE(aTHX_