From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 20 Jan 2002 06:35:54 +0000 (+0000)
Subject: Make also hex() and oct() to croak if their arguments
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ac95999ae1a7fa7cd4cdbaed612a3b867560f23;p=p5sagit%2Fp5-mst-13.2.git

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()).

p4raw-id: //depot/perl@14354
---

diff --git a/pp.c b/pp.c
index 0d7f75b..d041f1b 100644
--- a/pp.c
+++ b/pp.c
@@ -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')
@@ -3178,15 +3198,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
diff --git a/t/op/oct.t b/t/op/oct.t
index 06bcf3e..f996b48 100755
--- a/t/op/oct.t
+++ b/t/op/oct.t
@@ -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', "x3A",	 0x3A);
 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++;