Tels' patch to defer overloading of hex and oct,

to avoid magic leaking and smoke failures under
utf-8 locales

p4raw-id: //depot/perl@31450

diff --git a/lib/bigint.pm b/lib/bigint.pm
index c64116a..941ee5c 100644 (file)
--- a/lib/bigint.pm
+++ b/lib/bigint.pm
@@ -159,12 +159,12 @@ sub import
 
   $^H{bigint} = 1;                                     # we are in effect
 
+  my ($hex,$oct);
   # for newer Perls always override hex() and oct() with a lexical version:
   if ($] > 5.009004)
     {
-    no warnings 'redefine';
-    *CORE::GLOBAL::oct = \&_oct;
-    *CORE::GLOBAL::hex = \&_hex;
+    $oct = \&_oct;
+    $hex = \&_hex;
     }
   # some defaults
   my $lib = ''; my $lib_kind = 'try';
@@ -208,14 +208,12 @@ sub import
     elsif ($_[$i] eq 'hex')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      *CORE::GLOBAL::hex = \&_hex_global;
+      $hex = \&_hex_global;
       }
     elsif ($_[$i] eq 'oct')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      *CORE::GLOBAL::oct = \&_oct_global;
+      $oct = \&_oct_global;
       }
     else { die "unknown option $_[$i]"; }
     }
@@ -270,6 +268,11 @@ sub import
     {
     $self->export_to_level(1,$self,@a);           # export inf and NaN
     }
+  {
+    no warnings 'redefine';
+    *CORE::GLOBAL::oct = $oct if $oct;
+    *CORE::GLOBAL::hex = $hex if $hex;
+  }
   }
 
 sub inf () { Math::BigInt->binf(); }

diff --git a/lib/bignum.pm b/lib/bignum.pm
index 4323356..5ebb904 100644 (file)
--- a/lib/bignum.pm
+++ b/lib/bignum.pm
@@ -92,12 +92,13 @@ sub import
 
   $^H{bignum} = 1;                                     # we are in effect
 
+  my ($hex,$oct);
+
   # for newer Perls override hex() and oct() with a lexical version:
   if ($] > 5.009003)
     {
-    no warnings 'redefine';
-    *CORE::GLOBAL::oct = \&_oct;
-    *CORE::GLOBAL::hex = \&_hex;
+    $hex = \&_hex;
+    $oct = \&_oct;
     }
 
   # some defaults
@@ -158,16 +159,12 @@ sub import
     elsif ($_[$i] eq 'hex')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      # override with a global version
-      *CORE::GLOBAL::hex = \&bigint::_hex_global;
+      $hex = \&bigint::_hex_global;
       }
     elsif ($_[$i] eq 'oct')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      # override with a global version
-      *CORE::GLOBAL::oct = \&bigint::_oct_global;
+      $oct = \&bigint::_oct_global;
       }
     else { die "unknown option $_[$i]"; }
     }
@@ -233,6 +230,11 @@ sub import
     {
     $self->export_to_level(1,$self,@a);           # export inf and NaN
     }
+  {
+    no warnings 'redefine';
+    *CORE::GLOBAL::oct = $oct if $oct;
+    *CORE::GLOBAL::hex = $hex if $hex;
+  }
   }
 
 1;

diff --git a/lib/bigrat.pm b/lib/bigrat.pm
index 884e9da..a4de1d6 100644 (file)
--- a/lib/bigrat.pm
+++ b/lib/bigrat.pm
@@ -95,12 +95,12 @@ sub import
 
   $^H{bigrat} = 1;                                     # we are in effect
 
+  my ($hex,$oct);
   # for newer Perls always override hex() and oct() with a lexical version:
   if ($] > 5.009004)
     {
-    no warnings 'redefine';
-    *CORE::GLOBAL::oct = \&_oct;
-    *CORE::GLOBAL::hex = \&_hex;
+    $oct = \&_oct;
+    $hex = \&_hex;
     }
   # some defaults
   my $lib = ''; my $lib_kind = 'try'; my $upgrade = 'Math::BigFloat';
