Tests are good

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

diff --git a/pp.c b/pp.c
index 1c323f7..e4354ea 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++;
@@ -1736,7 +1759,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
@@ -1807,7 +1831,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
@@ -3033,8 +3059,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;
 }
 
@@ -3063,6 +3097,8 @@ 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;
 }