This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Placate nervous compilers that see longer than ints switch()ing.
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 03609e8..2a414b8 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1068,7 +1068,7 @@ PP(pp_repeat)
 {
   djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
   {
-    register I32 count = POPi;
+    register IV count = POPi;
     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
        I32 items = SP - MARK;
@@ -1468,21 +1468,72 @@ PP(pp_complement)
        }
       }
       else {
-       register char *tmps;
-       register long *tmpl;
+       register U8 *tmps;
        register I32 anum;
        STRLEN len;
 
        SvSetSV(TARG, sv);
-       tmps = SvPV_force(TARG, len);
+       tmps = (U8*)SvPV_force(TARG, len);
        anum = len;
+       if (SvUTF8(TARG)) {
+         /* Calculate exact length, let's not estimate. */
+         STRLEN targlen = 0;
+         U8 *result;
+         U8 *send;
+         STRLEN l;
+         UV nchar = 0;
+         UV nwide = 0;
+
+         send = tmps + len;
+         while (tmps < send) {
+           UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+           tmps += UTF8SKIP(tmps);
+           targlen += UNISKIP(~c);
+           nchar++;
+           if (c > 0xff)
+               nwide++;
+         }
+
+         /* Now rewind strings and write them. */
+         tmps -= len;
+
+         if (nwide) {
+             Newz(0, result, targlen + 1, U8);
+             while (tmps < send) {
+                 UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+                 tmps += UTF8SKIP(tmps);
+                 result = uv_to_utf8(result, ~c);
+             }
+             *result = '\0';
+             result -= targlen;
+             sv_setpvn(TARG, (char*)result, targlen);
+             SvUTF8_on(TARG);
+         }
+         else {
+             Newz(0, result, nchar + 1, U8);
+             while (tmps < send) {
+                 U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+                 tmps += UTF8SKIP(tmps);
+                 *result++ = ~c;
+             }
+             *result = '\0';
+             result -= nchar;
+             sv_setpvn(TARG, (char*)result, nchar);
+         }
+         Safefree(result);
+         SETs(TARG);
+         RETURN;
+       }
 #ifdef LIBERAL
-       for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
-           *tmps = ~*tmps;
-       tmpl = (long*)tmps;
-       for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
-           *tmpl = ~*tmpl;
-       tmps = (char*)tmpl;
+       {
+           register long *tmpl;
+           for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
+               *tmps = ~*tmps;
+           tmpl = (long*)tmps;
+           for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
+               *tmpl = ~*tmpl;
+           tmps = (U8*)tmpl;
+       }
 #endif
        for ( ; anum > 0; anum--, tmps++)
            *tmps = ~*tmps;
@@ -1534,7 +1585,7 @@ PP(pp_i_add)
 {
     djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left + right );
       RETURN;
     }
@@ -1544,7 +1595,7 @@ PP(pp_i_subtract)
 {
     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left - right );
       RETURN;
     }