@@ -151,14 +151,12 @@ sub import
     elsif ($_[$i] eq 'hex')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      *CORE::GLOBAL::hex = \&bigint::_hex_global;
+      $hex = \&bigint::_hex_global;
       }
     elsif ($_[$i] eq 'oct')
       {
       splice @a, $j, 1; $j --;
-      no warnings 'redefine';
-      *CORE::GLOBAL::oct = \&bigint::_oct_global;
+      $oct = \&bigint::_oct_global;
       }
     else
       {
@@ -221,6 +219,11 @@ sub import
     {
     $self->export_to_level(1,$self,@a);           # export inf and NaN
     }
+  {
+    no warnings 'redefine';
+    *CORE::GLOBAL::oct = $oct if $oct;
+    *CORE::GLOBAL::hex = $hex if $hex;
+  }
   }
 
 1;

diff --git a/lib/charnames.pm b/lib/charnames.pm
index ef1472c..3b42738 100644 (file)
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -2,7 +2,7 @@ package charnames;
 use strict;
 use warnings;
 use File::Spec;
-our $VERSION = '1.05';
+our $VERSION = '1.06';
 
 use bytes ();          # for $bytes::hint_bits
 
@@ -167,7 +167,7 @@ sub charnames
 
     ## we know where it starts, so turn into number -
     ## the ordinal for the char.
-    $ord = hex substr($txt, $hexstart, $off[0] - $hexstart);
+    $ord = CORE::hex substr($txt, $hexstart, $off[0] - $hexstart);
   }
 
   if ($^H & $bytes::hint_bits) {       # "use bytes" in effect?
@@ -294,7 +294,7 @@ sub vianame
 
   my $arg = shift;
 
-  return chr hex $1 if $arg =~ /^U\+([0-9a-fA-F]+)$/;
+  return chr CORE::hex $1 if $arg =~ /^U\+([0-9a-fA-F]+)$/;
 
   return $vianame{$arg} if exists $vianame{$arg};
 
@@ -304,7 +304,7 @@ sub vianame
   if ($[ <= $pos) {
     my $posLF = rindex $txt, "\n", $pos;
     (my $code = substr $txt, $posLF + 1, 6) =~ tr/\t//d;
-    return $vianame{$arg} = hex $code;
+    return $vianame{$arg} = CORE::hex $code;
 
     # If $pos is at the 1st line, $posLF must be $[ - 1 (not found);
     # then $posLF + 1 equals to $[ (at the beginning of $txt).

diff --git a/lib/utf8.pm b/lib/utf8.pm
index ac73aa1..a985021 100644 (file)
--- a/lib/utf8.pm
+++ b/lib/utf8.pm
@@ -2,7 +2,7 @@ package utf8;
 
 $utf8::hint_bits = 0x00800000;
 
-our $VERSION = '1.06';
+our $VERSION = '1.07';
 
 sub import {
     $^H |= $utf8::hint_bits;

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index c7bf527..b6b6b6e 100644 (file)
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -213,7 +213,7 @@ sub SWASHNEW {
        $list = join '',
            map  { $_->[1] }
            sort { $a->[0] <=> $b->[0] }
-           map  { /^([0-9a-fA-F]+)/; [ hex($1), $_ ] }
+           map  { /^([0-9a-fA-F]+)/; [ CORE::hex($1), $_ ] }
            grep { /^([0-9a-fA-F]+)/ and not $seen{$1}++ } @tmp; # XXX doesn't do ranges right
     }
 
@@ -225,9 +225,9 @@ sub SWASHNEW {
     if ($minbits != 1 && $minbits < 32) { # not binary property
        my $top = 0;
        while ($list =~ /^([0-9a-fA-F]+)(?:[\t]([0-9a-fA-F]+)?)(?:[ \t]([0-9a-fA-F]+))?/mg) {
-           my $min = hex $1;
-           my $max = defined $2 ? hex $2 : $min;
-           my $val = defined $3 ? hex $3 : 0;
+           my $min = CORE::hex $1;
+           my $max = defined $2 ? CORE::hex $2 : $min;
+           my $val = defined $3 ? CORE::hex $3 : 0;
            $val += $max - $min if defined $3;
            $top = $val if $val > $top;
        }