Rewrite bignum’s hex and oct overrides
[perl.git] / dist / bignum / lib / bigint.pm
index 7f877ab..3120fdd 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 $VERSION = '0.30';
 use Exporter;
 @ISA           = qw( Exporter );
-@EXPORT_OK     = qw( PI e bpi bexp );
+@EXPORT_OK     = qw( PI e bpi bexp hex oct );
 @EXPORT                = qw( inf NaN );
 
 use strict;
@@ -120,38 +120,67 @@ sub in_effect
 #############################################################################
 # the following two routines are for "use bigint qw/hex oct/;":
 
-sub _hex_global
+use constant LEXICAL => $] > 5.009004;
+
+{
+    my $proto = LEXICAL ? '_' : ';$';
+    eval '
+sub hex(' . $proto . ')' . <<'.';
   {
-  my $i = $_[0];
+  my $i = @_ ? $_[0] : $_;
   $i = '0x'.$i unless $i =~ /^0x/;
   Math::BigInt->new($i);
   }
-
-sub _oct_global
+.
+    eval '
+sub oct(' . $proto . ')' . <<'.';
   {
-  my $i = $_[0];
-  return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/;
+  my $i = @_ ? $_[0] : $_;
+  # oct() should never fall back to decimal
+  return Math::BigInt->from_oct($i) if $i =~ /^(?:0[0-9]|[1-9])/;
   Math::BigInt->new($i);
   }
+.
+}
 
 #############################################################################
 # the following two routines are for Perl 5.9.4 or later and are lexical
 
-sub _hex
+my ($prev_oct, $prev_hex, $overridden);
+
+if (LEXICAL) { eval <<'.' }
+sub _hex(_)
   {
-  return CORE::hex($_[0]) unless in_effect(1);
+  my $hh = (caller 0)[10];
+  return $prev_hex ? &$prev_hex($_[0]) : CORE::hex($_[0])
+    unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat};
   my $i = $_[0];
   $i = '0x'.$i unless $i =~ /^0x/;
   Math::BigInt->new($i);
   }
 
-sub _oct
+sub _oct(_)
   {
-  return CORE::oct($_[0]) unless in_effect(1);
+  my $hh = (caller 0)[10];
+  return $prev_oct ? &$prev_oct($_[0]) : CORE::oct($_[0])
+    unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat};
   my $i = $_[0];
-  return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/;
+  # oct() should never fall back to decimal
+  return Math::BigInt->from_oct($i) if $i =~ /^(?:0[0-9]|[1-9])/;
   Math::BigInt->new($i);
   }
+.
+
+sub _override
+  {
+  return if $overridden;
+  $prev_oct = *CORE::GLOBAL::oct{CODE};
+  $prev_hex = *CORE::GLOBAL::hex{CODE};
+  no warnings 'redefine';
+  *CORE::GLOBAL::oct = \&_oct;
+  *CORE::GLOBAL::hex = \&_hex;
+  $overridden++;
+  }
 
 sub import 
   {
@@ -159,12 +188,10 @@ 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)
+  if (LEXICAL)
     {
-    $oct = \&_oct;
-    $hex = \&_hex;
+    _override();
     }
   # some defaults
   my $lib = ''; my $lib_kind = 'try';
@@ -205,17 +232,7 @@ sub import
       $trace = 1;
       splice @a, $j, 1; $j --;
       }
-    elsif ($_[$i] eq 'hex')
-      {
-      splice @a, $j, 1; $j --;
-      $hex = \&_hex_global;
-      }
-    elsif ($_[$i] eq 'oct')
-      {
-      splice @a, $j, 1; $j --;
-      $oct = \&_oct_global;
-      }
-    elsif ($_[$i] !~ /^(PI|e|bpi|bexp)\z/)
+    elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/)
       {
       die ("unknown option $_[$i]");
       }
@@ -271,11 +288,6 @@ sub import
     {
     $self->export_to_level(1,$self,@a);           # export inf and NaN, e and PI
     }
-  {
-    no warnings 'redefine';
-    *CORE::GLOBAL::oct = $oct if $oct;
-    *CORE::GLOBAL::hex = $hex if $hex;
-  }
   }
 
 sub inf () { Math::BigInt::binf(); }
@@ -302,14 +314,14 @@ bigint - Transparent BigInteger support for Perl
   print 2 ** 512,"\n";                 # really is what you think it is
   print inf + 42,"\n";                 # inf
   print NaN * 7,"\n";                  # NaN
-  print hex("0x1234567890123490"),"\n";        # Perl v5.9.4 or later
+  print hex("0x1234567890123490"),"\n";        # Perl v5.10.0 or later
 
   {
     no bigint;
     print 2 ** 256,"\n";               # a normal Perl scalar now
   }
 
-  # Note that this will be global:
+  # Import into current package:
   use bigint qw/hex oct/;
   print hex("0x1234567890123490"),"\n";
   print oct("01234567890123490"),"\n";
@@ -397,14 +409,16 @@ Math::BigInt.
 =item hex
 
 Override the built-in hex() method with a version that can handle big
-integers. Note that under Perl v5.9.4 or ealier, this will be global
-and cannot be disabled with "no bigint;".
+integers. This overrides it by exporting it to the current package. Under
+Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically
+overridden in the current scope whenever the bigint pragma is active.
 
 =item oct
 
 Override the built-in oct() method with a version that can handle big
-integers. Note that under Perl v5.9.4 or ealier, this will be global
-and cannot be disabled with "no bigint;".
+integers. This overrides it by exporting it to the current package. Under
+Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically
+overridden in the current scope whenever the bigint pragma is active.
 
 =item l, lib, try or only