compile warnings (was Re: Smoke 14756 /pro/3gl/CPAN/perl-current)

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

diff --git a/pp.c b/pp.c
index ef0c75e..f856ea6 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1,6 +1,6 @@
 /*    pp.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -2791,8 +2791,18 @@ PP(pp_hex)
     STRLEN len;
     NV result_nv;
     UV result_uv;
+    SV* sv = POPs;
 
-    tmps = (SvPVx(POPs, len));
+    tmps = (SvPVx(sv, len));
+    if (DO_UTF8(sv)) {
+        /* If Unicode, try to downgrade
+         * If not possible, croak. */
+         SV* tsv = sv_2mortal(newSVsv(sv));
+       
+        SvUTF8_on(tsv);
+        sv_utf8_downgrade(tsv, FALSE);
+        tmps = SvPVX(tsv);
+    }
     result_uv = grok_hex (tmps, &len, &flags, &result_nv);
     if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
         XPUSHn(result_nv);
@@ -2811,8 +2821,18 @@ PP(pp_oct)
     STRLEN len;
     NV result_nv;
     UV result_uv;
+    SV* sv = POPs;
 
-    tmps = (SvPVx(POPs, len));
+    tmps = (SvPVx(sv, len));
+    if (DO_UTF8(sv)) {
+        /* If Unicode, try to downgrade
+         * If not possible, croak. */
+         SV* tsv = sv_2mortal(newSVsv(sv));
+       
+        SvUTF8_on(tsv);
+        sv_utf8_downgrade(tsv, FALSE);
+        tmps = SvPVX(tsv);
+    }
     while (*tmps && len && isSPACE(*tmps))
         tmps++, len--;
     if (*tmps == '0')
@@ -3148,8 +3168,7 @@ PP(pp_chr)
 
     if (value > 255 && !IN_BYTES) {
        SvGROW(TARG, UNISKIP(value)+1);
-       tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value,
-                                         UNICODE_ALLOW_SUPER);
+       tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
        SvCUR_set(TARG, tmps - SvPVX(TARG));
        *tmps = '\0';
        (void)SvPOK_only(TARG);
@@ -3178,15 +3197,15 @@ PP(pp_crypt)
     STRLEN n_a;
     STRLEN len;
     char *tmps = SvPV(left, len);
+
     if (DO_UTF8(left)) {
-         /* If Unicode, try to dowgrade.
+         /* If Unicode, try to downgrade.
          * If not possible, croak.
          * Yes, we made this up.  */
          SV* tsv = sv_2mortal(newSVsv(left));
-       
+
         SvUTF8_on(tsv);
-        if (!sv_utf8_downgrade(tsv, FALSE))
-             Perl_croak(aTHX_ "Wide character in crypt");
+        sv_utf8_downgrade(tsv, FALSE);
         tmps = SvPVX(tsv);
     }
 #   ifdef FCRYPT
@@ -3331,8 +3350,10 @@ PP(pp_uc)
            SETs(TARG);
        }
        else {
+           STRLEN nchar = utf8_length(s, s + len);
+
            (void)SvUPGRADE(TARG, SVt_PV);
-           SvGROW(TARG, (len * 2) + 1);
+           SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1);
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;
@@ -3398,8 +3419,10 @@ PP(pp_lc)
            SETs(TARG);
        }
        else {
+           STRLEN nchar = utf8_length(s, s + len);
+
            (void)SvUPGRADE(TARG, SVt_PV);
-           SvGROW(TARG, (len * 2) + 1);
+           SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1);
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;