Change 14354: Make also hex() and oct() to croak if their arguments

[Jarkko Hietaniemi]

Change 14354 by jhi@alpha on 2002/01/20 06:35:54

        Make also hex() and oct() to croak if their arguments
        cannot be downgraded (that is, if they contain wide
        characters), just like crypt() does (and use the croak
        feature of sv_utf8_downgrade()).

Affected files ...

.... //depot/perl/pp.c#329 edit
.... //depot/perl/t/op/oct.t#15 edit

Differences ...

==== //depot/perl/pp.c#329 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~       Sat Jan 19 23:45:06 2002
+++ perl/pp.c   Sat Jan 19 23:45:06 2002
@@ -2791,8 +2791,18 @@
     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 @@
     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')
@@ -3178,15 +3198,15 @@
     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

==== //depot/perl/t/op/oct.t#15 (xtext) ====
Index: perl/t/op/oct.t
--- perl/t/op/oct.t.~1~ Sat Jan 19 23:45:06 2002
+++ perl/t/op/oct.t     Sat Jan 19 23:45:06 2002
@@ -2,7 +2,7 @@
 
 # tests 51 onwards aren't all warnings clean. (intentionally)
 
-print "1..69\n";
+print "1..71\n";
 
 my $test = 1;
 
@@ -145,3 +145,8 @@
 test ('hex', "0x4",     4);
 test ('hex', "x4",      4);
 
+eval '$a = oct "10\x{100}"';
+print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+eval '$a = hex "ab\x{100}"';
+print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++;
End of Patch.