diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2015-10-15 14:06:53 +0100 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2015-10-15 17:45:02 +0100 |
commit | c6824fe7faff95279179788b689804df2369aaa6 (patch) | |
tree | 3e457fa448fffbe0f56152edc99fa79a586641c9 /cpan | |
parent | c287fe329195a77c40b06a322c85083aa5bc220d (diff) | |
download | perl-c6824fe7faff95279179788b689804df2369aaa6.tar.gz |
Upgrade bignum from version 0.40 to 0.41
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/bignum/lib/Math/BigFloat/Trace.pm | 2 | ||||
-rw-r--r-- | cpan/bignum/lib/Math/BigInt/Trace.pm | 2 | ||||
-rw-r--r-- | cpan/bignum/lib/bigint.pm | 113 | ||||
-rw-r--r-- | cpan/bignum/lib/bignum.pm | 2 | ||||
-rw-r--r-- | cpan/bignum/lib/bigrat.pm | 2 | ||||
-rw-r--r-- | cpan/bignum/t/auth-bigint-hex.t | 49 | ||||
-rw-r--r-- | cpan/bignum/t/auth-bigint-oct.t | 49 |
7 files changed, 200 insertions, 19 deletions
diff --git a/cpan/bignum/lib/Math/BigFloat/Trace.pm b/cpan/bignum/lib/Math/BigFloat/Trace.pm index 6eee9fafff..a034615fc2 100644 --- a/cpan/bignum/lib/Math/BigFloat/Trace.pm +++ b/cpan/bignum/lib/Math/BigFloat/Trace.pm @@ -12,7 +12,7 @@ use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK @ISA = qw(Exporter Math::BigFloat); -$VERSION = '0.40'; +$VERSION = '0.41'; use overload; # inherit overload from BigFloat diff --git a/cpan/bignum/lib/Math/BigInt/Trace.pm b/cpan/bignum/lib/Math/BigInt/Trace.pm index 6cab46cc3a..b43f36ee34 100644 --- a/cpan/bignum/lib/Math/BigInt/Trace.pm +++ b/cpan/bignum/lib/Math/BigInt/Trace.pm @@ -12,7 +12,7 @@ use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK @ISA = qw(Exporter Math::BigInt); -$VERSION = '0.40'; +$VERSION = '0.41'; use overload; # inherit overload from BigInt diff --git a/cpan/bignum/lib/bigint.pm b/cpan/bignum/lib/bigint.pm index e6481bd54f..71009a43fe 100644 --- a/cpan/bignum/lib/bigint.pm +++ b/cpan/bignum/lib/bigint.pm @@ -1,7 +1,7 @@ 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 ); @@ -110,21 +110,109 @@ sub in_effect { 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); } . } @@ -139,19 +227,14 @@ sub _hex(_) { 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]); } . diff --git a/cpan/bignum/lib/bignum.pm b/cpan/bignum/lib/bignum.pm index 61f2bca545..9387ff06df 100644 --- a/cpan/bignum/lib/bignum.pm +++ b/cpan/bignum/lib/bignum.pm @@ -1,7 +1,7 @@ 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 ); diff --git a/cpan/bignum/lib/bigrat.pm b/cpan/bignum/lib/bigrat.pm index 61b6526ab4..11cb6cdc39 100644 --- a/cpan/bignum/lib/bigrat.pm +++ b/cpan/bignum/lib/bigrat.pm @@ -1,7 +1,7 @@ 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 ); diff --git a/cpan/bignum/t/auth-bigint-hex.t b/cpan/bignum/t/auth-bigint-hex.t new file mode 100644 index 0000000000..76a38dea77 --- /dev/null +++ b/cpan/bignum/t/auth-bigint-hex.t @@ -0,0 +1,49 @@ +#!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)|); + } +} diff --git a/cpan/bignum/t/auth-bigint-oct.t b/cpan/bignum/t/auth-bigint-oct.t new file mode 100644 index 0000000000..06ecffc07c --- /dev/null +++ b/cpan/bignum/t/auth-bigint-oct.t @@ -0,0 +1,49 @@ +#!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)|); + } +} |