An inconvenient hang would happen if the stdio _ptr wasn't
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 35f5956..17beb6c 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -82,10 +82,6 @@ static double UV_MAX_cxux = ((double)UV_MAX);
 
 /* variations on pp_null */
 
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
-
 /* XXX I can't imagine anyone who doesn't have this actually _needs_
    it, since pid_t is an integral type.
    --AD  2/20/1998
@@ -178,7 +174,7 @@ PP(pp_padany)
 
 PP(pp_rv2gv)
 {
-    djSP; dTOPss;  
+    djSP; dTOPss;
 
     if (SvROK(sv)) {
       wasref:
@@ -206,9 +202,9 @@ PP(pp_rv2gv)
                    goto wasref;
            }
            if (!SvOK(sv) && sv != &PL_sv_undef) {
-               /* If this is a 'my' scalar and flag is set then vivify 
+               /* If this is a 'my' scalar and flag is set then vivify
                 * NI-S 1999/05/07
-                */ 
+                */
                if (PL_op->op_private & OPpDEREF) {
                    char *name;
                    GV *gv;
@@ -223,7 +219,8 @@ PP(pp_rv2gv)
                        name = CopSTASHPV(PL_curcop);
                        gv = newGVgen(name);
                    }
-                   sv_upgrade(sv, SVt_RV);
+                   if (SvTYPE(sv) < SVt_RV)
+                       sv_upgrade(sv, SVt_RV);
                    SvRV(sv) = (SV*)gv;
                    SvROK_on(sv);
                    SvSETMAGIC(sv);
@@ -410,7 +407,7 @@ PP(pp_prototype)
        char *s = SvPVX(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
            int code;
-           
+       
            code = keyword(s + 6, SvCUR(TOPs) - 6);
            if (code < 0) {     /* Overridable. */
 #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
@@ -434,9 +431,9 @@ PP(pp_prototype)
                        seen_question = 1;
                        str[n++] = ';';
                    }
-                   else if (n && str[0] == ';' && seen_question) 
+                   else if (n && str[0] == ';' && seen_question)
                        goto set;       /* XXXX system, exec */
-                   if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
+                   if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
                        && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
                        str[n++] = '\\';
                    }
@@ -567,7 +564,7 @@ PP(pp_bless)
            Perl_croak(aTHX_ "Attempt to bless into a reference");
        ptr = SvPV(ssv,len);
        if (ckWARN(WARN_MISC) && len == 0)
-           Perl_warner(aTHX_ WARN_MISC, 
+           Perl_warner(aTHX_ WARN_MISC,
                   "Explicit blessing to '' (assuming package main)");
        stash = gv_stashpvn(ptr, len, TRUE);
     }
@@ -584,7 +581,7 @@ PP(pp_gelem)
     char *elem;
     djSP;
     STRLEN n_a;
+
     sv = POPs;
     elem = SvPV(sv, n_a);
     gv = (GV*)POPs;
@@ -1476,31 +1473,50 @@ PP(pp_complement)
        tmps = (U8*)SvPV_force(TARG, len);
        anum = len;
        if (SvUTF8(TARG)) {
-         /* Calculate exact length, let's not estimate */
+         /* 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, &l);
+           UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
            tmps += UTF8SKIP(tmps);
-           targlen += UTF8LEN(~c);
+           targlen += UNISKIP(~c);
+           nchar++;
+           if (c > 0xff)
+               nwide++;
          }
 
          /* Now rewind strings and write them. */
          tmps -= len;
-         Newz(0, result, targlen + 1, U8);
-         while (tmps < send) {
-           UV c = utf8_to_uv(tmps, &l);
-           tmps += UTF8SKIP(tmps);
-           result = uv_to_utf8(result,(UV)~c);
+
+         if (nwide) {
+             Newz(0, result, targlen + 1, U8);
+             while (tmps < send) {
+                 UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
+                 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);
          }
-         *result = '\0';
-         result -= targlen;
-         sv_setpvn(TARG, (char*)result, targlen);
-         SvUTF8_on(TARG);
          Safefree(result);
          SETs(TARG);
          RETURN;
@@ -1552,7 +1568,7 @@ PP(pp_i_divide)
 
 PP(pp_i_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); 
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
       dPOPTOPiirl;
       if (!right)
@@ -1566,7 +1582,7 @@ PP(pp_i_add)
 {
     djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left + right );
       RETURN;
     }
@@ -1576,7 +1592,7 @@ PP(pp_i_subtract)
 {
     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left - right );
       RETURN;
     }
@@ -2240,7 +2256,7 @@ PP(pp_ord)
     STRLEN retlen;
 
     if ((*tmps & 0x80) && DO_UTF8(tmpsv))
