From 1ac95999ae1a7fa7cd4cdbaed612a3b867560f23 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 20 Jan 2002 06:35:54 +0000
Subject: [PATCH] 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
---
 pp.c       | 32 ++++++++++++++++++++++++++------
 t/op/oct.t |  7 ++++++-
 2 files changed, 32 insertions(+), 7 deletions(-)

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++;
-- 
2.7.4