Upgrade bignum from version 0.40 to 0.41

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)|);
+    }
+}