@@ -1857,11 +1908,24 @@ PP(pp_int)
        SETi(iv);
       }
       else {
-       if (value >= 0.0)
-         (void)Perl_modf(value, &value);
+         if (value >= 0.0) {
+#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+             (void)Perl_modf(value, &value);
+#else
+             double tmp = (double)value;
+             (void)Perl_modf(tmp, &tmp);
+             value = (NV)tmp;
+#endif
+         }
        else {
-         (void)Perl_modf(-value, &value);
-         value = -value;
+#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+           (void)Perl_modf(-value, &value);
+           value = -value;
+#else
+           double tmp = (double)value;
+           (void)Perl_modf(-tmp, &tmp);
+           value = -(NV)tmp;
+#endif
        }
        iv = I_V(value);
        if (iv == value)
@@ -1899,7 +1963,7 @@ PP(pp_hex)
 {
     djSP; dTARGET;
     char *tmps;
-    I32 argtype;
+    STRLEN argtype;
     STRLEN n_a;
 
     tmps = POPpx;
@@ -1912,7 +1976,7 @@ PP(pp_oct)
 {
     djSP; dTARGET;
     NV value;
-    I32 argtype;
+    STRLEN argtype;
     char *tmps;
     STRLEN n_a;
 
@@ -2072,8 +2136,8 @@ PP(pp_substr)
 PP(pp_vec)
 {
     djSP; dTARGET;
-    register I32 size = POPi;
-    register I32 offset = POPi;
+    register IV size   = POPi;
+    register IV offset = POPi;
     register SV *src = POPs;
     I32 lvalue = PL_op->op_flags & OPf_MOD;
 
@@ -2189,13 +2253,13 @@ PP(pp_ord)
 {
     djSP; dTARGET;
     UV value;
-    STRLEN n_a;
     SV *tmpsv = POPs;
-    U8 *tmps = (U8*)SvPVx(tmpsv,n_a);
-    I32 retlen;
+    STRLEN len;
+    U8 *tmps = (U8*)SvPVx(tmpsv, len);
+    STRLEN retlen;
 
     if ((*tmps & 0x80) && DO_UTF8(tmpsv))
-       value = utf8_to_uv_chk(tmps, &retlen, 0);
+       value = utf8_to_uv(tmps, len, &retlen, 0);
     else
        value = (UV)(*tmps & 255);
     XPUSHu(value);
@@ -2206,7 +2270,7 @@ PP(pp_chr)
 {
     djSP; dTARGET;
     char *tmps;
-    U32 value = POPu;
+    UV value = POPu;
 
     (void)SvUPGRADE(TARG,SVt_PV);
 
@@ -2259,10 +2323,10 @@ PP(pp_ucfirst)
     STRLEN slen;
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
-       I32 ulen;
+       STRLEN ulen;
        U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
-       UV uv = utf8_to_uv_chk(s, &ulen, 0);
+       UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2318,10 +2382,10 @@ PP(pp_lcfirst)
     STRLEN slen;
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
-       I32 ulen;
+       STRLEN ulen;
        U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
-       UV uv = utf8_to_uv_chk(s, &ulen, 0);
+       UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2378,7 +2442,7 @@ PP(pp_uc)
 
     if (DO_UTF8(sv)) {
        dTARGET;
-       I32 ulen;
+       STRLEN ulen;
        register U8 *d;
        U8 *send;
 
@@ -2398,7 +2462,7 @@ PP(pp_uc)
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
-                   d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
+                   d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
                    s += ulen;
                }
            }
@@ -2452,7 +2516,7 @@ PP(pp_lc)
 
     if (DO_UTF8(sv)) {
        dTARGET;
-       I32 ulen;
+       STRLEN ulen;
        register U8 *d;
        U8 *send;
 
@@ -2472,7 +2536,7 @@ PP(pp_lc)
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
-                   d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
+                   d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
                    s += ulen;
                }
            }
@@ -3316,9 +3380,9 @@ PP(pp_unpack)
     register char *str;
 
     /* These must not be in registers: */
-    I16 ashort;
+    short ashort;
     int aint;
-    I32 along;
+    long along;
 #ifdef HAS_QUAD
     Quad_t aquad;
 #endif
@@ -3614,7 +3678,9 @@ PP(pp_unpack)
                len = strend - s;
            if (checksum) {
                while (len-- > 0 && s < strend) {
-                   auint = utf8_to_uv_chk((U8*)s, &along, 0);
+                   STRLEN alen;
+                   auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+                   along = alen;
                    s += along;
                    if (checksum > 32)
                        cdouble += (NV)auint;
@@ -3626,7 +3692,9 @@ PP(pp_unpack)
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
                while (len-- > 0 && s < strend) {
-                   auint = utf8_to_uv_chk((U8*)s, &along, 0);
+                   STRLEN alen;
+                   auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+                   along = alen;
                    s += along;
                    sv = NEWSV(37, 0);
                    sv_setuv(sv, (UV)auint);
@@ -4973,7 +5041,7 @@ PP(pp_split)
 {
     djSP; dTARG;
     AV *ary;
-    register I32 limit = POPi;                 /* note, negative is forever */
+    register IV limit = POPi;                  /* note, negative is forever */
     SV *sv = POPs;
     bool doutf8 = DO_UTF8(sv);
     STRLEN len;