-       value = utf8_to_uv_chk(tmps, len, &retlen, 0);
+       value = utf8_to_uv(tmps, len, &retlen, 0);
     else
        value = (UV)(*tmps & 255);
     XPUSHu(value);
@@ -2289,7 +2305,7 @@ PP(pp_crypt)
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #endif
 #else
-    DIE(aTHX_ 
+    DIE(aTHX_
       "The crypt() function is unimplemented due to excessive paranoia.");
 #endif
     SETs(TARG);
@@ -2307,7 +2323,7 @@ PP(pp_ucfirst)
        STRLEN ulen;
        U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
-       UV uv = utf8_to_uv_chk(s, slen, &ulen, 0);
+       UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2366,7 +2382,7 @@ PP(pp_lcfirst)
        STRLEN ulen;
        U8 tmpbuf[UTF8_MAXLEN];
        U8 *tend;
-       UV uv = utf8_to_uv_chk(s, slen, &ulen, 0);
+       UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2443,7 +2459,7 @@ PP(pp_uc)
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
-                   d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv_chk(s, len, &ulen, 0)));
+                   d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
                    s += ulen;
                }
            }
@@ -2517,7 +2533,7 @@ PP(pp_lc)
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
-                   d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv_chk(s, len, &ulen, 0)));
+                   d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
                    s += ulen;
                }
            }
@@ -2897,7 +2913,7 @@ PP(pp_lslice)
        ix = SvIVx(*lelem);
        if (ix < 0)
            ix += max;
-       else 
+       else
            ix -= arybase;
        if (ix < 0 || ix >= max)
            *lelem = &PL_sv_undef;
@@ -3361,9 +3377,9 @@ PP(pp_unpack)
     register char *str;
 
     /* These must not be in registers: */
-    I16 ashort;
+    short ashort;
     int aint;
-    STRLEN along;
+    long along;
 #ifdef HAS_QUAD
     Quad_t aquad;
 #endif
@@ -3659,7 +3675,9 @@ PP(pp_unpack)
                len = strend - s;
            if (checksum) {
                while (len-- > 0 && s < strend) {
-                   auint = utf8_to_uv_chk((U8*)s, strend - 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;
@@ -3671,7 +3689,9 @@ PP(pp_unpack)
                EXTEND(SP, len);
                EXTEND_MORTAL(len);
                while (len-- > 0 && s < strend) {
-                   auint = utf8_to_uv_chk((U8*)s, strend - 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);
@@ -3912,7 +3932,6 @@ PP(pp_unpack)
            if (checksum) {
 #if LONGSIZE != SIZE32
                if (natint) {
-                   long along;
                    while (len-- > 0) {
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
@@ -3926,6 +3945,9 @@ PP(pp_unpack)
 #endif
                 {
                    while (len-- > 0) {
+#if LONGSIZE > SIZE32 && INTSIZE == SIZE32
+                       I32 along;
+#endif
                        COPY32(s, &along);
 #if LONGSIZE > SIZE32
                        if (along > 2147483647)
@@ -3944,7 +3966,6 @@ PP(pp_unpack)
                EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
                if (natint) {
-                   long along;
                    while (len-- > 0) {
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
@@ -3957,6 +3978,9 @@ PP(pp_unpack)
 #endif
                 {
                    while (len-- > 0) {
+#if LONGSIZE > SIZE32 && INTSIZE == SIZE32
+                       I32 along;
+#endif
                        COPY32(s, &along);
 #if LONGSIZE > SIZE32
                        if (along > 2147483647)
@@ -4225,7 +4249,7 @@ PP(pp_unpack)
              */
             if (PL_uudmap['M'] == 0) {
                 int i;
+
                 for (i = 0; i < sizeof(PL_uuemap); i += 1)
                     PL_uudmap[(U8)PL_uuemap[i]] = i;
                 /*
@@ -4470,7 +4494,7 @@ PP(pp_pack)
            patcopy++;
            continue;
         }
-       if (datumtype == 'U' && pat == patcopy+1) 
+       if (datumtype == 'U' && pat == patcopy+1)
            SvUTF8_on(cat);
        if (datumtype == '#') {
            while (pat < patend && *pat != '\n')
@@ -5201,7 +5225,7 @@ PP(pp_split)
     else {
        maxiters += (strend - s) * rx->nparens;
        while (s < strend && --limit
-/*            && (!rx->check_substr 
+/*            && (!rx->check_substr
                   || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
                                                 0, NULL))))
 */            && CALLREGEXEC(aTHX_ rx, s, strend, orig,