cpan/bignum/lib/bigrat.pm bigrat
cpan/bignum/lib/Math/BigFloat/Trace.pm bignum tracing
cpan/bignum/lib/Math/BigInt/Trace.pm bignum tracing
+cpan/bignum/t/auth-bigint-hex.t See if bignum works
+cpan/bignum/t/auth-bigint-oct.t See if bignum works
cpan/bignum/t/big_e_pi.t See if bignum exports e() and PI()
cpan/bignum/t/bigexp.t See if bignum works
cpan/bignum/t/bigint.t See if bigint works
},
'bignum' => {
- 'DISTRIBUTION' => 'PJACKLAM/bignum-0.40.tar.gz',
+ 'DISTRIBUTION' => 'PJACKLAM/bignum-0.41.tar.gz',
'FILES' => q[cpan/bignum],
'EXCLUDED' => [
qr{^inc/Module/},
@ISA = qw(Exporter Math::BigFloat);
-$VERSION = '0.40';
+$VERSION = '0.41';
use overload; # inherit overload from BigFloat
@ISA = qw(Exporter Math::BigInt);
-$VERSION = '0.40';
+$VERSION = '0.41';
use overload; # inherit overload from BigInt
package bigint;
use 5.006;
-$VERSION = '0.40';
+$VERSION = '0.41';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( PI e bpi bexp hex oct );
use constant LEXICAL => $] > 5.009004;
+# Internal function with the same semantics as CORE::hex(). This function is
+# not used directly, but rather by other front-end functions.
+
+sub _hex_core {
+ my $str = shift;
+
+ # Strip off, clean, and parse as much as we can from the beginning.
+
+ my $x;
+ if ($str =~ s/ ^ (0?[xX])? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) {
+ my $chrs = $2;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
+ $x = Math::BigInt -> from_hex($chrs);
+ } else {
+ $x = Math::BigInt -> bzero();
+ }
+
+ # Warn about trailing garbage.
+
+ if (CORE::length($str)) {
+ require Carp;
+ Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored",
+ substr($str, 0, 1)));
+ }
+
+ return $x;
+}
+
+# Internal function with the same semantics as CORE::oct(). This function is
+# not used directly, but rather by other front-end functions.
+
+sub _oct_core {
+ my $str = shift;
+
+ $str =~ s/^\s*//;
+
+ # Hexadecimal input.
+
+ return _hex_core($str) if $str =~ /^0?[xX]/;
+
+ my $x;
+
+ # Binary input.
+
+ if ($str =~ /^0?[bB]/) {
+
+ # Strip off, clean, and parse as much as we can from the beginning.
+
+ if ($str =~ s/ ^ (0?[bB])? ( [01]* ( _ [01]+ )* ) //x) {
+ my $chrs = $2;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
+ $x = Math::BigInt -> from_bin($chrs);
+ }
+
+ # Warn about trailing garbage.
+
+ if (CORE::length($str)) {
+ require Carp;
+ Carp::carp(sprintf("Illegal binary digit '%s' ignored",
+ substr($str, 0, 1)));
+ }
+
+ return $x;
+ }
+
+ # Octal input. Strip off, clean, and parse as much as we can from the
+ # beginning.
+
+ if ($str =~ s/ ^ ( [0-7]* ( _ [0-7]+ )* ) //x) {
+ my $chrs = $1;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
+ $x = Math::BigInt -> from_oct($chrs);
+ }
+
+ # Warn about trailing garbage. CORE::oct() only warns about 8 and 9.
+
+ if (CORE::length($str)) {
+ my $chr = substr($str, 0, 1);
+ if ($chr eq '8' || $chr eq '9') {
+ require Carp;
+ Carp::carp(sprintf("Illegal octal digit '%s' ignored", $chr));
+ }
+ }
+
+ return $x;
+}
+
{
my $proto = LEXICAL ? '_' : ';$';
eval '
sub hex(' . $proto . ') {' . <<'.';
- my $i = @_ ? $_[0] : $_;
- $i = '0x'.$i unless $i =~ /^0x/;
- Math::BigInt->new($i);
+ my $str = @_ ? $_[0] : $_;
+ _hex_core($str);
}
.
+
eval '
sub oct(' . $proto . ') {' . <<'.';
- my $i = @_ ? $_[0] : $_;
- # oct() should never fall back to decimal
- return Math::BigInt->from_oct($i) if $i =~ s/^(?=0[0-9]|[1-9])/0/;
- Math::BigInt->new($i);
+ my $str = @_ ? $_[0] : $_;
+ _oct_core($str);
}
.
}
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);
+ _hex_core($_[0]);
}
sub _oct(_) {
my $hh = (caller 0)[10];
return $prev_oct ? &$prev_oct($_[0]) : CORE::oct($_[0])
unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat};
- my $i = $_[0];
- # oct() should never fall back to decimal
- return Math::BigInt->from_oct($i) if $i =~ s/^(?=0[0-9]|[1-9])/0/;
- Math::BigInt->new($i);
+ _oct_core($_[0]);
}
.
package bignum;
use 5.006;
-$VERSION = '0.40';
+$VERSION = '0.41';
use Exporter;
@ISA = qw( bigint );
@EXPORT_OK = qw( PI e bexp bpi hex oct );
package bigrat;
use 5.006;
-$VERSION = '0.40';
+$VERSION = '0.41';
require Exporter;
@ISA = qw( bigint );
@EXPORT_OK = qw( PI e bpi bexp hex oct );
--- /dev/null
+#!perl
+
+BEGIN {
+ unless ($ENV{AUTHOR_TESTING}) {
+ require Test::More;
+ Test::More::plan(skip_all => 'these tests are for release candidate testing');
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 507068;
+
+use Algorithm::Combinatorics qw< variations >;
+
+use bigint;
+
+use Test::More;
+
+my $elements = ['0', 'b', 'x', '1', '1', '_', '_', '9', 'z'];
+
+for my $k (0 .. @$elements) {
+ my $seen = {};
+ for my $variation (variations($elements, $k)) {
+ my $str = join "", @$variation;
+ next if $seen -> {$str}++;
+ print qq|#\n# hex("$str")\n#\n|;
+
+ my $i;
+ my @warnings;
+ local $SIG{__WARN__} = sub {
+ my $warning = shift;
+ $warning =~ s/ at .*\z//s;
+ $warnings[$i] = $warning;
+ };
+
+ $i = 0;
+ my $want_val = CORE::hex("$str");
+ my $want_warn = $warnings[$i];
+
+ $i = 1;
+ my $got_val = bigint::hex("$str");
+ my $got_warn = $warnings[$i];
+
+ is($got_val, $want_val, qq|hex("$str") (output)|);
+ is($got_warn, $want_warn, qq|hex("$str") (warning)|);
+ }
+}
--- /dev/null
+#!perl
+
+BEGIN {
+ unless ($ENV{AUTHOR_TESTING}) {
+ require Test::More;
+ Test::More::plan(skip_all => 'these tests are for release candidate testing');
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 507068;
+
+use Algorithm::Combinatorics qw< variations >;
+
+use bigint;
+
+use Test::More;
+
+my $elements = ['0', 'b', 'x', '1', '1', '_', '_', '9', 'z'];
+
+for my $k (0 .. @$elements) {
+ my $seen = {};
+ for my $variation (variations($elements, $k)) {
+ my $str = join "", @$variation;
+ next if $seen -> {$str}++;
+ print qq|#\n# oct("$str")\n#\n|;
+
+ my $i;
+ my @warnings;
+ local $SIG{__WARN__} = sub {
+ my $warning = shift;
+ $warning =~ s/ at .*\z//s;
+ $warnings[$i] = $warning;
+ };
+
+ $i = 0;
+ my $want_val = CORE::oct("$str");
+ my $want_warn = $warnings[$i];
+
+ $i = 1;
+ my $got_val = bigint::oct("$str");
+ my $got_warn = $warnings[$i];
+
+ is($got_val, $want_val, qq|hex("$str") (output)|);
+ is($got_warn, $want_warn, qq|hex("$str") (warning)|);
+ }
+}
https://perl5.git.perl.org / perl5.git / commitdiff