dist/bignum/t/option_a.t See if bignum a => X works
dist/bignum/t/option_l.t See if bignum l => X works
dist/bignum/t/option_p.t See if bignum p => X works
+dist/bignum/t/overrides.t See if global overrides behave
dist/bignum/t/ratopt_a.t See if bigrat a => X works
dist/bignum/t/scope_f.t See if no bignum works
dist/bignum/t/scope_i.t See if no bigint works
$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;
#############################################################################
# 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
{
$^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';
$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]");
}
{
$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(); }
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";
=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
$VERSION = '0.30';
use Exporter;
@ISA = qw( bigint );
-@EXPORT_OK = qw( PI e bexp bpi );
+@EXPORT_OK = qw( PI e bexp bpi hex oct );
@EXPORT = qw( inf NaN );
use strict;
{
*inf = \&bigint::inf;
*NaN = \&bigint::NaN;
+ *hex = \&bigint::hex;
+ *oct = \&bigint::oct;
}
# These are all alike, and thus faked by AUTOLOAD
}
#############################################################################
-# the following two routines are for Perl 5.9.4 or later and are lexical
-
-sub _hex
- {
- return CORE::hex($_[0]) unless in_effect(1);
- my $i = $_[0];
- $i = '0x'.$i unless $i =~ /^0x/;
- Math::BigInt->new($i);
- }
-
-sub _oct
- {
- return CORE::oct($_[0]) unless in_effect(1);
- my $i = $_[0];
- return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/;
- Math::BigInt->new($i);
- }
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)
+ if ($] > 5.009004)
{
- $hex = \&_hex;
- $oct = \&_oct;
+ bigint::_override();
}
# some defaults
$trace = 1;
splice @a, $j, 1; $j --;
}
- elsif ($_[$i] eq 'hex')
- {
- splice @a, $j, 1; $j --;
- $hex = \&bigint::_hex_global;
- }
- elsif ($_[$i] eq 'oct')
- {
- splice @a, $j, 1; $j --;
- $oct = \&bigint::_oct_global;
- }
- elsif ($_[$i] !~ /^(PI|e|bexp|bpi)\z/)
+ elsif ($_[$i] !~ /^(PI|e|bexp|bpi|hex|oct)\z/)
{
die ("unknown option $_[$i]");
}
{
$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 PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); }
print 2 ** 256,"\n"; # a normal Perl scalar now
}
- # for older Perls, note that this will be global:
+ # for older Perls, import into current package:
use bignum qw/hex oct/;
print hex("0x1234567890123490"),"\n";
print oct("01234567890123490"),"\n";
=item hex
Override the built-in hex() method with a version that can handle big
-integers. Note that under Perl older than v5.9.4, this will be global
-and cannot be disabled with "no bigint;".
+numbers. 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 bignum pragma is active.
=item oct
Override the built-in oct() method with a version that can handle big
-integers. Note that under Perl older than v5.9.4, this will be global
-and cannot be disabled with "no bigint;".
+numbers. 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 v or version
$VERSION = '0.30';
require Exporter;
@ISA = qw( bigint );
-@EXPORT_OK = qw( PI e bpi bexp );
+@EXPORT_OK = qw( PI e bpi bexp hex oct );
@EXPORT = qw( inf NaN );
use strict;
{
*inf = \&bigint::inf;
*NaN = \&bigint::NaN;
+ *hex = \&bigint::hex;
+ *oct = \&bigint::oct;
}
# These are all alike, and thus faked by AUTOLOAD
}
#############################################################################
-# the following two routines are for Perl 5.9.4 or later and are lexical
-
-sub _hex
- {
- return CORE::hex($_[0]) unless in_effect(1);
- my $i = $_[0];
- $i = '0x'.$i unless $i =~ /^0x/;
- Math::BigInt->new($i);
- }
-
-sub _oct
- {
- return CORE::oct($_[0]) unless in_effect(1);
- my $i = $_[0];
- return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/;
- Math::BigInt->new($i);
- }
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)
{
- $oct = \&_oct;
- $hex = \&_hex;
+ bigint::_override();
}
# some defaults
my $lib = ''; my $lib_kind = 'try'; my $upgrade = 'Math::BigFloat';
$trace = 1;
splice @a, $j, 1; $j --;
}
- elsif ($_[$i] eq 'hex')
- {
- splice @a, $j, 1; $j --;
- $hex = \&bigint::_hex_global;
- }
- elsif ($_[$i] eq 'oct')
- {
- splice @a, $j, 1; $j --;
- $oct = \&bigint::_oct_global;
- }
- elsif ($_[$i] !~ /^(PI|e|bpi|bexp)\z/)
+ elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/)
{
die ("unknown option $_[$i]");
}
{
$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 PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); }
print 1/3,"\n"; # 0.33333...
}
- # Note that this will make hex() and oct() be globally overridden:
+ # Import into current package:
use bigrat qw/hex oct/;
print hex("0x1234567890123490"),"\n";
print oct("01234567890123490"),"\n";
=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;".
+numbers. 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 bigrat 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 earlier, this will be global
-and cannot be disabled with "no bigint;".
+numbers. 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 bigrat pragma is active.
=item v or version
--- /dev/null
+#!perl -w
+
+# Test behaviour of hex and oct overrides in detail, and also how the three
+# modules interact.
+
+use Test::More tests => 35;
+
+# For testing that existing CORE::GLOBAL overrides are not clobbered
+BEGIN
+ {
+ if ($] > 5.009004)
+ {
+ no warnings 'syntax';
+ *CORE::GLOBAL::hex = sub(_) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
+ *CORE::GLOBAL::oct = sub(_) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
+ }
+ else
+ {
+ *CORE::GLOBAL::hex = sub(;$) { ++$hex_called; CORE::hex(@_?$_[0]:$_) };
+ *CORE::GLOBAL::oct = sub(;$) { ++$oct_called; CORE::oct(@_?$_[0]:$_) };
+ }
+ }
+
+{
+ use bigint;
+ $_ = "20";
+ is hex, "32", 'bigint hex override without arguments infers $_';
+ is oct, "16", 'bigint oct override without arguments infers $_';
+ @_ = 1..20;
+ is hex(@_), "32", 'bigint hex override provides scalar context';
+ is oct(@_), "16", 'bigint oct override provides scalar context';
+ is ref hex(1), 'Math::BigInt',
+ 'bigint hex() works when bignum and bigrat are loaded';
+ is ref oct(1), 'Math::BigInt',
+ 'bigint oct() works when bignum and bigrat are loaded';
+}
+{
+ use bignum;
+ $_ = "20";
+ is hex, "32", 'bignum hex override without arguments infers $_';
+ is oct, "16", 'bignum oct override without arguments infers $_';
+ @_ = 1..20;
+ is hex(@_), "32", 'bignum hex override provides scalar context';
+ is oct(@_), "16", 'bignum oct override provides scalar context';
+ is ref hex(1), 'Math::BigInt',
+ 'bignum hex() works when bigint and bigrat are loaded';
+ is ref oct(1), 'Math::BigInt',
+ 'bignum oct() works when bigint and bigrat are loaded';
+}
+{
+ use bigrat;
+ $_ = "20";
+ is hex, "32", 'bigrat hex override without arguments infers $_';
+ is oct, "16", 'bigrat oct override without arguments infers $_';
+ @_ = 1..20;
+ is hex(@_), "32", 'bigrat hex override provides scalar context';
+ is oct(@_), "16", 'bigrat oct override provides scalar context';
+ is ref hex(1), 'Math::BigInt',
+ 'bigrat hex() works when bignum and bigint are loaded';
+ is ref oct(1), 'Math::BigInt',
+ 'bigrat oct() works when bignum and bigint are loaded';
+}
+
+$hex_called = 0;
+() = hex 0;
+is $hex_called, 1, 'existing hex overrides are called';
+$oct_called = 0;
+() = oct 0;
+is $oct_called, 1, 'existing oct overrides are called';
+
+{
+ package _importer;
+ {
+ use bigint 'hex', 'oct';
+ ::is \&hex, \&bigint::hex, 'exported hex function';
+ ::is \&oct, \&bigint::oct, 'exported oct function';
+ }
+ ::ok ref hex(), 'exported hex function returns ref outside pragma scope';
+ ::ok ref oct(), 'exported oct function returns ref outside pragma scope';
+ ::is oct("20"), "16", 'exported oct function works with "decimal"';
+ # (used to return 20 because it thought it was decimal)
+}
+{
+ package _importer2;
+ use bignum 'hex', 'oct';
+ ::is \&hex, \&bignum::hex, 'bignum exports hex';
+ ::is \&oct, \&bignum::oct, 'bignum exports oct';
+ ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint';
+ ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint';
+}
+{
+ package _importer3;
+ use bigrat 'hex', 'oct';
+ ::is \&hex, \&bigrat::hex, 'bigrat exports hex';
+ ::is \&oct, \&bigrat::oct, 'bigrat exports oct';
+ ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint';
+ ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint';
+}
+is ref hex 0, "", 'hex export is not global';
+is ref oct 0, "", 'oct export is not global';
projects / platform / upstream / perl.git / commitdiff