We need to replace the optimize (-O1) with

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index d6d0534..3ab629e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1256,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++;
@@ -1520,6 +1543,16 @@ PP(pp_lt)
        }
     }
 #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));
@@ -1588,6 +1621,16 @@ PP(pp_gt)
        }
     }
 #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));
@@ -1656,6 +1699,16 @@ PP(pp_le)
        }
     }
 #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));
@@ -1724,6 +1777,16 @@ PP(pp_ge)
        }
     }
 #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));
@@ -1736,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
@@ -1748,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);
+           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(aiv != biv));
-               RETURN;
-           }
-           if (auvok && buvok) { /* ## UV != UV ## */
-               UV auv = SvUVX(TOPm1s);
-               UV buv = SvUVX(TOPs);
-               
-               SP--;
                SETs(boolSV(auv != buv));
                RETURN;
            }
@@ -1807,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
@@ -3079,9 +3142,10 @@ PP(pp_chr)
 
 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;
@@ -3098,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_