ext/re/hints/MSWin32.pl seems to be missing from perlio.

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

diff --git a/pp.c b/pp.c
index 6d77ca1..59c67e9 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -178,7 +178,7 @@ PP(pp_padany)
 
 PP(pp_rv2gv)
 {
-    djSP; dTOPss;  
+    djSP; dTOPss;
 
     if (SvROK(sv)) {
       wasref:
@@ -206,9 +206,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 +223,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 +411,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 +435,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 +568,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 +585,7 @@ PP(pp_gelem)
     char *elem;
     djSP;
     STRLEN n_a;
- 
+
     sv = POPs;
     elem = SvPV(sv, n_a);
     gv = (GV*)POPs;
@@ -1476,31 +1477,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, 0, &l, UTF8_ALLOW_ANY);
+           UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
            tmps += UTF8SKIP(tmps);
            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, 0, &l, UTF8_ALLOW_ANY);
-           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 +1572,7 @@ PP(pp_i_divide)
 
 PP(pp_i_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); 
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
       dPOPTOPiirl;
       if (!right)
@@ -1566,7 +1586,7 @@ PP(pp_i_add)
 {
     djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left + right );
       RETURN;
     }
@@ -1576,7 +1596,7 @@ PP(pp_i_subtract)
 {
     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
     {
-      dPOPTOPiirl;
+      dPOPTOPiirl_ul;
       SETi( left - right );
       RETURN;
     }
@@ -2289,7 +2309,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);
@@ -2897,7 +2917,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;
@@ -3916,7 +3936,6 @@ PP(pp_unpack)
            if (checksum) {
 #if LONGSIZE != SIZE32
                if (natint) {
-                   long along;
                    while (len-- > 0) {
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
@@ -3930,6 +3949,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)
@@ -3948,7 +3970,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);
@@ -3961,6 +3982,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)
@@ -4229,7 +4253,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;
                 /*
@@ -4474,7 +4498,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')
@@ -5205,7 +5229,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,