This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Math::BigInt from version 1.999816 to 1.999817
authorSteve Hay <steve.m.hay@googlemail.com>
Wed, 16 Oct 2019 07:06:47 +0000 (08:06 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Wed, 16 Oct 2019 07:06:47 +0000 (08:06 +0100)
29 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/Math-BigInt/lib/Math/BigFloat.pm
cpan/Math-BigInt/lib/Math/BigInt.pm
cpan/Math-BigInt/lib/Math/BigInt/Calc.pm
cpan/Math-BigInt/lib/Math/BigInt/Lib.pm
cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm
cpan/Math-BigInt/t/Math/BigInt/Scalar.pm
cpan/Math-BigInt/t/backermann-mbi.t [new file with mode: 0644]
cpan/Math-BigInt/t/bare_mbf.t
cpan/Math-BigInt/t/bare_mbi.t
cpan/Math-BigInt/t/bdigitsum-mbi.t [new file with mode: 0644]
cpan/Math-BigInt/t/bigfltpm.inc
cpan/Math-BigInt/t/bigfltpm.t
cpan/Math-BigInt/t/bigintc.t
cpan/Math-BigInt/t/bigintpm.inc
cpan/Math-BigInt/t/bigintpm.t
cpan/Math-BigInt/t/buparrow-mbi.t [new file with mode: 0644]
cpan/Math-BigInt/t/calling-class-methods.t
cpan/Math-BigInt/t/calling-instance-methods.t
cpan/Math-BigInt/t/calling.t
cpan/Math-BigInt/t/from_ieee754-mbf.t [new file with mode: 0644]
cpan/Math-BigInt/t/new-mbf.t
cpan/Math-BigInt/t/sub_mbf.t
cpan/Math-BigInt/t/sub_mbi.t
cpan/Math-BigInt/t/to_ieee754-mbf.t [new file with mode: 0644]
cpan/Math-BigInt/t/upgrade.inc
cpan/Math-BigInt/t/upgrade.t
cpan/Math-BigInt/t/with_sub.t

index 0c06d8a..29b6e7c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1294,9 +1294,11 @@ cpan/Math-BigInt/lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigIn
 cpan/Math-BigInt/lib/Math/BigInt/Lib.pm
 cpan/Math-BigInt/t/_e_math.t           Helper routine in BigFloat for _e math
 cpan/Math-BigInt/t/alias.inc           Support for BigInt tests
+cpan/Math-BigInt/t/backermann-mbi.t    Test Math::BigInt
 cpan/Math-BigInt/t/bare_mbf.t          Test MBF under Math::BigInt::BareCalc
 cpan/Math-BigInt/t/bare_mbi.t          Test MBI under Math::BigInt::BareCalc
 cpan/Math-BigInt/t/bare_mif.t          Rounding tests under BareCalc
+cpan/Math-BigInt/t/bdigitsum-mbi.t     Test Math::BigInt
 cpan/Math-BigInt/t/bdstr-mbf.t         Test Math::BigInt
 cpan/Math-BigInt/t/bdstr-mbi.t         Test Math::BigInt
 cpan/Math-BigInt/t/bestr-mbf.t         Test Math::BigInt
@@ -1318,6 +1320,7 @@ cpan/Math-BigInt/t/bnstr-mbf.t            Test Math::BigInt
 cpan/Math-BigInt/t/bnstr-mbi.t         Test Math::BigInt
 cpan/Math-BigInt/t/bsstr-mbf.t         Test Math::BigInt
 cpan/Math-BigInt/t/bsstr-mbi.t         Test Math::BigInt
+cpan/Math-BigInt/t/buparrow-mbi.t      Test Math::BigInt
 cpan/Math-BigInt/t/calling.t           Test calling conventions
 cpan/Math-BigInt/t/calling-class-methods.t     Test Math::BigInt
 cpan/Math-BigInt/t/calling-instance-methods.t  Test Math::BigInt
@@ -1334,6 +1337,7 @@ cpan/Math-BigInt/t/from_bin-mbf.t Test Math::BigInt
 cpan/Math-BigInt/t/from_bin-mbi.t
 cpan/Math-BigInt/t/from_hex-mbf.t      Test Math::BigInt
 cpan/Math-BigInt/t/from_hex-mbi.t
+cpan/Math-BigInt/t/from_ieee754-mbf.t  Test Math::BigInt
 cpan/Math-BigInt/t/from_oct-mbf.t      Test Math::BigInt
 cpan/Math-BigInt/t/from_oct-mbi.t
 cpan/Math-BigInt/t/inf_nan.t           Special tests for inf and *NaN* handling
@@ -1373,6 +1377,7 @@ cpan/Math-BigInt/t/sub_mbf.t              Empty subclass test of BigFloat
 cpan/Math-BigInt/t/sub_mbi.t           Empty subclass test of BigInt
 cpan/Math-BigInt/t/sub_mif.t           Test A & P with subclasses using mbimbf.inc
 cpan/Math-BigInt/t/to_base-mbi.t
+cpan/Math-BigInt/t/to_ieee754-mbf.t    Test Math::BigInt
 cpan/Math-BigInt/t/trap.t              Test whether trap_nan and trap_inf work
 cpan/Math-BigInt/t/upgrade.inc         Actual tests for upgrade.t
 cpan/Math-BigInt/t/upgrade.t           Test if use Math::BigInt(); under upgrade works
index 9ab84aa..a595577 100755 (executable)
@@ -714,7 +714,7 @@ use File::Glob qw(:case);
     },
 
     'Math::BigInt' => {
-        'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999816.tar.gz',
+        'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999817.tar.gz',
         'FILES'        => q[cpan/Math-BigInt],
         'EXCLUDED'     => [
             qr{^examples/},
index 8a92b58..1b7b2f2 100644 (file)
@@ -19,8 +19,9 @@ use warnings;
 use Carp qw< carp croak >;
 use Math::BigInt ();
 
-our $VERSION = '1.999816';
+our $VERSION = '1.999817';
 
+require Exporter;
 our @ISA        = qw/Math::BigInt/;
 our @EXPORT_OK  = qw/bpi/;
 
@@ -28,8 +29,6 @@ our @EXPORT_OK  = qw/bpi/;
 our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
      $upgrade, $downgrade, $_trap_nan, $_trap_inf);
 
-my $class = "Math::BigFloat";
-
 use overload
 
   # overload key: with_assign
@@ -273,7 +272,7 @@ sub AUTOLOAD {
     my $name = $AUTOLOAD;
 
     $name =~ s/(.*):://;        # split package
-    my $c = $1 || $class;
+    my $c = $1 || __PACKAGE__;
     no strict 'refs';
     $c->import() if $IMPORT == 0;
     if (!_method_alias($name)) {
@@ -418,7 +417,8 @@ sub new {
         return $self;
     }
 
-    # Handle hexadecimal numbers.
+    # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
+    # have a "0x" or "0X" prefix.
 
     if ($wanted =~ /^\s*[+-]?0[Xx]/) {
         $self = $class -> from_hex($wanted);
@@ -426,7 +426,42 @@ sub new {
         return $self;
     }
 
-    # Handle binary numbers.
+    # Handle octal numbers. We auto-detect octal numbers if they have a "0"
+    # prefix and a binary exponent.
+
+    if ($wanted =~ /
+                       ^
+                       \s*
+
+                       # sign
+                       [+-]?
+
+                       # prefix
+                       0
+
+                       # significand using the octal digits 0..7
+                       [0-7]+ (?: _ [0-7]+ )*
+                       (?:
+                           \.
+                           (?: [0-7]+ (?: _ [0-7]+ )* )?
+                       )?
+
+                       # exponent (power of 2) using decimal digits
+                       [Pp]
+                       [+-]?
+                       \d+ (?: _ \d+ )*
+
+                       \s*
+                       $
+                 /x)
+    {
+        $self = $class -> from_oct($wanted);
+        $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
+        return $self;
+    }
+
+    # Handle binary numbers. We auto-detect binary numbers if they have a "0b"
+    # or "0B" prefix.
 
     if ($wanted =~ /^\s*[+-]?0[Bb]/) {
         $self = $class -> from_bin($wanted);
@@ -781,6 +816,165 @@ sub from_bin {
     return $self->bnan();
 }
 
+sub from_ieee754 {
+    my $self    = shift;
+    my $selfref = ref $self;
+    my $class   = $selfref || $self;
+
+    # Don't modify constant (read-only) objects.
+
+    return if $selfref && $self->modify('from_ieee754');
+
+    my $in     = shift;     # input string (or raw bytes)
+    my $format = shift;     # format ("binary32", "decimal64" etc.)
+    my $enc;                # significand encoding (applies only to decimal)
+    my $k;                  # storage width in bits
+    my $b;                  # base
+
+    if ($format =~ /^binary(\d+)\z/) {
+        $k = $1;
+        $b = 2;
+    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+        $k = $1;
+        $b = 10;
+        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
+    } elsif ($format eq 'half') {
+        $k = 16;
+        $b = 2;
+    } elsif ($format eq 'single') {
+        $k = 32;
+        $b = 2;
+    } elsif ($format eq 'double') {
+        $k = 64;
+        $b = 2;
+    } elsif ($format eq 'quadruple') {
+        $k = 128;
+        $b = 2;
+    } elsif ($format eq 'octuple') {
+        $k = 256;
+        $b = 2;
+    } elsif ($format eq 'sexdecuple') {
+        $k = 512;
+        $b = 2;
+    }
+
+    if ($b == 2) {
+
+        # Get the parameters for this format.
+
+        my $p;                      # precision (in bits)
+        my $t;                      # number of bits in significand
+        my $w;                      # number of bits in exponent
+
+        if ($k == 16) {             # binary16 (half-precision)
+            $p = 11;
+            $t = 10;
+            $w =  5;
+        } elsif ($k == 32) {        # binary32 (single-precision)
+            $p = 24;
+            $t = 23;
+            $w =  8;
+        } elsif ($k == 64) {        # binary64 (double-precision)
+            $p = 53;
+            $t = 52;
+            $w = 11;
+        } else {                    # binaryN (quadruple-precision and above)
+            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+                croak "Number of bits must be 16, 32, 64, or >= 128 and",
+                  " a multiple of 32";
+            }
+            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+            $t = $p - 1;
+            $w = $k - $t - 1;
+        }
+
+        # The maximum exponent, minimum exponent, and exponent bias.
+
+        my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec();
+        my $emin = 1 - $emax;
+        my $bias = $emax;
+
+        # Undefined input.
+
+        unless (defined $in) {
+            carp("Input is undefined");
+            return $self -> bzero();
+        }
+
+        # Make sure input string is a string of zeros and ones.
+
+        my $len = CORE::length $in;
+        if (8 * $len == $k) {                   # bytes
+            $in = unpack "B*", $in;
+        } elsif (4 * $len == $k) {              # hexadecimal
+            if ($in =~ /([^\da-f])/i) {
+                croak "Illegal hexadecimal digit '$1'";
+            }
+            $in = unpack "B*", pack "H*", $in;
+        } elsif ($len == $k) {                  # bits
+            if ($in =~ /([^01])/) {
+                croak "Illegal binary digit '$1'";
+            }
+        } else {
+            croak "Unknown input -- $in";
+        }
+
+        # Split bit string into sign, exponent, and mantissa/significand.
+
+        my $sign = substr($in, 0, 1) eq '1' ? '-' : '+';
+        my $expo = $class -> from_bin(substr($in, 1, $w));
+        my $mant = $class -> from_bin(substr($in, $w + 1));
+
+        my $x;
+
+        $expo -> bsub($bias);                   # subtract bias
+
+        if ($expo < $emin) {                    # zero and subnormals
+            if ($mant == 0) {                   # zero
+                $x = $class -> bzero();
+            } else {                            # subnormals
+                # compute (1/$b)**(N) rather than ($b)**(-N)
+                $x = $class -> new("0.5");      # 1/$b
+                $x -> bpow($bias + $t - 1) -> bmul($mant);
+                $x -> bneg() if $sign eq '-';
+            }
+        }
+
+        elsif ($expo > $emax) {                 # inf and nan
+            if ($mant == 0) {                   # inf
+                $x = $class -> binf($sign);
+            } else {                            # nan
+                $x = $class -> bnan();
+            }
+        }
+
+        else {                                  # normals
+            $mant = $class -> new(2) -> bpow($t) -> badd($mant);
+            if ($expo < $t) {
+                # compute (1/$b)**(N) rather than ($b)**(-N)
+                $x = $class -> new("0.5");      # 1/$b
+                $x -> bpow($t - $expo) -> bmul($mant);
+            } else {
+                $x = $class -> new(2);
+                $x -> bpow($expo - $t) -> bmul($mant);
+            }
+            $x -> bneg() if $sign eq '-';
+        }
+
+        if ($selfref) {
+            $self -> {sign} = $x -> {sign};
+            $self -> {_m}   = $x -> {_m};
+            $self -> {_es}  = $x -> {_es};
+            $self -> {_e}   = $x -> {_e};
+        } else {
+            $self = $x;
+        }
+        return $self;
+    }
+
+    croak("The format '$format' is not yet supported.");
+}
+
 sub bzero {
     # create/assign '+0'
 
@@ -3023,7 +3217,7 @@ sub bsqrt {
 
     return $x if $x->modify('bsqrt');
 
-    return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
+    return $x->bnan() if $x->{sign} !~ /^\+/;  # NaN, -inf or < 0
     return $x if $x->{sign} eq '+inf';         # sqrt(inf) == inf
     return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one();
 
@@ -3783,7 +3977,7 @@ sub mantissa {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-        $s =~ s/^[+]//;
+        $s =~ s/^\+//;
         return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
     }
     my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
@@ -3798,7 +3992,7 @@ sub exponent {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-$s =~ s/^[+-]//;
+        $s =~ s/^[+-]//;
         return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
     }
     Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
@@ -3810,9 +4004,9 @@ sub parts {
 
     if ($x->{sign} !~ /^[+-]$/) {
         my $s = $x->{sign};
-$s =~ s/^[+]//;
-my $se = $s;
-$se =~ s/^[-]//;
+        $s =~ s/^\+//;
+        my $se = $s;
+        $se =~ s/^-//;
         return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
     }
     my $m = Math::BigInt->bzero();
@@ -3981,9 +4175,9 @@ sub bstr {
     }
 
     my $es = '0';
-my $len = 1;
-my $cad = 0;
-my $dot = '.';
+    my $len = 1;
+    my $cad = 0;
+    my $dot = '.';
 
     # $x is zero?
     my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
@@ -4007,8 +4201,8 @@ my $dot = '.';
         } elsif ($e > 0) {
             # expand with zeros
             $es .= '0' x $e;
-$len += $e;
-$cad = 0;
+            $len += $e;
+            $cad = 0;
         }
     }                           # if not zero
 
@@ -4160,6 +4354,178 @@ sub to_bin {
     return $x->{sign} eq '-' ? "-$str" : $str;
 }
 
+sub to_ieee754 {
+    my $x = shift;
+    my $format = shift;
+    my $class = ref $x;
+
+    my $enc;            # significand encoding (applies only to decimal)
+    my $k;              # storage width in bits
+    my $b;              # base
+
+    if ($format =~ /^binary(\d+)\z/) {
+        $k = $1;
+        $b = 2;
+    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+        $k = $1;
+        $b = 10;
+        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
+    } elsif ($format eq 'half') {
+        $k = 16;
+        $b = 2;
+    } elsif ($format eq 'single') {
+        $k = 32;
+        $b = 2;
+    } elsif ($format eq 'double') {
+        $k = 64;
+        $b = 2;
+    } elsif ($format eq 'quadruple') {
+        $k = 128;
+        $b = 2;
+    } elsif ($format eq 'octuple') {
+        $k = 256;
+        $b = 2;
+    } elsif ($format eq 'sexdecuple') {
+        $k = 512;
+        $b = 2;
+    }
+
+    if ($b == 2) {
+
+        # Get the parameters for this format.
+
+        my $p;                      # precision (in bits)
+        my $t;                      # number of bits in significand
+        my $w;                      # number of bits in exponent
+
+        if ($k == 16) {             # binary16 (half-precision)
+            $p = 11;
+            $t = 10;
+            $w =  5;
+        } elsif ($k == 32) {        # binary32 (single-precision)
+            $p = 24;
+            $t = 23;
+            $w =  8;
+        } elsif ($k == 64) {        # binary64 (double-precision)
+            $p = 53;
+            $t = 52;
+            $w = 11;
+        } else {                    # binaryN (quadruple-precition and above)
+            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+                croak "Number of bits must be 16, 32, 64, or >= 128 and",
+                  " a multiple of 32";
+            }
+            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+            $t = $p - 1;
+            $w = $k - $t - 1;
+        }
+
+        # The maximum exponent, minimum exponent, and exponent bias.
+
+        my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
+        my $emin = 1 - $emax;
+        my $bias = $emax;
+
+        # Get numerical sign, exponent, and mantissa/significand for bit
+        # string.
+
+        my $sign = 0;
+        my $expo;
+        my $mant;
+
+        if ($x -> is_nan()) {                   # nan
+            $sign = 1;
+            $expo = $emax -> copy() -> binc();
+            $mant = $class -> new(2) -> bpow($t - 1);
+        } elsif ($x -> is_inf()) {              # inf
+            $sign = 1 if $x -> is_neg();
+            $expo = $emax -> copy() -> binc();
+            $mant = $class -> bzero();
+        } elsif ($x -> is_zero()) {             # zero
+            $expo = $emin -> copy() -> bdec();
+            $mant = $class -> bzero();
+        } else {                                # normal and subnormal
+
+            $sign = 1 if $x -> is_neg();
+
+            # Get the mantissa and exponent in base $b.
+
+            my $binv = $class -> new("0.5");
+            my $b    = $class -> new(2);
+            my $one  = $class -> bone();
+
+            $expo = $class -> bzero();
+            $mant = $x -> copy() -> babs();
+
+            # We need to find the base 2 exponent. First make an estimate of
+            # the base 2 exponent, before adjusting it below. We could skip
+            # this estimation and go straight to the while-loops below, but the
+            # loops are slow, especially when the final exponent is far from
+            # zero and even more so if the number of digits is large. This
+            # initial estimation speeds up the computation dramatically.
+            #
+            #   log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
+            #                     = (log10($m) + $e) * log(10)/log(2)
+            #                     = (log($m)/log(10) + $e) * log(10)/log(2)
+
+            my ($m, $e) = $x -> nparts();
+            my $ms = $m -> numify();
+            my $es = $e -> numify();
+            $expo = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
+            $expo = int($expo);
+            if ($expo > $emax) {
+                $expo = $emax;
+            } elsif ($expo < $emin) {
+                $expo = $emin;
+            }
+            $expo = $class -> new($expo);
+            $mant -> bmul($binv -> copy() -> bpow($expo));
+
+            # Final adjustment.
+
+            while ($mant >= $b && $expo <= $emax) {
+                $mant -> bmul($binv);
+                $expo -> binc();
+            }
+
+            while ($mant < $one && $expo >= $emin) {
+                $mant -> bmul($b);
+                $expo -> bdec();
+            }
+
+            # Encode as infinity, normal number or subnormal number?
+
+            if ($expo > $emax) {                # overflow => infinity
+                $expo = $emax -> copy() -> binc();
+                $mant = $class -> bzero();
+            } elsif ($expo < $emin) {           # subnormal number
+                my $const = $class -> new(2) -> bpow($t - 1);
+                $mant -> bmul($const);
+                $mant -> bfround(0);
+            } else {                            # normal number
+                $mant -> bdec();                # remove implicit leading bit
+                my $const = $class -> new(2) -> bpow($t);
+                $mant -> bmul($const) -> bfround(0);
+            }
+        }
+
+        $expo -> badd($bias);                   # add bias
+
+        my $signbit = "$sign";
+
+        my $mantbits = $mant -> to_bin();
+        $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits;
+
+        my $expobits = $expo -> to_bin();
+        $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits;
+
+        my $bin = $signbit . $expobits . $mantbits;
+        return pack "B*", $bin;
+    }
+
+    croak("The format '$format' is not yet supported.");
+}
+
 sub as_hex {
     # return number as hexadecimal string (only for integers defined)
 
@@ -4242,7 +4608,7 @@ sub import {
     my $class = shift;
     my $l = scalar @_;
     my $lib = '';
-my @a;
+    my @a;
     my $lib_kind = 'try';
     $IMPORT=1;
     for (my $i = 0; $i < $l ; $i++) {
@@ -4314,7 +4680,7 @@ sub _len_to_steps {
 
     # D = 50 => N => 42, so L = 40 and R = 50
     my $l = 40;
-my $r = $d;
+    my $r = $d;
 
     # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
     $l = $l->numify if ref($l);
@@ -4370,7 +4736,6 @@ sub _log {
     $over->bmul($u);
     $factor = $class->new(3); $f = $class->new(2);
 
-    my $steps = 0;
     $limit = $class->new("1E-". ($scale-1));
 
     while (3 < 5) {
@@ -4717,7 +5082,6 @@ sub _pow {
     $over = $u->copy();
 
     $limit = $class->new("1E-". ($scale-1));
-    #my $steps = 0;
     while (3 < 5) {
         # we calculate the next term, and add it to the last
         # when the next term is below our limit, it won't affect the outcome
@@ -4731,8 +5095,6 @@ sub _pow {
         $factor->binc();
 
         last if $x->{sign} !~ /^[-+]$/;
-
-        #$steps++;
     }
 
     if ($do_invert) {
@@ -4795,6 +5157,7 @@ Math::BigFloat - Arbitrary size floating point math package
   $x = Math::BigFloat->from_oct('0377');        # ditto
   $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
   $x = Math::BigFloat->from_bin('0101');        # ditto
+  $x = Math::BigFloat->from_ieee754($b, "binary64");  # from IEEE-754 bytes
   $x = Math::BigFloat->bzero();                 # create a +0
   $x = Math::BigFloat->bone();                  # create a +1
   $x = Math::BigFloat->bone('-');               # create a -1
@@ -4926,6 +5289,7 @@ Math::BigFloat - Arbitrary size floating point math package
   $x->as_hex();       # as signed hexadecimal string with prefixed 0x
   $x->as_bin();       # as signed binary string with prefixed 0b
   $x->as_oct();       # as signed octal string with prefixed 0
+  $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008
 
   # Other conversion methods
 
@@ -5106,6 +5470,17 @@ using decimal digits.
 
 If called as an instance method, the value is assigned to the invocand.
 
+=item from_ieee754()
+
+Interpret the input as a value encoded as described in IEEE754-2008.  The input
+can be given as a byte string, hex string or binary string. The input is
+assumed to be in big-endian byte-order.
+
+        # both $dbl and $mbf are 3.141592...
+        $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18";
+        $dbl = unpack "d>", $bytes;
+        $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64");
+
 =item bpi()
 
     print Math::BigFloat->bpi(100), "\n";
@@ -5225,6 +5600,29 @@ C<ref($x)-E<gt>new()> can parse to create an object.
 
 In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
 
+=item to_ieee754()
+
+Encodes the invocand as a byte string in the given format as specified in IEEE
+754-2008. Note that the encoded value is the nearest possible representation of
+the value. This value might not be exactly the same as the value in the
+invocand.
+
+    # $x = 3.1415926535897932385
+    $x = Math::BigFloat -> bpi(30);
+
+    $b = $x -> to_ieee754("binary64");  # encode as 8 bytes
+    $h = unpack "H*", $b;               # "400921fb54442d18"
+
+    # 3.141592653589793115997963...
+    $y = Math::BigFloat -> from_ieee754($h, "binary64");
+
+All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases
+are recognized: "half" for "binary16", "single" for "binary32", "double" for
+"binary64", "quadruple" for "binary128", "octuple" for "binary256", and
+"sexdecuple" for "binary512".
+
+See also L<https://en.wikipedia.org/wiki/IEEE_754>.
+
 =back
 
 =head2 ACCURACY AND PRECISION
@@ -5552,11 +5950,11 @@ L<http://annocpan.org/dist/Math-BigInt>
 
 =item * CPAN Ratings
 
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
 
-=item * Search CPAN
+=item * MetaCPAN
 
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
 
 =item * CPAN Testers Matrix
 
index a443cd4..127f46b 100644 (file)
@@ -1,3 +1,5 @@
+# -*- coding: utf-8-unix -*-
+
 package Math::BigInt;
 
 #
@@ -20,14 +22,12 @@ use warnings;
 
 use Carp qw< carp croak >;
 
-our $VERSION = '1.999816';
+our $VERSION = '1.999817';
 
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT_OK = qw(objectify bgcd blcm);
 
-my $class = "Math::BigInt";
-
 # Inside overload, the first arg is always an object. If the original code had
 # it reversed (like $x = 2 * $y), then the third parameter is true.
 # In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
@@ -232,9 +232,7 @@ my $LIB = 'Math::BigInt::Calc';        # module to do the low level math
                                         # default is Calc.pm
 my $IMPORT = 0;                         # was import() called yet?
                                         # used to make require work
-my %WARN;                               # warn only once for low-level libs
 my %CALLBACKS;                          # callbacks to notify on lib loads
-my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
 
 ##############################################################################
 # the old code had $rnd_mode, so we need to support it, too
@@ -1135,7 +1133,7 @@ sub bpi {
     if (@_ == 1) {
         # called like Math::BigInt::bpi(10);
         $n = $self;
-        $self = $class;
+        $self = __PACKAGE__;
     }
     $self = ref($self) if ref($self);
 
@@ -1234,6 +1232,24 @@ sub is_negative {
     $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
 }
 
+sub is_non_negative {
+    # Return true if argument is non-negative (>= 0).
+    my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+    return 1 if $x->{sign} =~ /^\+/;
+    return 1 if $x -> is_zero();
+    return 0;
+}
+
+sub is_non_positive {
+    # Return true if argument is non-positive (<= 0).
+    my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+    return 1 if $x->{sign} =~ /^\-/;
+    return 1 if $x -> is_zero();
+    return 0;
+}
+
 sub is_odd {
     # return true when arg (BINT or num_str) is odd, false for even
     my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
@@ -2354,7 +2370,7 @@ sub bmodpow {
     $num->{value} = $value;
     $num->{sign}  = $sign;
 
-    return $num;
+    return $num -> round(@r);
 }
 
 sub bpow {
@@ -2401,21 +2417,14 @@ sub bpow {
 
     $r[3] = $y;                 # no push!
 
-    # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
-
-    my $new_sign = '+';
-    $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+    # 0 ** -y => ( 1 / (0 ** y)) => 1 / 0 => +inf
+    return $x->binf() if $y->is_negative() && $x->is_zero();
 
-    # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
-    return $x->binf()
-      if $y->{sign} eq '-' && $x->{sign} eq '+' && $LIB->_is_zero($x->{value});
     # 1 ** -y => 1 / (1 ** |y|)
-    # so do test for negative $y after above's clause
-    return $x->bnan() if $y->{sign} eq '-' && !$LIB->_is_one($x->{value});
+    return $x->bzero() if $y->is_negative() && !$LIB->_is_one($x->{value});
 
     $x->{value} = $LIB->_pow($x->{value}, $y->{value});
-    $x->{sign} = $new_sign;
-    $x->{sign} = '+' if $LIB->_is_zero($y->{value});
+    $x->{sign}  = $x->is_negative() && $y->is_odd() ? '-' : '+';
     $x->round(@r);
 }
 
@@ -2483,7 +2492,7 @@ sub blog {
         return $x;
     }
 
-    my ($rc, $exact) = $LIB->_log_int($x->{value}, $base->{value});
+    my ($rc) = $LIB->_log_int($x->{value}, $base->{value});
     return $x->bnan() unless defined $rc; # not possible to take log?
     $x->{value} = $rc;
     $x->round(@r);
@@ -2602,6 +2611,126 @@ sub bnok {
     $n->round(@r);
 }
 
+sub buparrow {
+    my $a = shift;
+    my $y = $a -> uparrow(@_);
+    $a -> {value} = $y -> {value};
+    return $a;
+}
+
+sub uparrow {
+    # Knuth's up-arrow notation buparrow(a, n, b)
+    #
+    # The following is a simple, recursive implementation of the up-arrow
+    # notation, just to show the idea. Such implementations cause "Deep
+    # recursion on subroutine ..." warnings, so we use a faster, non-recursive
+    # algorithm below with @_ as a stack.
+    #
+    #   sub buparrow {
+    #       my ($a, $n, $b) = @_;
+    #       return $a ** $b if $n == 1;
+    #       return $a * $b  if $n == 0;
+    #       return 1        if $b == 0;
+    #       return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));
+    #   }
+
+    my ($a, $b, $n) = @_;
+    my $class = ref $a;
+    croak("a must be non-negative") if $a < 0;
+    croak("n must be non-negative") if $n < 0;
+    croak("b must be non-negative") if $b < 0;
+
+    while (@_ >= 3) {
+
+        # return $a ** $b if $n == 1;
+
+        if ($_[-2] == 1) {
+            my ($a, $n, $b) = splice @_, -3;
+            push @_, $a ** $b;
+            next;
+        }
+
+        # return $a * $b if $n == 0;
+
+        if ($_[-2] == 0) {
+            my ($a, $n, $b) = splice @_, -3;
+            push @_, $a * $b;
+            next;
+        }
+
+        # return 1 if $b == 0;
+
+        if ($_[-1] == 0) {
+            splice @_, -3;
+            push @_, $class -> bone();
+            next;
+        }
+
+        # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));
+
+        my ($a, $n, $b) = splice @_, -3;
+        push @_, ($a, $n - 1,
+                      $a, $n, $b - 1);
+
+    }
+
+    pop @_;
+}
+
+sub backermann {
+    my $m = shift;
+    my $y = $m -> ackermann(@_);
+    $m -> {value} = $y -> {value};
+    return $m;
+}
+
+sub ackermann {
+    # Ackermann's function ackermann(m, n)
+    #
+    # The following is a simple, recursive implementation of the ackermann
+    # function, just to show the idea. Such implementations cause "Deep
+    # recursion on subroutine ..." warnings, so we use a faster, non-recursive
+    # algorithm below with @_ as a stack.
+    #
+    # sub ackermann {
+    #     my ($m, $n) = @_;
+    #     return $n + 1                                  if $m == 0;
+    #     return ackermann($m - 1, 1)                    if $m > 0 && $n == 0;
+    #     return ackermann($m - 1, ackermann($m, $n - 1) if $m > 0 && $n > 0;
+    # }
+
+    my ($m, $n) = @_;
+    my $class = ref $m;
+    croak("m must be non-negative") if $m < 0;
+    croak("n must be non-negative") if $n < 0;
+
+    my $two      = $class -> new("2");
+    my $three    = $class -> new("3");
+    my $thirteen = $class -> new("13");
+
+    $n = pop;
+    $n = $class -> new($n) unless ref($n);
+    while (@_) {
+        my $m = pop;
+        if ($m > $three) {
+            push @_, (--$m) x $n;
+            while (--$m >= $three) {
+                push @_, $m;
+            }
+            $n = $thirteen;
+        } elsif ($m == $three) {
+            $n = $class -> bone() -> blsft($n + $three) -> bsub($three);
+        } elsif ($m == $two) {
+            $n -> bmul($two) -> badd($three);
+        } elsif ($m >= 0) {
+            $n -> badd($m) -> binc();
+        } else {
+            die "negative m!";
+        }
+    }
+    $n;
+}
+
 sub bsin {
     # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
     # result truncated to an integer.
@@ -2654,9 +2783,9 @@ sub batan {
     return $upgrade->new($x)->batan(@r) if defined $upgrade;
 
     # calculate the result and truncate it to integer
-    my $t = Math::BigFloat->new($x)->batan(@r);
+    my $tmp = Math::BigFloat->new($x)->batan(@r);
 
-    $x->{value} = $LIB->_new($x->as_int()->bstr());
+    $x->{value} = $LIB->_new($tmp->as_int()->bstr());
     $x->round(@r);
 }
 
@@ -2902,12 +3031,19 @@ sub blsft {
     # (BINT or num_str, BINT or num_str) return BINT
     # compute x << y, base n, y >= 0
 
-    # set up parameters
-    my ($class, $x, $y, $b, @r) = (ref($_[0]), @_);
+    my ($class, $x, $y, $b, @r);
 
-    # objectify is costly, so avoid it
-    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
-        ($class, $x, $y, $b, @r) = objectify(2, @_);
+    # Objectify the base only when it is defined, since an undefined base, as
+    # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2.
+
+    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+        # E.g., Math::BigInt->blog(256, 5, 2)
+        ($class, $x, $y, $b, @r) =
+          defined $_[3] ? objectify(3, @_) : objectify(2, @_);
+    } else {
+        # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2)
+        ($class, $x, $y, $b, @r) =
+          defined $_[2] ? objectify(3, @_) : objectify(2, @_);
     }
 
     return $x if $x -> modify('blsft');
@@ -2915,7 +3051,15 @@ sub blsft {
                             $y -> {sign} !~ /^[+-]$/);
     return $x -> round(@r) if $y -> is_zero();
 
-    $b = 2 if !defined $b;
+    $b = defined($b) ? $b -> numify() : 2;
+
+    # While some of the libraries support an arbitrarily large base, not all of
+    # them do, so rather than returning an incorrect result in those cases,
+    # disallow bases that don't work with all libraries.
+
+    my $uintmax = ~0;
+    croak("Base is too large.") if $b > $uintmax;
+
     return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';
 
     $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b);
@@ -3146,7 +3290,7 @@ sub bround {
     # do not return $x->bnorm(), but $x
 
     my $x = shift;
-    $x = $class->new($x) unless ref $x;
+    $x = __PACKAGE__->new($x) unless ref $x;
     my ($scale, $mode) = $x->_scale_a(@_);
     return $x if !defined $scale || $x->modify('bround'); # no-op
 
@@ -3264,7 +3408,7 @@ sub fround {
     # Exists to make life easier for switch between MBF and MBI (should we
     # autoload fxxx() like MBF does for bxxx()?)
     my $x = shift;
-    $x = $class->new($x) unless ref $x;
+    $x = __PACKAGE__->new($x) unless ref $x;
     $x->bround(@_);
 }
 
@@ -3356,6 +3500,31 @@ sub digit {
     $LIB->_digit($x->{value}, $n || 0);
 }
 
+sub bdigitsum {
+    # like digitsum(), but assigns the result to the invocand
+    my $x = shift;
+
+    return $x           if $x -> is_nan();
+    return $x -> bnan() if $x -> is_inf();
+
+    $x -> {value} = $LIB -> _digitsum($x -> {value});
+    $x -> {sign}  = '+';
+    return $x;
+}
+
+sub digitsum {
+    # compute sum of decimal digits and return it
+    my $x = shift;
+    my $class = ref $x;
+
+    return $class -> bnan() if $x -> is_nan();
+    return $class -> bnan() if $x -> is_inf();
+
+    my $y = $class -> bzero();
+    $y -> {value} = $LIB -> _digitsum($x -> {value});
+    return $y;
+}
+
 sub length {
     my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
 
@@ -3652,7 +3821,7 @@ sub bdstr {
 sub to_hex {
     # return as hex string, with prefixed 0x
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3663,7 +3832,7 @@ sub to_hex {
 sub to_oct {
     # return as octal string, with prefixed 0
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3674,7 +3843,7 @@ sub to_oct {
 sub to_bin {
     # return as binary string, with prefixed 0b
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3685,7 +3854,7 @@ sub to_bin {
 sub to_bytes {
     # return a byte string
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     croak("to_bytes() requires a finite, non-negative integer")
         if $x -> is_neg() || ! $x -> is_int();
@@ -3699,13 +3868,13 @@ sub to_bytes {
 sub to_base {
     # return a base anything string
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     croak("the value to convert must be a finite, non-negative integer")
       if $x -> is_neg() || !$x -> is_int();
 
     my $base = shift;
-    $base = $class->new($base) unless ref($base);
+    $base = __PACKAGE__->new($base) unless ref($base);
 
     croak("the base must be a finite integer >= 2")
       if $base < 2 || ! $base -> is_int();
@@ -3729,7 +3898,7 @@ sub to_base {
 sub as_hex {
     # return as hex string, with prefixed 0x
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3740,7 +3909,7 @@ sub as_hex {
 sub as_oct {
     # return as octal string, with prefixed 0
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3751,7 +3920,7 @@ sub as_oct {
 sub as_bin {
     # return as binary string, with prefixed 0b
     my $x = shift;
-    $x = $class->new($x) if !ref($x);
+    $x = __PACKAGE__->new($x) if !ref($x);
 
     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
 
@@ -3768,7 +3937,7 @@ sub as_bin {
 sub numify {
     # Make a Perl scalar number from a Math::BigInt object.
     my $x = shift;
-    $x = $class->new($x) unless ref $x;
+    $x = __PACKAGE__->new($x) unless ref $x;
 
     if ($x -> is_nan()) {
         require Math::Complex;
@@ -3817,7 +3986,7 @@ sub objectify {
     # Check the context.
 
     unless (wantarray) {
-        croak("${class}::objectify() needs list context");
+        croak(__PACKAGE__ . "::objectify() needs list context");
     }
 
     # Get the number of arguments to objectify.
@@ -3935,10 +4104,9 @@ sub objectify {
 sub import {
     my $class = shift;
     $IMPORT++;                  # remember we did import()
-    my @a;
-    my $l = scalar @_;
+    my @a;                      # unrecognized arguments
     my $warn_or_die = 0;        # 0 - no warn, 1 - warn, 2 - die
-    for (my $i = 0; $i < $l ; $i++) {
+    for (my $i = 0; $i <= $#_ ; $i++) {
         if ($_[$i] eq ':constant') {
             # this causes overlord er load to step in
             overload::constant
@@ -3951,7 +4119,9 @@ sub import {
         } elsif ($_[$i] =~ /^(lib|try|only)\z/) {
             # this causes a different low lib to take care...
             $LIB = $_[$i+1] || '';
-            # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
+            # try  => 0 (no warn)
+            # lib  => 1 (warn on fallback)
+            # only => 2 (die on fallback)
             $warn_or_die = 1 if $_[$i] eq 'lib';
             $warn_or_die = 2 if $_[$i] eq 'only';
             $i++;
@@ -3968,77 +4138,34 @@ sub import {
     # try to load core math lib
     my @c = split /\s*,\s*/, $LIB;
     foreach (@c) {
-        $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+        tr/a-zA-Z0-9://cd;      # limit to sane characters
     }
     push @c, \'Calc'            # if all fail, try these
       if $warn_or_die < 2;      # but not for "only"
-    $LIB = '';                 # signal error
+    $LIB = '';                  # signal error
     foreach my $l (@c) {
         # fallback libraries are "marked" as \'string', extract string if nec.
         my $lib = $l;
         $lib = $$l if ref($l);
 
-        next if ($lib || '') eq '';
+        next unless defined($lib) && CORE::length($lib);
         $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
         $lib =~ s/\.pm$//;
-        if ($] < 5.006) {
-            # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
-            # used in the same script, or eval("") inside import().
-            my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
-            my $file = pop @parts;
-            $file .= '.pm';     # BigInt => BigInt.pm
-            require File::Spec;
-            $file = File::Spec->catfile (@parts, $file);
-            eval {
-                require "$file";
-                $lib->import(@c);
-            }
-        } else {
-            eval "use $lib qw/@c/;";
-        }
+        my @parts = split /::/, $lib;   # Math::BigInt => Math BigInt
+        $parts[-1] .= '.pm';            # BigInt => BigInt.pm
+        require File::Spec;
+        my $file = File::Spec->catfile(@parts);
+        eval { require $file; };
         if ($@ eq '') {
-            my $ok = 1;
-            # loaded it ok, see if the api_version() is high enough
-            if ($lib->can('api_version') && $lib->api_version() >= 1.0) {
-                $ok = 0;
-                # api_version matches, check if it really provides anything we need
-                for my $method (qw/
-                                      one two ten
-                                      str num
-                                      add mul div sub dec inc
-                                      acmp len digit is_one is_zero is_even is_odd
-                                      is_two is_ten
-                                      zeros new copy check
-                                      from_hex from_oct from_bin as_hex as_bin as_oct
-                                      rsft lsft xor and or
-                                      mod sqrt root fac pow modinv modpow log_int gcd
-                                  /) {
-                    if (!$lib->can("_$method")) {
-                        if (($WARN{$lib} || 0) < 2) {
-                            carp("$lib is missing method '_$method'");
-                            $WARN{$lib} = 1; # still warn about the lib
-                        }
-                        $ok++;
-                        last;
-                    }
-                }
-            }
-            if ($ok == 0) {
-                $LIB = $lib;
-                if ($warn_or_die > 0 && ref($l)) {
-                    my $msg = "Math::BigInt: couldn't load specified"
-                            . " math lib(s), fallback to $lib";
-                    carp($msg)  if $warn_or_die == 1;
-                    croak($msg) if $warn_or_die == 2;
-                }
-                last;           # found a usable one, break
-            } else {
-                if (($WARN{$lib} || 0) < 2) {
-                    my $ver = eval "\$$lib\::VERSION" || 'unknown';
-                    carp("Cannot load outdated $lib v$ver, please upgrade");
-                    $WARN{$lib} = 2; # never warn again
-                }
+            $lib->import();
+            $LIB = $lib;
+            if ($warn_or_die > 0 && ref($l)) {
+                my $msg = "Math::BigInt: couldn't load specified"
+                        . " math lib(s), fallback to $lib";
+                carp($msg)  if $warn_or_die == 1;
+                croak($msg) if $warn_or_die == 2;
             }
+            last;               # found a usable one, break
         }
     }
     if ($LIB eq '') {
@@ -4210,7 +4337,7 @@ sub _split {
 sub _trailing_zeros {
     # return the amount of trailing zeros in $x (as scalar)
     my $x = shift;
-    $x = $class->new($x) unless ref $x;
+    $x = __PACKAGE__->new($x) unless ref $x;
 
     return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
 
@@ -4423,6 +4550,8 @@ Math::BigInt - Arbitrary size integer/float math package
   $x->blog($base);        # logarithm of $x to base $base (e.g., base 2)
   $x->bexp();             # calculate e ** $x where e is Euler's number
   $x->bnok($y);           # x over y (binomial coefficient n over k)
+  $x->buparrow($n, $y);   # Knuth's up-arrow notation
+  $x->backermann($y);     # the Ackermann function
   $x->bsin();             # sine
   $x->bcos();             # cosine
   $x->batan();            # inverse tangent
@@ -4987,6 +5116,18 @@ neither positive nor negative.
 Returns true if the invocand is negative and false otherwise. A C<NaN> is
 neither positive nor negative.
 
+=item is_non_positive()
+
+    $x->is_non_positive();      # true if <= 0
+
+Returns true if the invocand is negative or zero.
+
+=item is_non_negative()
+
+    $x->is_non_negative();      # true if >= 0
+
+Returns true if the invocand is positive or zero.
+
 =item is_odd()
 
     $x->is_odd();               # true if odd, false for even
@@ -5292,6 +5433,38 @@ pseudo-code:
 The behaviour is identical to the behaviour of the Maple and Mathematica
 function for negative integers n, k.
 
+=item buparrow()
+
+=item uparrow()
+
+    $a -> buparrow($n, $b);         # modifies $a
+    $x = $a -> uparrow($n, $b);     # does not modify $a
+
+This method implements Knuth's up-arrow notation, where $n is a non-negative
+integer representing the number of up-arrows. $n = 0 gives multiplication, $n =
+1 gives exponentiation, $n = 2 gives tetration, $n = 3 gives hexation etc. The
+following illustrates the relation between the first values of $n.
+
+See L<https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation>.
+
+=item backermann()
+
+=item ackermann()
+
+    $m -> backermann($n);           # modifies $a
+    $x = $m -> ackermann($n);       # does not modify $a
+
+This method implements the Ackermann function:
+
+             / n + 1              if m = 0
+   A(m, n) = | A(m-1, 1)          if m > 0 and n = 0
+             \ A(m-1, A(m, n-1))  if m > 0 and n > 0
+
+Its value grows rapidly, even for small inputs. For example, A(4, 2) is an
+integer of 19729 decimal digits.
+
+See https://en.wikipedia.org/wiki/Ackermann_function
+
 =item bsin()
 
     my $x = Math::BigInt->new(1);
@@ -5590,6 +5763,18 @@ If you want $x to have a certain sign, use one of the following methods:
 
 If C<$n> is negative, returns the digit counting from left.
 
+=item digitsum()
+
+    $x->digitsum();
+
+Computes the sum of the base 10 digits and returns it.
+
+=item bdigitsum()
+
+    $x->bdigitsum();
+
+Computes the sum of the base 10 digits and assigns the result to the invocand.
+
 =item length()
 
     $x->length();
@@ -6696,11 +6881,11 @@ L<http://annocpan.org/dist/Math-BigInt>
 
 =item * CPAN Ratings
 
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
 
-=item * Search CPAN
+=item * MetaCPAN
 
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
 
 =item * CPAN Testers Matrix
 
index 2bb06a0..8634125 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 use Carp qw< carp croak >;
 use Math::BigInt::Lib;
 
-our $VERSION = '1.999816';
+our $VERSION = '1.999817';
 
 our @ISA = ('Math::BigInt::Lib');
 
@@ -35,9 +35,6 @@ our @ISA = ('Math::BigInt::Lib');
 ##############################################################################
 # global constants, flags and accessory
 
-# announce that we are compatible with MBI v1.83 and up
-sub api_version () { 2; }
-
 # constants for easier life
 my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL);
 my ($AND_BITS, $XOR_BITS, $OR_BITS);
@@ -50,9 +47,7 @@ sub _base_len {
 
     my ($class, $b, $int) = @_;
     if (defined $b) {
-        # avoid redefinitions
-        undef &_mul;
-        undef &_div;
+        no warnings "redefine";
 
         if ($] >= 5.008 && $int && $b > 7) {
             $BASE_LEN = $b;
@@ -403,13 +398,14 @@ sub _mul_use_mul {
     my ($c, $xv, $yv) = @_;
 
     if (@$yv == 1) {
-        # shortcut for two very short numbers (improved by Nathan Zook)
-        # works also if xv and yv are the same reference, and handles also $x == 0
+        # shortcut for two very short numbers (improved by Nathan Zook) works
+        # also if xv and yv are the same reference, and handles also $x == 0
         if (@$xv == 1) {
             if (($xv->[0] *= $yv->[0]) >= $BASE) {
-                $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE;
+                my $rem = $xv->[0] % $BASE;
+                $xv->[1] = ($xv->[0] - $rem) * $RBASE;
+                $xv->[0] = $rem;
             }
-            ;
             return $xv;
         }
         # $x * 0 => 0
@@ -417,56 +413,44 @@ sub _mul_use_mul {
             @$xv = (0);
             return $xv;
         }
+
         # multiply a large number a by a single element one, so speed up
         my $y = $yv->[0];
         my $car = 0;
+        my $rem;
         foreach my $i (@$xv) {
             $i = $i * $y + $car;
-            $car = int($i * $RBASE);
-            $i -= $car * $BASE;
+            $rem = $i % $BASE;
+            $car = ($i - $rem) * $RBASE;
+            $i = $rem;
         }
         push @$xv, $car if $car != 0;
         return $xv;
     }
+
     # shortcut for result $x == 0 => result = 0
     return $xv if @$xv == 1 && $xv->[0] == 0;
 
     # since multiplying $x with $x fails, make copy in this case
-    $yv = [ @$xv ] if $xv == $yv; # same references?
+    $yv = $c->_copy($xv) if $xv == $yv;         # same references?
 
     my @prod = ();
-    my ($prod, $car, $cty, $xi, $yi);
-
+    my ($prod, $rem, $car, $cty, $xi, $yi);
     for $xi (@$xv) {
         $car = 0;
         $cty = 0;
-
-        # slow variant
-        #    for $yi (@$yv)
-        #      {
-        #      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
-        #      $prod[$cty++] =
-        #       $prod - ($car = int($prod * RBASE)) * $BASE;  # see USE_MUL
-        #      }
-        #    $prod[$cty] += $car if $car; # need really to check for 0?
-        #    $xi = shift @prod;
-
-        # faster variant
         # looping through this if $xi == 0 is silly - so optimize it away!
-        $xi = (shift @prod || 0), next if $xi == 0;
+        $xi = (shift(@prod) || 0), next if $xi == 0;
         for $yi (@$yv) {
             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
-            ##     this is actually a tad slower
-            ##        $prod = $prod[$cty]; $prod += ($car + $xi * $yi);     # no ||0 here
-            $prod[$cty++] =
-              $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL
+            $rem = $prod % $BASE;
+            $car = int(($prod - $rem) * $RBASE);
+            $prod[$cty++] = $rem;
         }
-        $prod[$cty] += $car if $car; # need really to check for 0?
-        $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
+        $prod[$cty] += $car if $car;    # need really to check for 0?
+        $xi = shift(@prod) || 0;        # || 0 makes v5.005_3 happy
     }
     push @$xv, @prod;
-    # can't have leading zeros
-    #  __strip_zeros($xv);
     $xv;
 }
 
@@ -478,11 +462,11 @@ sub _mul_use_div_64 {
     my ($c, $xv, $yv) = @_;
 
     use integer;
+
     if (@$yv == 1) {
-        # shortcut for two small numbers, also handles $x == 0
+        # shortcut for two very short numbers (improved by Nathan Zook) works
+        # also if xv and yv are the same reference, and handles also $x == 0
         if (@$xv == 1) {
-            # shortcut for two very short numbers (improved by Nathan Zook)
-            # works also if xv and yv are the same reference, and handles also $x == 0
             if (($xv->[0] *= $yv->[0]) >= $BASE) {
                 $xv->[0] =
                   $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE;
@@ -494,6 +478,7 @@ sub _mul_use_div_64 {
             @$xv = (0);
             return $xv;
         }
+
         # multiply a large number a by a single element one, so speed up
         my $y = $yv->[0];
         my $car = 0;
@@ -505,11 +490,12 @@ sub _mul_use_div_64 {
         push @$xv, $car if $car != 0;
         return $xv;
     }
+
     # shortcut for result $x == 0 => result = 0
-    return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
+    return $xv if @$xv == 1 && $xv->[0] == 0;
 
     # since multiplying $x with $x fails, make copy in this case
-    $yv = $c->_copy($xv) if $xv == $yv; # same references?
+    $yv = $c->_copy($xv) if $xv == $yv;         # same references?
 
     my @prod = ();
     my ($prod, $car, $cty, $xi, $yi);
@@ -517,13 +503,13 @@ sub _mul_use_div_64 {
         $car = 0;
         $cty = 0;
         # looping through this if $xi == 0 is silly - so optimize it away!
-        $xi = (shift @prod || 0), next if $xi == 0;
+        $xi = (shift(@prod) || 0), next if $xi == 0;
         for $yi (@$yv) {
             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
             $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE;
         }
-        $prod[$cty] += $car if $car; # need really to check for 0?
-        $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
+        $prod[$cty] += $car if $car;    # need really to check for 0?
+        $xi = shift(@prod) || 0;        # || 0 makes v5.005_3 happy
     }
     push @$xv, @prod;
     $xv;
@@ -536,15 +522,14 @@ sub _mul_use_div {
     my ($c, $xv, $yv) = @_;
 
     if (@$yv == 1) {
-        # shortcut for two small numbers, also handles $x == 0
+        # shortcut for two very short numbers (improved by Nathan Zook) works
+        # also if xv and yv are the same reference, and handles also $x == 0
         if (@$xv == 1) {
-            # shortcut for two very short numbers (improved by Nathan Zook)
-            # works also if xv and yv are the same reference, and handles also $x == 0
             if (($xv->[0] *= $yv->[0]) >= $BASE) {
-                $xv->[0] =
-                  $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE;
+                my $rem = $xv->[0] % $BASE;
+                $xv->[1] = ($xv->[0] - $rem) / $BASE;
+                $xv->[0] = $rem;
             }
-            ;
             return $xv;
         }
         # $x * 0 => 0
@@ -552,42 +537,44 @@ sub _mul_use_div {
             @$xv = (0);
             return $xv;
         }
+
         # multiply a large number a by a single element one, so speed up
         my $y = $yv->[0];
         my $car = 0;
+        my $rem;
         foreach my $i (@$xv) {
             $i = $i * $y + $car;
-            $car = int($i / $BASE);
-            $i -= $car * $BASE;
-            # This (together with use integer;) does not work on 32-bit Perls
-            #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE;
+            $rem = $i % $BASE;
+            $car = ($i - $rem) / $BASE;
+            $i = $rem;
         }
         push @$xv, $car if $car != 0;
         return $xv;
     }
+
     # shortcut for result $x == 0 => result = 0
-    return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
+    return $xv if @$xv == 1 && $xv->[0] == 0;
 
     # since multiplying $x with $x fails, make copy in this case
-    $yv = $c->_copy($xv) if $xv == $yv; # same references?
+    $yv = $c->_copy($xv) if $xv == $yv;         # same references?
 
     my @prod = ();
-    my ($prod, $car, $cty, $xi, $yi);
+    my ($prod, $rem, $car, $cty, $xi, $yi);
     for $xi (@$xv) {
         $car = 0;
         $cty = 0;
         # looping through this if $xi == 0 is silly - so optimize it away!
-        $xi = (shift @prod || 0), next if $xi == 0;
+        $xi = (shift(@prod) || 0), next if $xi == 0;
         for $yi (@$yv) {
             $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
-            $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE;
+            $rem = $prod % $BASE;
+            $car = ($prod - $rem) / $BASE;
+            $prod[$cty++] = $rem;
         }
-        $prod[$cty] += $car if $car; # need really to check for 0?
-        $xi = shift @prod || 0;      # || 0 makes v5.005_3 happy
+        $prod[$cty] += $car if $car;    # need really to check for 0?
+        $xi = shift(@prod) || 0;        # || 0 makes v5.005_3 happy
     }
     push @$xv, @prod;
-    # can't have leading zeros
-    #  __strip_zeros($xv);
     $xv;
 }
 
@@ -595,28 +582,19 @@ sub _div_use_mul {
     # ref to array, ref to array, modify first array and return remainder if
     # in list context
 
-    # see comments in _div_use_div() for more explanations
-
     my ($c, $x, $yorg) = @_;
 
     # the general div algorithm here is about O(N*N) and thus quite slow, so
     # we first check for some special cases and use shortcuts to handle them.
 
-    # This works, because we store the numbers in a chunked format where each
-    # element contains 5..7 digits (depending on system).
-
     # if both numbers have only one element:
     if (@$x == 1 && @$yorg == 1) {
         # shortcut, $yorg and $x are two small numbers
-        if (wantarray) {
-            my $rem = [ $x->[0] % $yorg->[0] ];
-            bless $rem, $c;
-            $x->[0] = int($x->[0] / $yorg->[0]);
-            return ($x, $rem);
-        } else {
-            $x->[0] = int($x->[0] / $yorg->[0]);
-            return $x;
-        }
+        my $rem = [ $x->[0] % $yorg->[0] ];
+        bless $rem, $c;
+        $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0];
+        return ($x, $rem) if wantarray;
+        return $x;
     }
 
     # if x has more than one, but y has only one element:
@@ -631,120 +609,120 @@ sub _div_use_mul {
         my $b;
         while ($j-- > 0) {
             $b = $r * $BASE + $x->[$j];
-            $x->[$j] = int($b/$y);
             $r = $b % $y;
+            $x->[$j] = ($b - $r) / $y;
         }
-        pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+        pop(@$x) if @$x > 1 && $x->[-1] == 0;   # remove any trailing zero
         return ($x, $rem) if wantarray;
         return $x;
     }
 
     # now x and y have more than one element
 
-    # check whether y has more elements than x, if yet, the result will be 0
+    # check whether y has more elements than x, if so, the result is 0
     if (@$yorg > @$x) {
         my $rem;
-        $rem = $c->_copy($x) if wantarray;    # make copy
-        @$x = 0;                        # set to 0
-        return ($x, $rem) if wantarray; # including remainder?
-        return $x;                      # only x, which is [0] now
+        $rem = $c->_copy($x) if wantarray;      # make copy
+        @$x = 0;                                # set to 0
+        return ($x, $rem) if wantarray;         # including remainder?
+        return $x;                              # only x, which is [0] now
     }
+
     # check whether the numbers have the same number of elements, in that case
     # the result will fit into one element and can be computed efficiently
     if (@$yorg == @$x) {
+        my $cmp = 0;
+        for (my $j = $#$x ; $j >= 0 ; --$j) {
+            last if $cmp = $x->[$j] - $yorg->[$j];
+        }
 
-        # if $yorg has more digits than $x (it's leading element is longer than
-        # the one from $x), the result will also be 0:
-        if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
-            my $rem = $c->_copy($x) if wantarray;        # make copy
-            @$x = 0;                            # set to 0
-            return ($x, $rem) if wantarray;     # including remainder?
+        if ($cmp == 0) {        # x = y
+            @$x = 1;
+            return $x, $c->_zero() if wantarray;
             return $x;
         }
-        # now calculate $x / $yorg
-        if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
-            # same length, so make full compare
 
-            my $a = 0;
-            my $j = @$x - 1;
-            # manual way (abort if unequal, good for early ne)
-            while ($j >= 0) {
-                last if ($a = $x->[$j] - $yorg->[$j]);
-                $j--;
-            }
-            # $a contains the result of the compare between X and Y
-            # a < 0: x < y, a == 0: x == y, a > 0: x > y
-            if ($a <= 0) {
-                # a = 0 => x == y => rem 0
-                # a < 0 => x < y => rem = x
-                my $rem = $a == 0 ? $c->_zero() : $c->_copy($x);
-                @$x = 0;             # if $a < 0
-                $x->[0] = 1 if $a == 0;  # $x == $y
-                return ($x, $rem) if wantarray;
-                return $x;
+        if ($cmp < 0) {         # x < y
+            if (wantarray) {
+                my $rem = $c->_copy($x);
+                @$x = 0;
+                return $x, $rem;
             }
-            # $x >= $y, so proceed normally
+            @$x = 0;
+            return $x;
         }
     }
 
     # all other cases:
 
-    my $y = $c->_copy($yorg);         # always make copy to preserve
+    my $y = $c->_copy($yorg);           # always make copy to preserve
 
-    my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
-
-    $car = $bar = $prd = 0;
-    if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
-        for $xi (@$x) {
+    my $tmp = $y->[-1] + 1;
+    my $rem = $BASE % $tmp;
+    my $dd  = ($BASE - $rem) / $tmp;
+    if ($dd != 1) {
+        my $car = 0;
+        for my $xi (@$x) {
             $xi = $xi * $dd + $car;
-            $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL
+            $xi -= ($car = int($xi * $RBASE)) * $BASE;          # see USE_MUL
         }
         push(@$x, $car);
         $car = 0;
-        for $yi (@$y) {
+        for my $yi (@$y) {
             $yi = $yi * $dd + $car;
-            $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL
+            $yi -= ($car = int($yi * $RBASE)) * $BASE;          # see USE_MUL
         }
     } else {
         push(@$x, 0);
     }
-    @q = ();
-    ($v2, $v1) = @$y[-2, -1];
+
+    # @q will accumulate the final result, $q contains the current computed
+    # part of the final result
+
+    my @q = ();
+    my ($v2, $v1) = @$y[-2, -1];
     $v2 = 0 unless $v2;
     while ($#$x > $#$y) {
-        ($u2, $u1, $u0) = @$x[-3 .. -1];
+        my ($u2, $u1, $u0) = @$x[-3 .. -1];
         $u2 = 0 unless $u2;
         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
         # if $v1 == 0;
-        $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
-        --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
+        my $tmp = $u0 * $BASE + $u1;
+        my $rem = $tmp % $v1;
+        my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
+        --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
         if ($q) {
-            ($car, $bar) = (0, 0);
-            for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
+            my $prd;
+            my ($car, $bar) = (0, 0);
+            for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                 $prd = $q * $y->[$yi] + $car;
-                $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL
-                $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+                $prd -= ($car = int($prd * $RBASE)) * $BASE;    # see USE_MUL
+                $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
             }
             if ($x->[-1] < $car + $bar) {
                 $car = 0;
                 --$q;
-                for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
+                for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                     $x->[$xi] -= $BASE
-                      if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+                      if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
                 }
             }
         }
         pop(@$x);
         unshift(@q, $q);
     }
+
     if (wantarray) {
         my $d = bless [], $c;
         if ($dd != 1) {
-            $car = 0;
-            for $xi (reverse @$x) {
+            my $car = 0;
+            my ($prd, $rem);
+            for my $xi (reverse @$x) {
                 $prd = $car * $BASE + $xi;
-                $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL
-                unshift(@$d, $tmp);
+                $rem = $prd % $dd;
+                $tmp = ($prd - $rem) / $dd;
+                $car = $rem;
+                unshift @$d, $tmp;
             }
         } else {
             @$d = @$x;
@@ -762,29 +740,29 @@ sub _div_use_mul {
 sub _div_use_div_64 {
     # ref to array, ref to array, modify first array and return remainder if
     # in list context
-    # This version works on 64 bit integers
-    my ($c, $x, $yorg) = @_;
 
+    # This version works on integers
     use integer;
+
+    my ($c, $x, $yorg) = @_;
+
     # the general div algorithm here is about O(N*N) and thus quite slow, so
     # we first check for some special cases and use shortcuts to handle them.
 
-    # This works, because we store the numbers in a chunked format where each
-    # element contains 5..7 digits (depending on system).
-
     # if both numbers have only one element:
     if (@$x == 1 && @$yorg == 1) {
         # shortcut, $yorg and $x are two small numbers
         if (wantarray) {
             my $rem = [ $x->[0] % $yorg->[0] ];
             bless $rem, $c;
-            $x->[0] = int($x->[0] / $yorg->[0]);
+            $x->[0] = $x->[0] / $yorg->[0];
             return ($x, $rem);
         } else {
-            $x->[0] = int($x->[0] / $yorg->[0]);
+            $x->[0] = $x->[0] / $yorg->[0];
             return $x;
         }
     }
+
     # if x has more than one, but y has only one element:
     if (@$yorg == 1) {
         my $rem;
@@ -797,78 +775,67 @@ sub _div_use_div_64 {
         my $b;
         while ($j-- > 0) {
             $b = $r * $BASE + $x->[$j];
-            $x->[$j] = int($b/$y);
             $r = $b % $y;
+            $x->[$j] = $b / $y;
         }
-        pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+        pop(@$x) if @$x > 1 && $x->[-1] == 0;   # remove any trailing zero
         return ($x, $rem) if wantarray;
         return $x;
     }
+
     # now x and y have more than one element
 
-    # check whether y has more elements than x, if yet, the result will be 0
+    # check whether y has more elements than x, if so, the result is 0
     if (@$yorg > @$x) {
         my $rem;
-        $rem = $c->_copy($x) if wantarray;    # make copy
-        @$x = 0;                        # set to 0
-        return ($x, $rem) if wantarray; # including remainder?
-        return $x;                      # only x, which is [0] now
+        $rem = $c->_copy($x) if wantarray;      # make copy
+        @$x = 0;                                # set to 0
+        return ($x, $rem) if wantarray;         # including remainder?
+        return $x;                              # only x, which is [0] now
     }
+
     # check whether the numbers have the same number of elements, in that case
     # the result will fit into one element and can be computed efficiently
     if (@$yorg == @$x) {
-        my $rem;
-        # if $yorg has more digits than $x (it's leading element is longer than
-        # the one from $x), the result will also be 0:
-        if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
-            $rem = $c->_copy($x) if wantarray;     # make copy
-            @$x = 0;                          # set to 0
-            return ($x, $rem) if wantarray; # including remainder?
-            return $x;
+        my $cmp = 0;
+        for (my $j = $#$x ; $j >= 0 ; --$j) {
+            last if $cmp = $x->[$j] - $yorg->[$j];
         }
-        # now calculate $x / $yorg
 
-        if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
-            # same length, so make full compare
+        if ($cmp == 0) {        # x = y
+            @$x = 1;
+            return $x, $c->_zero() if wantarray;
+            return $x;
+        }
 
-            my $a = 0;
-            my $j = @$x - 1;
-            # manual way (abort if unequal, good for early ne)
-            while ($j >= 0) {
-                last if ($a = $x->[$j] - $yorg->[$j]);
-                $j--;
-            }
-            # $a contains the result of the compare between X and Y
-            # a < 0: x < y, a == 0: x == y, a > 0: x > y
-            if ($a <= 0) {
-                $rem = $c->_zero();                  # a = 0 => x == y => rem 0
-                $rem = $c->_copy($x) if $a != 0;       # a < 0 => x < y => rem = x
-                @$x = 0;                       # if $a < 0
-                $x->[0] = 1 if $a == 0;        # $x == $y
-                return ($x, $rem) if wantarray; # including remainder?
-                return $x;
+        if ($cmp < 0) {         # x < y
+            if (wantarray) {
+                my $rem = $c->_copy($x);
+                @$x = 0;
+                return $x, $rem;
             }
-            # $x >= $y, so proceed normally
+            @$x = 0;
+            return $x;
         }
     }
 
     # all other cases:
 
-    my $y = $c->_copy($yorg);         # always make copy to preserve
-
-    my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
+    my $y = $c->_copy($yorg);           # always make copy to preserve
 
-    $car = $bar = $prd = 0;
-    if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
-        for $xi (@$x) {
+    my $tmp;
+    my $dd = $BASE / ($y->[-1] + 1);
+    if ($dd != 1) {
+        my $car = 0;
+        for my $xi (@$x) {
             $xi = $xi * $dd + $car;
-            $xi -= ($car = int($xi / $BASE)) * $BASE;
+            $xi -= ($car = $xi / $BASE) * $BASE;
         }
         push(@$x, $car);
         $car = 0;
-        for $yi (@$y) {
+        for my $yi (@$y) {
             $yi = $yi * $dd + $car;
-            $yi -= ($car = int($yi / $BASE)) * $BASE;
+            $yi -= ($car = $yi / $BASE) * $BASE;
         }
     } else {
         push(@$x, 0);
@@ -877,43 +844,48 @@ sub _div_use_div_64 {
     # @q will accumulate the final result, $q contains the current computed
     # part of the final result
 
-    @q = ();
-    ($v2, $v1) = @$y[-2, -1];
+    my @q = ();
+    my ($v2, $v1) = @$y[-2, -1];
     $v2 = 0 unless $v2;
     while ($#$x > $#$y) {
-        ($u2, $u1, $u0) = @$x[-3..-1];
+        my ($u2, $u1, $u0) = @$x[-3 .. -1];
         $u2 = 0 unless $u2;
         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
         # if $v1 == 0;
-        $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
-        --$q while ($v2 * $q > ($u0 * $BASE +$ u1- $q*$v1) * $BASE + $u2);
+        my $tmp = $u0 * $BASE + $u1;
+        my $rem = $tmp % $v1;
+        my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
+        --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
         if ($q) {
-            ($car, $bar) = (0, 0);
-            for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+            my $prd;
+            my ($car, $bar) = (0, 0);
+            for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                 $prd = $q * $y->[$yi] + $car;
                 $prd -= ($car = int($prd / $BASE)) * $BASE;
-                $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+                $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
             }
             if ($x->[-1] < $car + $bar) {
                 $car = 0;
                 --$q;
-                for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+                for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                     $x->[$xi] -= $BASE
-                      if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+                      if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
                 }
             }
         }
         pop(@$x);
         unshift(@q, $q);
     }
+
     if (wantarray) {
         my $d = bless [], $c;
         if ($dd != 1) {
-            $car = 0;
-            for $xi (reverse @$x) {
+            my $car = 0;
+            my $prd;
+            for my $xi (reverse @$x) {
                 $prd = $car * $BASE + $xi;
-                $car = $prd - ($tmp = int($prd / $dd)) * $dd;
-                unshift(@$d, $tmp);
+                $car = $prd - ($tmp = $prd / $dd) * $dd;
+                unshift @$d, $tmp;
             }
         } else {
             @$d = @$x;
@@ -931,27 +903,22 @@ sub _div_use_div_64 {
 sub _div_use_div {
     # ref to array, ref to array, modify first array and return remainder if
     # in list context
+
     my ($c, $x, $yorg) = @_;
 
     # the general div algorithm here is about O(N*N) and thus quite slow, so
     # we first check for some special cases and use shortcuts to handle them.
 
-    # This works, because we store the numbers in a chunked format where each
-    # element contains 5..7 digits (depending on system).
-
     # if both numbers have only one element:
     if (@$x == 1 && @$yorg == 1) {
         # shortcut, $yorg and $x are two small numbers
-        if (wantarray) {
-            my $rem = [ $x->[0] % $yorg->[0] ];
-            bless $rem, $c;
-            $x->[0] = int($x->[0] / $yorg->[0]);
-            return ($x, $rem);
-        } else {
-            $x->[0] = int($x->[0] / $yorg->[0]);
-            return $x;
-        }
+        my $rem = [ $x->[0] % $yorg->[0] ];
+        bless $rem, $c;
+        $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0];
+        return ($x, $rem) if wantarray;
+        return $x;
     }
+
     # if x has more than one, but y has only one element:
     if (@$yorg == 1) {
         my $rem;
@@ -964,80 +931,72 @@ sub _div_use_div {
         my $b;
         while ($j-- > 0) {
             $b = $r * $BASE + $x->[$j];
-            $x->[$j] = int($b/$y);
             $r = $b % $y;
+            $x->[$j] = ($b - $r) / $y;
         }
-        pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+        pop(@$x) if @$x > 1 && $x->[-1] == 0;   # remove any trailing zero
         return ($x, $rem) if wantarray;
         return $x;
     }
+
     # now x and y have more than one element
 
-    # check whether y has more elements than x, if yet, the result will be 0
+    # check whether y has more elements than x, if so, the result is 0
     if (@$yorg > @$x) {
         my $rem;
-        $rem = $c->_copy($x) if wantarray;    # make copy
-        @$x = 0;                        # set to 0
-        return ($x, $rem) if wantarray; # including remainder?
-        return $x;                      # only x, which is [0] now
+        $rem = $c->_copy($x) if wantarray;      # make copy
+        @$x = 0;                                # set to 0
+        return ($x, $rem) if wantarray;         # including remainder?
+        return $x;                              # only x, which is [0] now
     }
+
     # check whether the numbers have the same number of elements, in that case
     # the result will fit into one element and can be computed efficiently
     if (@$yorg == @$x) {
-        my $rem;
-        # if $yorg has more digits than $x (it's leading element is longer than
-        # the one from $x), the result will also be 0:
-        if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
-            $rem = $c->_copy($x) if wantarray;        # make copy
-            @$x = 0;                            # set to 0
-            return ($x, $rem) if wantarray;     # including remainder?
-            return $x;
+        my $cmp = 0;
+        for (my $j = $#$x ; $j >= 0 ; --$j) {
+            last if $cmp = $x->[$j] - $yorg->[$j];
         }
-        # now calculate $x / $yorg
 
-        if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
-            # same length, so make full compare
+        if ($cmp == 0) {        # x = y
+            @$x = 1;
+            return $x, $c->_zero() if wantarray;
+            return $x;
+        }
 
-            my $a = 0;
-            my $j = @$x - 1;
-            # manual way (abort if unequal, good for early ne)
-            while ($j >= 0) {
-                last if ($a = $x->[$j] - $yorg->[$j]);
-                $j--;
-            }
-            # $a contains the result of the compare between X and Y
-            # a < 0: x < y, a == 0: x == y, a > 0: x > y
-            if ($a <= 0) {
-                $rem = $c->_zero();                   # a = 0 => x == y => rem 0
-                $rem = $c->_copy($x) if $a != 0;      # a < 0 => x < y => rem = x
+        if ($cmp < 0) {         # x < y
+            if (wantarray) {
+                my $rem = $c->_copy($x);
                 @$x = 0;
-                $x->[0] = 0;                    # if $a < 0
-                $x->[0] = 1 if $a == 0;         # $x == $y
-                return ($x, $rem) if wantarray; # including remainder?
-                return $x;
+                return $x, $rem;
             }
-            # $x >= $y, so proceed normally
-
+            @$x = 0;
+            return $x;
         }
     }
 
     # all other cases:
 
-    my $y = $c->_copy($yorg);         # always make copy to preserve
-
-    my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0);
+    my $y = $c->_copy($yorg);           # always make copy to preserve
 
-    $car = $bar = $prd = 0;
-    if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
-        for $xi (@$x) {
+    my $tmp = $y->[-1] + 1;
+    my $rem = $BASE % $tmp;
+    my $dd  = ($BASE - $rem) / $tmp;
+    if ($dd != 1) {
+        my $car = 0;
+        for my $xi (@$x) {
             $xi = $xi * $dd + $car;
-            $xi -= ($car = int($xi / $BASE)) * $BASE;
+            $rem = $xi % $BASE;
+            $car = ($xi - $rem) / $BASE;
+            $xi = $rem;
         }
         push(@$x, $car);
         $car = 0;
-        for $yi (@$y) {
+        for my $yi (@$y) {
             $yi = $yi * $dd + $car;
-            $yi -= ($car = int($yi / $BASE)) * $BASE;
+            $rem = $yi % $BASE;
+            $car = ($yi - $rem) / $BASE;
+            $yi = $rem;
         }
     } else {
         push(@$x, 0);
@@ -1046,43 +1005,52 @@ sub _div_use_div {
     # @q will accumulate the final result, $q contains the current computed
     # part of the final result
 
-    @q = ();
-    ($v2, $v1) = @$y[-2, -1];
+    my @q = ();
+    my ($v2, $v1) = @$y[-2, -1];
     $v2 = 0 unless $v2;
     while ($#$x > $#$y) {
-        ($u2, $u1, $u0) = @$x[-3..-1];
+        my ($u2, $u1, $u0) = @$x[-3 .. -1];
         $u2 = 0 unless $u2;
         #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
         # if $v1 == 0;
-        $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
-        --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
+        my $tmp = $u0 * $BASE + $u1;
+        my $rem = $tmp % $v1;
+        my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
+        --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
         if ($q) {
-            ($car, $bar) = (0, 0);
-            for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+            my $prd;
+            my ($car, $bar) = (0, 0);
+            for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                 $prd = $q * $y->[$yi] + $car;
-                $prd -= ($car = int($prd / $BASE)) * $BASE;
-                $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+                $rem = $prd % $BASE;
+                $car = ($prd - $rem) / $BASE;
+                $prd -= $car * $BASE;
+                $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
             }
             if ($x->[-1] < $car + $bar) {
                 $car = 0;
                 --$q;
-                for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+                for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                     $x->[$xi] -= $BASE
-                      if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+                      if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
                 }
             }
         }
         pop(@$x);
         unshift(@q, $q);
     }
+
     if (wantarray) {
         my $d = bless [], $c;
         if ($dd != 1) {
-            $car = 0;
-            for $xi (reverse @$x) {
+            my $car = 0;
+            my ($prd, $rem);
+            for my $xi (reverse @$x) {
                 $prd = $car * $BASE + $xi;
-                $car = $prd - ($tmp = int($prd / $dd)) * $dd;
-                unshift(@$d, $tmp);
+                $rem = $prd % $dd;
+                $tmp = ($prd - $rem) / $dd;
+                $car = $rem;
+                unshift @$d, $tmp;
             }
         } else {
             @$d = @$x;
@@ -1385,7 +1353,7 @@ sub _rsft {
             $dst++;
         }
         splice(@$x, $dst) if $dst > 0;       # kill left-over array elems
-        pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0
+        pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0
     }                                        # else rem == 0
     $x;
 }
@@ -1393,49 +1361,64 @@ sub _rsft {
 sub _lsft {
     my ($c, $x, $n, $b) = @_;
 
-    return $x if $c->_is_zero($x);
-
-    # Handle the special case when the base is a power of 10. Don't check
-    # whether log($b)/log(10) is an integer, because log(1000)/log(10) is not
-    # exactly 3.
-
-    my $log10 = sprintf "%.0f", log($b) / log(10);
-    if ($b == 10 ** $log10) {
-        $b = 10;
-        $n = $c->_mul($n, $c->_new($log10));
-
-        # shortcut (faster) for shifting by 10) since we are in base 10eX
-        # multiples of $BASE_LEN:
-        my $src = @$x;                      # source
-        my $len = $c->_num($n);             # shift-len as normal int
-        my $rem = $len % $BASE_LEN;         # remainder to shift
-        my $dst = $src + int($len / $BASE_LEN); # destination
-        my $vd;                                 # further speedup
-        $x->[$src] = 0;                         # avoid first ||0 for speed
-        my $z = '0' x $BASE_LEN;
-        while ($src >= 0) {
-            $vd = $x->[$src];
-            $vd = $z . $vd;
-            $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem);
-            $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem)
-              : '0' x $rem;
-            $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
-            $x->[$dst] = int($vd);
-            $dst--;
-            $src--;
+    return $x if $c->_is_zero($x) || $c->_is_zero($n);
+
+    # For backwards compatibility, allow the base $b to be a scalar.
+
+    $b = $c->_new($b) unless ref $b;
+
+    # If the base is a power of 10, use shifting, since the internal
+    # representation is in base 10eX.
+
+    my $bstr = $c->_str($b);
+    if ($bstr =~ /^1(0+)\z/) {
+
+        # Adjust $n so that we're shifting in base 10. Do this by multiplying
+        # $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n).
+
+        my $log10b = length($1);
+        $n = $c->_mul($c->_new($log10b), $n);
+        $n = $c->_num($n);              # shift-len as normal int
+
+        # $q is the number of places to shift the elements within the array,
+        # and $r is the number of places to shift the values within the
+        # elements.
+
+        my $r = $n % $BASE_LEN;
+        my $q = ($n - $r) / $BASE_LEN;
+
+        # If we must shift the values within the elements ...
+
+        if ($r) {
+            my $i = @$x;                # index
+            $x->[$i] = 0;               # initialize most significant element
+            my $z = '0' x $BASE_LEN;
+            my $vd;
+            while ($i >= 0) {
+                $vd = $x->[$i];
+                $vd = $z . $vd;
+                $vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r);
+                $vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r)
+                              : '0' x $r;
+                $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
+                $x->[$i] = int($vd);    # e.g., "0...048" -> 48 etc.
+                $i--;
+            }
+
+            pop(@$x) if $x->[-1] == 0;  # if most significant element is zero
         }
-        # set lowest parts to 0
-        while ($dst >= 0) {
-            $x->[$dst--] = 0;
+
+        # If we must shift the elements within the array ...
+
+        if ($q) {
+            unshift @$x, (0) x $q;
         }
-        # fix spurious last zero element
-        splice @$x, -1 if $x->[-1] == 0;
-        return $x;
+
     } else {
-        $b = $c->_new($b);
-        #print $c->_str($b);
-        return $c->_mul($x, $c->_pow($b, $n));
+        $x = $c->_mul($x, $c->_pow($b, $n));
     }
+
+    return $x;
 }
 
 sub _pow {
index 883f31f..619c8d9 100644 (file)
@@ -4,7 +4,7 @@ use 5.006001;
 use strict;
 use warnings;
 
-our $VERSION = '1.999816';
+our $VERSION = '1.999817';
 
 use Carp;
 
@@ -251,13 +251,6 @@ use overload
 
   ;
 
-# Do we need api_version() at all, now that we have a virtual parent class that
-# will provide any missing methods? Fixme!
-
-sub api_version () {
-    croak "@{[(caller 0)[3]]} method not implemented";
-}
-
 sub _new {
     croak "@{[(caller 0)[3]]} method not implemented";
 }
@@ -386,6 +379,20 @@ sub _digit {
     substr($class ->_str($x), -($n+1), 1);
 }
 
+sub _digitsum {
+    my ($class, $x) = @_;
+
+    my $len = $class -> _len($x);
+    my $sum = $class -> _zero();
+    for (my $i = 0 ; $i < $len ; ++$i) {
+        my $digit = $class -> _digit($x, $i);
+        $digit = $class -> _new($digit);
+        $sum = $class -> _add($sum, $digit);
+    }
+
+    return $sum;
+}
+
 sub _zeros {
     my ($class, $x) = @_;
     my $str = $class -> _str($x);
@@ -1428,16 +1435,20 @@ sub _to_base {
     if (@_) {
         $collseq = shift();
     } else {
-        if ($class -> _acmp($base, $class -> _new("62")) <= 0) {
-            $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-                                    . 'abcdefghijklmnopqrstuvwxyz';
+        if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
+            $collseq = '0123456789'                     #  48 ..  57
+                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
+                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
+                     . '!"#$%&\'()*+,-./'               #  33 ..  47
+                     . ':;<=>?@'                        #  58 ..  64
+                     . '[\\]^_`'                        #  91 ..  96
+                     . '{|}~';                          # 123 .. 126
         } else {
-            croak "When base > 62, a collation sequence must be given";
+            croak "When base > 94, a collation sequence must be given";
         }
     }
 
     my @collseq = split '', $collseq;
-    my %collseq = map { $_ => $collseq[$_] } 0 .. $#collseq;
 
     my $str   = '';
     my $tmp   = $class -> _copy($x);
@@ -1573,11 +1584,16 @@ sub _from_base {
         if ($class -> _acmp($base, $class -> _new("36")) <= 0) {
             $str = uc $str;
             $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
-        } elsif ($class -> _acmp($base, $class -> _new("62")) <= 0) {
-            $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-                                    . 'abcdefghijklmnopqrstuvwxyz';
+        } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) {
+            $collseq = '0123456789'                     #  48 ..  57
+                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
+                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
+                     . '!"#$%&\'()*+,-./'               #  33 ..  47
+                     . ':;<=>?@'                        #  58 ..  64
+                     . '[\\]^_`'                        #  91 ..  96
+                     . '{|}~';                          # 123 .. 126
         } else {
-            croak "When base > 62, a collation sequence must be given";
+            croak "When base > 94, a collation sequence must be given";
         }
         $collseq = substr $collseq, 0, $class -> _num($base);
     }
@@ -1920,11 +1936,8 @@ comparison routines.
 
 =item CLASS-E<gt>api_version()
 
-Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for
-Math::BigInt v1.83.
-
-This method is no longer used. Methods that are not implemented by a subclass
-will be inherited from this class.
+This method is no longer used and can be omitted. Methods that are not
+implemented by a subclass will be inherited from this class.
 
 =back
 
@@ -1986,10 +1999,20 @@ COLLSEQ. Each character in STR represents a numerical value identical to the
 character's position in COLLSEQ. All characters in STR must be present in
 COLLSEQ.
 
-If BASE is less than or equal to 62, and a collation sequence is not specified,
-a default collation sequence consisting of the 62 characters 0..9, A..Z, and
-a..z is used. If the default collation sequence is used, and the BASE is less
-than or equal to 36, the letter case in STR is ignored.
+If BASE is less than or equal to 94, and a collation sequence is not specified,
+the following default collation sequence is used. It contains of all the 94
+printable ASCII characters except space/blank:
+
+    0123456789                  # ASCII  48 to  57
+    ABCDEFGHIJKLMNOPQRSTUVWXYZ  # ASCII  65 to  90
+    abcdefghijklmnopqrstuvwxyz  # ASCII  97 to 122
+    !"#$%&'()*+,-./             # ASCII  33 to  47
+    :;<=>?@                     # ASCII  58 to  64
+    [\]^_`                      # ASCII  91 to  96
+    {|}~                        # ASCII 123 to 126
+
+If the default collation sequence is used, and the BASE is less than or equal
+to 36, the letter case in STR is ignored.
 
 For instance, with base 3 and collation sequence "-/|", the character "-"
 represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the
@@ -2005,10 +2028,12 @@ conversion. All examples return 250.
 
 Some more examples, all returning 250:
 
-    $x = $class -> _from_base("100021", 3, "012")
-    $x = $class -> _from_base("3322", 4, "0123")
-    $x = $class -> _from_base("2000", 5, "01234")
+    $x = $class -> _from_base("100021", 3)
+    $x = $class -> _from_base("3322", 4)
+    $x = $class -> _from_base("2000", 5)
     $x = $class -> _from_base("caaa", 5, "abcde")
+    $x = $class -> _from_base("42", 62)
+    $x = $class -> _from_base("2!", 94)
 
 =back
 
@@ -2301,6 +2326,10 @@ from the left (most significant digit). If $obj represents the number 123, then
     CLASS->_digit($obj,  2)     # returns 1
     CLASS->_digit($obj, -1)     # returns 1
 
+=item CLASS-E<gt>_digitsum(OBJ)
+
+Returns the sum of the base 10 digits.
+
 =item CLASS-E<gt>_check(OBJ)
 
 Returns true if the object is invalid and false otherwise. Preferably, the true
@@ -2394,11 +2423,11 @@ L<http://annocpan.org/dist/Math-BigInt>
 
 =item * CPAN Ratings
 
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
 
-=item * Search CPAN
+=item * MetaCPAN
 
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
 
 =item * CPAN Testers Matrix
 
index 73b79d9..f521e52 100644 (file)
@@ -17,11 +17,6 @@ my $BASE_LEN = 9;
 my $BASE     = 0 + ("1" . ("0" x $BASE_LEN));
 my $MAX_VAL  = $BASE - 1;
 
-# Do we need api_version() at all, now that we have a virtual parent class that
-# will provide any missing methods? Fixme!
-
-sub api_version () { 2; }
-
 sub _new {
     my ($class, $str) = @_;
     croak "Invalid input string '$str'" unless $str =~ /^([1-9]\d*|0)\z/;
@@ -490,529 +485,4 @@ sub _check {
     return 0;
 }
 
-##############################################################################
-##############################################################################
-
 1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Math::BigInt::Calc - Pure Perl module to support Math::BigInt
-
-=head1 SYNOPSIS
-
-This library provides support for big integer calculations. It is not
-intended to be used by other modules. Other modules which support the same
-API (see below) can also be used to support Math::BigInt, like
-Math::BigInt::GMP and Math::BigInt::Pari.
-
-=head1 DESCRIPTION
-
-In this library, the numbers are represented in base B = 10**N, where N is
-the largest possible value that does not cause overflow in the intermediate
-computations. The base B elements are stored in an array, with the least
-significant element stored in array element zero. There are no leading zero
-elements, except a single zero element when the number is zero.
-
-For instance, if B = 10000, the number 1234567890 is represented internally
-as [3456, 7890, 12].
-
-=head1 THE Math::BigInt API
-
-In order to allow for multiple big integer libraries, Math::BigInt was
-rewritten to use a plug-in library for core math routines. Any module which
-conforms to the API can be used by Math::BigInt by using this in your program:
-
-        use Math::BigInt lib => 'libname';
-
-'libname' is either the long name, like 'Math::BigInt::Pari', or only the short
-version, like 'Pari'.
-
-=head2 General Notes
-
-A library only needs to deal with unsigned big integers. Testing of input
-parameter validity is done by the caller, so there is no need to worry about
-underflow (e.g., in C<_sub()> and C<_dec()>) nor about division by zero (e.g.,
-in C<_div()>) or similar cases.
-
-For some methods, the first parameter can be modified. That includes the
-possibility that you return a reference to a completely different object
-instead. Although keeping the reference and just changing its contents is
-preferred over creating and returning a different reference.
-
-Return values are always objects, strings, Perl scalars, or true/false for
-comparison routines.
-
-=head2 API version 1
-
-The following methods must be defined in order to support the use by
-Math::BigInt v1.70 or later.
-
-=head3 API version
-
-=over 4
-
-=item I<api_version()>
-
-Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for
-Math::BigInt v1.83.
-
-=back
-
-=head3 Constructors
-
-=over 4
-
-=item I<_new(STR)>
-
-Convert a string representing an unsigned decimal number to an object
-representing the same number. The input is normalize, i.e., it matches
-C<^(0|[1-9]\d*)$>.
-
-=item I<_zero()>
-
-Return an object representing the number zero.
-
-=item I<_one()>
-
-Return an object representing the number one.
-
-=item I<_two()>
-
-Return an object representing the number two.
-
-=item I<_ten()>
-
-Return an object representing the number ten.
-
-=item I<_from_bin(STR)>
-
-Return an object given a string representing a binary number. The input has a
-'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>.
-
-=item I<_from_oct(STR)>
-
-Return an object given a string representing an octal number. The input has a
-'0' prefix and matches the regular expression C<^0[1-7]*$>.
-
-=item I<_from_hex(STR)>
-
-Return an object given a string representing a hexadecimal number. The input
-has a '0x' prefix and matches the regular expression
-C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>.
-
-=back
-
-=head3 Mathematical functions
-
-Each of these methods may modify the first input argument, except I<_bgcd()>,
-which shall not modify any input argument, and I<_sub()> which may modify the
-second input argument.
-
-=over 4
-
-=item I<_add(OBJ1, OBJ2)>
-
-Returns the result of adding OBJ2 to OBJ1.
-
-=item I<_mul(OBJ1, OBJ2)>
-
-Returns the result of multiplying OBJ2 and OBJ1.
-
-=item I<_div(OBJ1, OBJ2)>
-
-Returns the result of dividing OBJ1 by OBJ2 and truncating the result to an
-integer.
-
-=item I<_sub(OBJ1, OBJ2, FLAG)>
-
-=item I<_sub(OBJ1, OBJ2)>
-
-Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted,
-OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
-
-=item I<_dec(OBJ)>
-
-Decrement OBJ by one.
-
-=item I<_inc(OBJ)>
-
-Increment OBJ by one.
-
-=item I<_mod(OBJ1, OBJ2)>
-
-Return OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2.
-
-=item I<_sqrt(OBJ)>
-
-Return the square root of the object, truncated to integer.
-
-=item I<_root(OBJ, N)>
-
-Return Nth root of the object, truncated to int. N is E<gt>= 3.
-
-=item I<_fac(OBJ)>
-
-Return factorial of object (1*2*3*4*...).
-
-=item I<_pow(OBJ1, OBJ2)>
-
-Return OBJ1 to the power of OBJ2. By convention, 0**0 = 1.
-
-=item I<_modinv(OBJ1, OBJ2)>
-
-Return modular multiplicative inverse, i.e., return OBJ3 so that
-
-    (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2
-
-The result is returned as two arguments. If the modular multiplicative
-inverse does not exist, both arguments are undefined. Otherwise, the
-arguments are a number (object) and its sign ("+" or "-").
-
-The output value, with its sign, must either be a positive value in the
-range 1,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the
-input arguments are objects representing the numbers 7 and 5, the method
-must either return an object representing the number 3 and a "+" sign, since
-(3*7) % 5 = 1 % 5, or an object representing the number 2 and "-" sign,
-since (-2*7) % 5 = 1 % 5.
-
-=item I<_modpow(OBJ1, OBJ2, OBJ3)>
-
-Return modular exponentiation, (OBJ1 ** OBJ2) % OBJ3.
-
-=item I<_rsft(OBJ, N, B)>
-
-Shift object N digits right in base B and return the resulting object. This is
-equivalent to performing integer division by B**N and discarding the remainder,
-except that it might be much faster, depending on how the number is represented
-internally.
-
-For instance, if the object $obj represents the hexadecimal number 0xabcde,
-then C<< $obj->_rsft(2, 16) >> returns an object representing the number 0xabc.
-The "remainer", 0xde, is discarded and not returned.
-
-=item I<_lsft(OBJ, N, B)>
-
-Shift the object N digits left in base B. This is equivalent to multiplying by
-B**N, except that it might be much faster, depending on how the number is
-represented internally.
-
-=item I<_log_int(OBJ, B)>
-
-Return integer log of OBJ to base BASE. This method has two output arguments,
-the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ is the exact
-result, 0 if the result was truncted to give OBJ, and undef if it is unknown
-whether OBJ is the exact result.
-
-=item I<_gcd(OBJ1, OBJ2)>
-
-Return the greatest common divisor of OBJ1 and OBJ2.
-
-=back
-
-=head3 Bitwise operators
-
-Each of these methods may modify the first input argument.
-
-=over 4
-
-=item I<_and(OBJ1, OBJ2)>
-
-Return bitwise and. If necessary, the smallest number is padded with leading
-zeros.
-
-=item I<_or(OBJ1, OBJ2)>
-
-Return bitwise or. If necessary, the smallest number is padded with leading
-zeros.
-
-=item I<_xor(OBJ1, OBJ2)>
-
-Return bitwise exclusive or. If necessary, the smallest number is padded
-with leading zeros.
-
-=back
-
-=head3 Boolean operators
-
-=over 4
-
-=item I<_is_zero(OBJ)>
-
-Returns a true value if OBJ is zero, and false value otherwise.
-
-=item I<_is_one(OBJ)>
-
-Returns a true value if OBJ is one, and false value otherwise.
-
-=item I<_is_two(OBJ)>
-
-Returns a true value if OBJ is two, and false value otherwise.
-
-=item I<_is_ten(OBJ)>
-
-Returns a true value if OBJ is ten, and false value otherwise.
-
-=item I<_is_even(OBJ)>
-
-Return a true value if OBJ is an even integer, and a false value otherwise.
-
-=item I<_is_odd(OBJ)>
-
-Return a true value if OBJ is an even integer, and a false value otherwise.
-
-=item I<_acmp(OBJ1, OBJ2)>
-
-Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is less than, equal
-to, or larger than OBJ2, respectively.
-
-=back
-
-=head3 String conversion
-
-=over 4
-
-=item I<_str(OBJ)>
-
-Return a string representing the object. The returned string should have no
-leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>.
-
-=item I<_as_bin(OBJ)>
-
-Return the binary string representation of the number. The string must have a
-'0b' prefix.
-
-=item I<_as_oct(OBJ)>
-
-Return the octal string representation of the number. The string must have
-a '0x' prefix.
-
-Note: This method was required from Math::BigInt version 1.78, but the required
-API version number was not incremented, so there are older libraries that
-support API version 1, but do not support C<_as_oct()>.
-
-=item I<_as_hex(OBJ)>
-
-Return the hexadecimal string representation of the number. The string must
-have a '0x' prefix.
-
-=back
-
-=head3 Numeric conversion
-
-=over 4
-
-=item I<_num(OBJ)>
-
-Given an object, return a Perl scalar number (int/float) representing this
-number.
-
-=back
-
-=head3 Miscellaneous
-
-=over 4
-
-=item I<_copy(OBJ)>
-
-Return a true copy of the object.
-
-=item I<_len(OBJ)>
-
-Returns the number of the decimal digits in the number. The output is a
-Perl scalar.
-
-=item I<_zeros(OBJ)>
-
-Return the number of trailing decimal zeros. The output is a Perl scalar.
-
-=item I<_digit(OBJ, N)>
-
-Return the Nth digit as a Perl scalar. N is a Perl scalar, where zero refers to
-the rightmost (least significant) digit, and negative values count from the
-left (most significant digit). If $obj represents the number 123, then
-I<$obj->_digit(0)> is 3 and I<_digit(123, -1)> is 1.
-
-=item I<_check(OBJ)>
-
-Return a true value if the object is OK, and a false value otherwise. This is a
-check routine to test the internal state of the object for corruption.
-
-=back
-
-=head2 API version 2
-
-The following methods are required for an API version of 2 or greater.
-
-=head3 Constructors
-
-=over 4
-
-=item I<_1ex(N)>
-
-Return an object representing the number 10**N where N E<gt>= 0 is a Perl
-scalar.
-
-=back
-
-=head3 Mathematical functions
-
-=over 4
-
-=item I<_nok(OBJ1, OBJ2)>
-
-Return the binomial coefficient OBJ1 over OBJ1.
-
-=back
-
-=head3 Miscellaneous
-
-=over 4
-
-=item I<_alen(OBJ)>
-
-Return the approximate number of decimal digits of the object. The output is
-one Perl scalar.
-
-=back
-
-=head2 API optional methods
-
-The following methods are optional, and can be defined if the underlying lib
-has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
-slow) fallback routines to emulate these:
-
-=head3 Signed bitwise operators.
-
-Each of these methods may modify the first input argument.
-
-=over 4
-
-=item I<_signed_or(OBJ1, OBJ2, SIGN1, SIGN2)>
-
-Return the signed bitwise or.
-
-=item I<_signed_and(OBJ1, OBJ2, SIGN1, SIGN2)>
-
-Return the signed bitwise and.
-
-=item I<_signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)>
-
-Return the signed bitwise exclusive or.
-
-=back
-
-=head1 WRAP YOUR OWN
-
-If you want to port your own favourite c-lib for big numbers to the
-Math::BigInt interface, you can take any of the already existing modules as a
-rough guideline. You should really wrap up the latest Math::BigInt and
-Math::BigFloat testsuites with your module, and replace in them any of the
-following:
-
-        use Math::BigInt;
-
-by this:
-
-        use Math::BigInt lib => 'yourlib';
-
-This way you ensure that your library really works 100% within Math::BigInt.
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-math-bigint at rt.cpan.org>, or through the web interface at
-L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
-(requires login).
-We will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
-    perldoc Math::BigInt::Calc
-
-You can also look for information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Math-BigInt>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/dist/Math-BigInt>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Math-BigInt/>
-
-=item * CPAN Testers Matrix
-
-L<http://matrix.cpantesters.org/?dist=Math-BigInt>
-
-=item * The Bignum mailing list
-
-=over 4
-
-=item * Post to mailing list
-
-C<bignum at lists.scsys.co.uk>
-
-=item * View mailing list
-
-L<http://lists.scsys.co.uk/pipermail/bignum/>
-
-=item * Subscribe/Unsubscribe
-
-L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
-
-=back
-
-=back
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=head1 AUTHORS
-
-=over 4
-
-=item *
-
-Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
-in late 2000.
-
-=item *
-
-Separated from BigInt and shaped API with the help of John Peacock.
-
-=item *
-
-Fixed, speed-up, streamlined and enhanced by Tels 2001 - 2007.
-
-=item *
-
-API documentation corrected and extended by Peter John Acklam,
-E<lt>pjacklam@online.noE<gt>
-
-=back
-
-=head1 SEE ALSO
-
-L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::GMP>,
-L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.
-
-=cut
index 1bfd338..d703806 100644 (file)
@@ -14,8 +14,6 @@ our @ISA = qw(Exporter);
 
 our $VERSION = '0.13';
 
-sub api_version() { 1; }
-
 ##############################################################################
 # global constants, flags and accessory
 
diff --git a/cpan/Math-BigInt/t/backermann-mbi.t b/cpan/Math-BigInt/t/backermann-mbi.t
new file mode 100644 (file)
index 0000000..45fcac6
--- /dev/null
@@ -0,0 +1,507 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 858;
+
+my $class;
+
+BEGIN {
+    $class = 'Math::BigInt';
+    use_ok($class);
+}
+
+can_ok($class, 'backermann', 'ackermann');
+
+while (<DATA>) {
+    s/#.*$//;                   # remove comments
+    s/\s+$//;                   # remove trailing whitespace
+    next unless length;         # skip empty lines
+
+    my ($m, $n, $expected) = split /:/;
+
+    # backermann() modifies the invocand.
+
+    {
+        my ($x, $y);
+        my $test = qq|\$x = $class->new("$m"); \$y = \$x->backermann("$n");|;
+
+        subtest $test,
+          sub {
+              plan tests => 4;
+
+              eval $test;
+              is($@, "", "'$test' gives emtpy \$\@");
+
+              is(ref($y), $class,
+                 "'$test' output arg is a $class");
+
+              is($y -> bstr(), $expected,
+                 "'$test' output arg has the right value");
+
+              is($x -> bstr(), $expected,
+                 "'$test' invocand has the right value");
+          };
+    }
+
+    # ackermann() does not modify the invocand.
+
+    {
+        my ($x, $y);
+        my $test = qq|\$x = $class->new("$m"); \$y = \$x->ackermann("$n");|;
+
+        subtest $test,
+          sub {
+              plan tests => 4;
+
+              eval $test;
+              is($@, "", "'$test' gives emtpy \$\@");
+
+              is(ref($y), $class,
+                 "'$test' output arg is a $class");
+
+              is($y -> bstr(), $expected,
+                 "'$test' output arg has the right value");
+
+              is($x -> bstr(), $m,
+                 "'$test' invocand has the right value");
+          };
+    }
+}
+
+__DATA__
+
+0:0:1
+0:1:2
+0:2:3
+0:3:4
+0:4:5
+0:5:6
+0:6:7
+0:7:8
+0:8:9
+0:9:10
+0:10:11
+0:11:12
+0:12:13
+0:13:14
+0:14:15
+0:15:16
+0:16:17
+0:17:18
+0:18:19
+0:19:20
+0:20:21
+0:21:22
+0:22:23
+0:23:24
+0:24:25
+0:25:26
+0:26:27
+0:27:28
+0:28:29
+0:29:30
+0:30:31
+0:31:32
+0:32:33
+0:33:34
+0:34:35
+0:35:36
+0:36:37
+0:37:38
+0:38:39
+0:39:40
+0:40:41
+0:41:42
+0:42:43
+0:43:44
+0:44:45
+0:45:46
+0:46:47
+0:47:48
+0:48:49
+0:49:50
+0:50:51
+0:51:52
+0:52:53
+0:53:54
+0:54:55
+0:55:56
+0:56:57
+0:57:58
+0:58:59
+0:59:60
+0:60:61
+0:61:62
+0:62:63
+0:63:64
+0:64:65
+0:65:66
+0:66:67
+0:67:68
+0:68:69
+0:69:70
+0:70:71
+0:71:72
+0:72:73
+0:73:74
+0:74:75
+0:75:76
+0:76:77
+0:77:78
+0:78:79
+0:79:80
+0:80:81
+0:81:82
+0:82:83
+0:83:84
+0:84:85
+0:85:86
+0:86:87
+0:87:88
+0:88:89
+0:89:90
+0:90:91
+0:91:92
+0:92:93
+0:93:94
+0:94:95
+0:95:96
+0:96:97
+0:97:98
+0:98:99
+0:99:100
+0:100:101
+0:1000:1001
+0:100000:100001
+0:10000000:10000001
+0:10000000000:10000000001
+0:10000000000000:10000000000001
+0:10000000000000000000000000000000000:10000000000000000000000000000000001
+0:12345678987654321012345678987654321:12345678987654321012345678987654322
+
+1:0:2
+1:1:3
+1:2:4
+1:3:5
+1:4:6
+1:5:7
+1:6:8
+1:7:9
+1:8:10
+1:9:11
+1:10:12
+1:11:13
+1:12:14
+1:13:15
+1:14:16
+1:15:17
+1:16:18
+1:17:19
+1:18:20
+1:19:21
+1:20:22
+1:21:23
+1:22:24
+1:23:25
+1:24:26
+1:25:27
+1:26:28
+1:27:29
+1:28:30
+1:29:31
+1:30:32
+1:31:33
+1:32:34
+1:33:35
+1:34:36
+1:35:37
+1:36:38
+1:37:39
+1:38:40
+1:39:41
+1:40:42
+1:41:43
+1:42:44
+1:43:45
+1:44:46
+1:45:47
+1:46:48
+1:47:49
+1:48:50
+1:49:51
+1:50:52
+1:51:53
+1:52:54
+1:53:55
+1:54:56
+1:55:57
+1:56:58
+1:57:59
+1:58:60
+1:59:61
+1:60:62
+1:61:63
+1:62:64
+1:63:65
+1:64:66
+1:65:67
+1:66:68
+1:67:69
+1:68:70
+1:69:71
+1:70:72
+1:71:73
+1:72:74
+1:73:75
+1:74:76
+1:75:77
+1:76:78
+1:77:79
+1:78:80
+1:79:81
+1:80:82
+1:81:83
+1:82:84
+1:83:85
+1:84:86
+1:85:87
+1:86:88
+1:87:89
+1:88:90
+1:89:91
+1:90:92
+1:91:93
+1:92:94
+1:93:95
+1:94:96
+1:95:97
+1:96:98
+1:97:99
+1:98:100
+1:99:101
+1:100:102
+1:1000:1002
+1:100000:100002
+1:10000000:10000002
+1:10000000000:10000000002
+1:10000000000000:10000000000002
+1:10000000000000000000000000000000000:10000000000000000000000000000000002
+1:12345678987654321012345678987654321:12345678987654321012345678987654323
+
+2:0:3
+2:1:5
+2:2:7
+2:3:9
+2:4:11
+2:5:13
+2:6:15
+2:7:17
+2:8:19
+2:9:21
+2:10:23
+2:11:25
+2:12:27
+2:13:29
+2:14:31
+2:15:33
+2:16:35
+2:17:37
+2:18:39
+2:19:41
+2:20:43
+2:21:45
+2:22:47
+2:23:49
+2:24:51
+2:25:53
+2:26:55
+2:27:57
+2:28:59
+2:29:61
+2:30:63
+2:31:65
+2:32:67
+2:33:69
+2:34:71
+2:35:73
+2:36:75
+2:37:77
+2:38:79
+2:39:81
+2:40:83
+2:41:85
+2:42:87
+2:43:89
+2:44:91
+2:45:93
+2:46:95
+2:47:97
+2:48:99
+2:49:101
+2:50:103
+2:51:105
+2:52:107
+2:53:109
+2:54:111
+2:55:113
+2:56:115
+2:57:117
+2:58:119
+2:59:121
+2:60:123
+2:61:125
+2:62:127
+2:63:129
+2:64:131
+2:65:133
+2:66:135
+2:67:137
+2:68:139
+2:69:141
+2:70:143
+2:71:145
+2:72:147
+2:73:149
+2:74:151
+2:75:153
+2:76:155
+2:77:157
+2:78:159
+2:79:161
+2:80:163
+2:81:165
+2:82:167
+2:83:169
+2:84:171
+2:85:173
+2:86:175
+2:87:177
+2:88:179
+2:89:181
+2:90:183
+2:91:185
+2:92:187
+2:93:189
+2:94:191
+2:95:193
+2:96:195
+2:97:197
+2:98:199
+2:99:201
+2:100:203
+2:1000:2003
+2:100000:200003
+2:10000000:20000003
+2:10000000000:20000000003
+2:10000000000000:20000000000003
+2:10000000000000000000000000000000000:20000000000000000000000000000000003
+2:12345678987654321012345678987654321:24691357975308642024691357975308645
+
+3:0:5
+3:1:13
+3:2:29
+3:3:61
+3:4:125
+3:5:253
+3:6:509
+3:7:1021
+3:8:2045
+3:9:4093
+3:10:8189
+3:11:16381
+3:12:32765
+3:13:65533
+3:14:131069
+3:15:262141
+3:16:524285
+3:17:1048573
+3:18:2097149
+3:19:4194301
+3:20:8388605
+3:21:16777213
+3:22:33554429
+3:23:67108861
+3:24:134217725
+3:25:268435453
+3:26:536870909
+3:27:1073741821
+3:28:2147483645
+3:29:4294967293
+3:30:8589934589
+3:31:17179869181
+3:32:34359738365
+3:33:68719476733
+3:34:137438953469
+3:35:274877906941
+3:36:549755813885
+3:37:1099511627773
+3:38:2199023255549
+3:39:4398046511101
+3:40:8796093022205
+3:41:17592186044413
+3:42:35184372088829
+3:43:70368744177661
+3:44:140737488355325
+3:45:281474976710653
+3:46:562949953421309
+3:47:1125899906842621
+3:48:2251799813685245
+3:49:4503599627370493
+3:50:9007199254740989
+3:51:18014398509481981
+3:52:36028797018963965
+3:53:72057594037927933
+3:54:144115188075855869
+3:55:288230376151711741
+3:56:576460752303423485
+3:57:1152921504606846973
+3:58:2305843009213693949
+3:59:4611686018427387901
+3:60:9223372036854775805
+3:61:18446744073709551613
+3:62:36893488147419103229
+3:63:73786976294838206461
+3:64:147573952589676412925
+3:65:295147905179352825853
+3:66:590295810358705651709
+3:67:1180591620717411303421
+3:68:2361183241434822606845
+3:69:4722366482869645213693
+3:70:9444732965739290427389
+3:71:18889465931478580854781
+3:72:37778931862957161709565
+3:73:75557863725914323419133
+3:74:151115727451828646838269
+3:75:302231454903657293676541
+3:76:604462909807314587353085
+3:77:1208925819614629174706173
+3:78:2417851639229258349412349
+3:79:4835703278458516698824701
+3:80:9671406556917033397649405
+3:81:19342813113834066795298813
+3:82:38685626227668133590597629
+3:83:77371252455336267181195261
+3:84:154742504910672534362390525
+3:85:309485009821345068724781053
+3:86:618970019642690137449562109
+3:87:1237940039285380274899124221
+3:88:2475880078570760549798248445
+3:89:4951760157141521099596496893
+3:90:9903520314283042199192993789
+3:91:19807040628566084398385987581
+3:92:39614081257132168796771975165
+3:93:79228162514264337593543950333
+3:94:158456325028528675187087900669
+3:95:316912650057057350374175801341
+3:96:633825300114114700748351602685
+3:97:1267650600228229401496703205373
+3:98:2535301200456458802993406410749
+3:99:5070602400912917605986812821501
+3:100:10141204801825835211973625643005
+
+4:0:13
+4:1:65533
+
+5:0:65533
index 5137740..c8184cb 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2818;
+use Test::More tests => 2830;
 
 use lib 't';
 
index 7003104..7c24404 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4026;           # tests in require'd file
+use Test::More tests => 4038;           # tests in require'd file
 
 use lib 't';
 
diff --git a/cpan/Math-BigInt/t/bdigitsum-mbi.t b/cpan/Math-BigInt/t/bdigitsum-mbi.t
new file mode 100644 (file)
index 0000000..45c9bd7
--- /dev/null
@@ -0,0 +1,113 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 48;
+
+use Math::BigInt;
+
+my $x;
+my $y;
+
+###############################################################################
+# bdigitsum()
+
+# Finite numbers.
+
+$x = Math::BigInt -> new("123");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "6");
+is($y, "6");
+
+$x = Math::BigInt -> new("0");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "0");
+is($y, "0");
+
+$x = Math::BigInt -> new("-123");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "6");
+is($y, "6");
+
+# Infinity
+
+$x = Math::BigInt -> binf("+");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "NaN");
+is($y, "NaN");
+
+$x = Math::BigInt -> binf("-");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "NaN");
+is($y, "NaN");
+
+# NaN
+
+$x = Math::BigInt -> bnan();
+isa_ok($x, 'Math::BigInt');
+$y = $x -> bdigitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "NaN");
+is($y, "NaN");
+
+###############################################################################
+# digitsum()
+
+# Finite numbers.
+
+$x = Math::BigInt -> new("123");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "123");
+is($y, "6");
+
+$x = Math::BigInt -> new("0");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "0");
+is($y, "0");
+
+$x = Math::BigInt -> new("-123");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "-123");
+is($y, "6");
+
+# Infinity
+
+$x = Math::BigInt -> binf("+");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "inf");
+is($y, "NaN");
+
+$x = Math::BigInt -> binf("-");
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "-inf");
+is($y, "NaN");
+
+# NaN
+
+$x = Math::BigInt -> bnan();
+isa_ok($x, 'Math::BigInt');
+$y = $x -> digitsum();
+isa_ok($y, 'Math::BigInt');
+is($x, "NaN");
+is($y, "NaN");
index 4858e2e..af6e422 100644 (file)
@@ -37,7 +37,7 @@ while (<DATA>) {
     $try = qq|\$x = $CLASS->new("$args[0]");|;
     if ($f eq "bnorm") {
         $try .= qq| \$x;|;
-    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
+    } elsif ($f =~ /^is_(zero|one|odd|even||(non_)?(negative|positive)|nan|int)$/) {
         $try .= qq| \$x->$f();|;
     } elsif ($f eq "is_inf") {
         $try .= qq| \$x->is_inf("$args[1]");|;
@@ -2183,6 +2183,22 @@ NaN:0
 -inf:1
 +inf:0
 
+&is_non_positive
+0:1
+1:0
+-1:1
+NaN:0
+-inf:1
++inf:0
+
+&is_non_negative
+0:1
+1:1
+-1:0
+NaN:0
+-inf:0
++inf:1
+
 &parts
 0:0 0
 1:1 0
index 992ee04..8b0079f 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2818            # tests in require'd file
+use Test::More tests => 2830            # tests in require'd file
                          + 19;          # tests in this file
 
 use Math::BigInt only => 'Calc';
index 517da46..f9c16d2 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 379;
+use Test::More tests => 460;
 
 use Math::BigInt::Calc;
 
@@ -261,6 +261,27 @@ $y = $LIB->_new("45");
 is($LIB->_str($LIB->_rsft($x, $y, 10)), 0,
    qq|$LIB->_str($LIB->_rsft(\$x, \$y, 10)) = 0|);
 
+# _lsft() with large bases
+
+for my $xstr ("1", "2", "3") {
+    for my $nstr ("1", "2", "3") {
+        for my $bpow (25, 50, 75) {
+            my $bstr = "1" . ("0" x $bpow);
+            my $expected = $xstr . ("0" x ($bpow * $nstr));
+            my $xobj = $LIB->_new($xstr);
+            my $nobj = $LIB->_new($nstr);
+            my $bobj = $LIB->_new($bstr);
+
+            is($LIB->_str($LIB->_lsft($xobj, $nobj, $bobj)), $expected,
+               qq|$LIB->_str($LIB->_lsft($LIB->_new("$xstr"), |
+                                    . qq|$LIB->_new("$nstr"), |
+                                    . qq|$LIB->_new("$bstr")))|);
+            is($LIB->_str($nobj), $nstr, q|$n is unmodified|);
+            is($LIB->_str($bobj), $bstr, q|$b is unmodified|);
+        }
+    }
+}
+
 # _acmp
 
 $x = $LIB->_new("123456789");
index d98807f..9dd331a 100644 (file)
@@ -68,7 +68,7 @@ while (<DATA>) {
     $try = qq|\$x = $CLASS->new("$args[0]");|;
     if ($f eq "bnorm") {
         $try = qq|\$x = $CLASS->bnorm("$args[0]");|;
-    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
+    } elsif ($f =~ /^is_(zero|one|odd|even|(non_)?(negative|positive)|nan|int)$/) {
         $try .= " \$x->$f() || 0;";
     } elsif ($f eq "is_inf") {
         $try .= qq| \$x->is_inf("$args[1]");|;
@@ -787,17 +787,26 @@ SKIP: {
         my @bl = $LIB->_base_len();
         my $bl = $bl[5];
 
-        $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
+        # Compute the value.
+        $x = ('1' x $bl) . ('0' x $bl) . ('1' x $bl) . ('0' x $bl);
         $y = '1' x (2 * $bl);
         $x = $CLASS->new($x)->bmul($y);
-        # result is 123..$bl .  $bl x (3*bl-1) . $bl...321 . '0' x $bl
+
+        # Build the expected output.
         $y = '';
-        my $d = '';
-        for (my $i = 1; $i <= $bl; $i++) {
-            $y .= $i;
-            $d = $i . $d;
+        if ($bl >= 2) {
+            $y .= '123456790' x int(($bl - 2) / 9);
+            $y .= substr '123456790', 0, ($bl - 2) % 9;
+            $y .= ($bl - 1) % 9;
+        }
+        $y .= ((($bl - 1) % 9) + 1) x ($bl * 3);
+        if ($bl >= 2) {
+            $y .= substr '098765432', -(($bl - 1) % 9);
+            $y .= '098765432' x int(($bl - 2) / 9);
         }
-        $y .= $bl x (3 * $bl - 1) . $d . '0' x $bl;
+        $y .= '1';
+        $y .= '0' x $bl;
+
         is($x, $y, "testing number with a zero-hole of BASE_LEN_SMALL");
 
         #########################################################################
@@ -1077,6 +1086,22 @@ invalid:0
 -inf:0
 invalid:0
 
+&is_non_negative
+0:1
+-1:0
+1:1
++inf:1
+-inf:0
+NaN:0
+
+&is_non_positive
+0:1
+-1:1
+1:0
++inf:0
+-inf:1
+NaN:0
+
 &is_int
 -inf:0
 +inf:0
@@ -2850,9 +2875,9 @@ abc:12:NaN
 -inf:NaN:NaN
 #
 -3:-inf:0
--3:-3:NaN
--3:-2:NaN
--3:-1:NaN
+-3:-3:0
+-3:-2:0
+-3:-1:0
 -3:0:1
 -3:1:-3
 -3:2:9
@@ -2861,9 +2886,9 @@ abc:12:NaN
 -3:NaN:NaN
 #
 -2:-inf:0
--2:-3:NaN
--2:-2:NaN
--2:-1:NaN
+-2:-3:0
+-2:-2:0
+-2:-1:0
 -2:0:1
 -2:1:-2
 -2:2:4
@@ -2905,9 +2930,9 @@ abc:12:NaN
 1:NaN:NaN
 #
 2:-inf:0
-2:-3:NaN
-2:-2:NaN
-2:-1:NaN
+2:-3:0
+2:-2:0
+2:-1:0
 2:0:1
 2:1:2
 2:2:4
@@ -2916,9 +2941,9 @@ abc:12:NaN
 2:NaN:NaN
 #
 3:-inf:0
-3:-3:NaN
-3:-2:NaN
-3:-1:NaN
+3:-3:0
+3:-2:0
+3:-1:0
 3:0:1
 3:1:3
 3:2:9
index 1616064..7d05dc9 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4026            # tests in require'd file
+use Test::More tests => 4038            # tests in require'd file
                          + 20;          # tests in this file
 
 use Math::BigInt only => 'Calc';
diff --git a/cpan/Math-BigInt/t/buparrow-mbi.t b/cpan/Math-BigInt/t/buparrow-mbi.t
new file mode 100644 (file)
index 0000000..c2eb2ee
--- /dev/null
@@ -0,0 +1,581 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1021;
+
+my $class;
+
+BEGIN {
+    $class = 'Math::BigInt';
+    use_ok($class);
+}
+
+while (<DATA>) {
+    s/#.*$//;                   # remove comments
+    s/\s+$//;                   # remove trailing whitespace
+    next unless length;         # skip empty lines
+
+    my ($a, $n, $b, $expected) = split /:/;
+
+    # buparrow() modifies the invocand.
+
+    {
+        my ($x, $y);
+        my $test = qq|\$x = $class->new("$a"); \$y = \$x->buparrow($n, $b);|;
+
+        subtest $test,
+          sub {
+              plan tests => 4;
+
+              eval $test;
+              is($@, "", "'$test' gives emtpy \$\@");
+
+              is(ref($y), $class,
+                 "'$test' output arg is a $class");
+
+              is($y -> bstr(), $expected,
+                 "'$test' output arg has the right value");
+
+              is($x -> bstr(), $expected,
+                 "'$test' invocand has the right value");
+          };
+    }
+
+    # uparrow() does not modify the invocand.
+
+    {
+        my ($x, $y);
+        my $test = qq|\$x = $class->new("$a"); \$y = \$x->uparrow($n, $b);|;
+
+        subtest $test,
+          sub {
+              plan tests => 4;
+
+              eval $test;
+              is($@, "", "'$test' gives emtpy \$\@");
+
+              is(ref($y), $class,
+                 "'$test' output arg is a $class");
+
+              is($y -> bstr(), $expected,
+                 "'$test' output arg has the right value");
+
+              is($x -> bstr(), $a,
+                 "'$test' invocand has the right value");
+          };
+    }
+}
+
+__DATA__
+0:0:0:0
+0:0:1:0
+0:0:2:0
+0:0:3:0
+0:0:4:0
+0:0:5:0
+0:0:6:0
+0:0:7:0
+0:0:8:0
+0:0:9:0
+0:1:0:1
+0:1:1:0
+0:1:2:0
+0:1:3:0
+0:1:4:0
+0:1:5:0
+0:1:6:0
+0:1:7:0
+0:1:8:0
+0:1:9:0
+0:2:0:1
+0:2:1:0
+0:2:2:1
+0:2:3:0
+0:2:4:1
+0:2:5:0
+0:2:6:1
+0:2:7:0
+0:2:8:1
+0:2:9:0
+0:3:0:1
+0:3:1:0
+0:3:2:1
+0:3:3:0
+0:3:4:1
+0:3:5:0
+0:3:6:1
+0:3:7:0
+0:3:8:1
+0:3:9:0
+0:4:0:1
+0:4:1:0
+0:4:2:1
+0:4:3:0
+0:4:4:1
+0:4:5:0
+0:4:6:1
+0:4:7:0
+0:4:8:1
+0:4:9:0
+0:5:0:1
+0:5:1:0
+0:5:2:1
+0:5:3:0
+0:5:4:1
+0:5:5:0
+0:5:6:1
+0:5:7:0
+0:5:8:1
+0:5:9:0
+0:6:0:1
+0:6:1:0
+0:6:2:1
+0:6:3:0
+0:6:4:1
+0:6:5:0
+0:6:6:1
+0:6:7:0
+0:6:8:1
+0:6:9:0
+0:7:0:1
+0:7:1:0
+0:7:2:1
+0:7:3:0
+0:7:4:1
+0:7:5:0
+0:7:6:1
+0:7:7:0
+0:7:8:1
+0:7:9:0
+0:8:0:1
+0:8:1:0
+0:8:2:1
+0:8:3:0
+0:8:4:1
+0:8:5:0
+0:8:6:1
+0:8:7:0
+0:8:8:1
+0:8:9:0
+0:9:0:1
+0:9:1:0
+0:9:2:1
+0:9:3:0
+0:9:4:1
+0:9:5:0
+0:9:6:1
+0:9:7:0
+0:9:8:1
+0:9:9:0
+1:0:0:0
+1:0:1:1
+1:0:2:2
+1:0:3:3
+1:0:4:4
+1:0:5:5
+1:0:6:6
+1:0:7:7
+1:0:8:8
+1:0:9:9
+1:1:0:1
+1:1:1:1
+1:1:2:1
+1:1:3:1
+1:1:4:1
+1:1:5:1
+1:1:6:1
+1:1:7:1
+1:1:8:1
+1:1:9:1
+1:2:0:1
+1:2:1:1
+1:2:2:1
+1:2:3:1
+1:2:4:1
+1:2:5:1
+1:2:6:1
+1:2:7:1
+1:2:8:1
+1:2:9:1
+1:3:0:1
+1:3:1:1
+1:3:2:1
+1:3:3:1
+1:3:4:1
+1:3:5:1
+1:3:6:1
+1:3:7:1
+1:3:8:1
+1:3:9:1
+1:4:0:1
+1:4:1:1
+1:4:2:1
+1:4:3:1
+1:4:4:1
+1:4:5:1
+1:4:6:1
+1:4:7:1
+1:4:8:1
+1:4:9:1
+1:5:0:1
+1:5:1:1
+1:5:2:1
+1:5:3:1
+1:5:4:1
+1:5:5:1
+1:5:6:1
+1:5:7:1
+1:5:8:1
+1:5:9:1
+1:6:0:1
+1:6:1:1
+1:6:2:1
+1:6:3:1
+1:6:4:1
+1:6:5:1
+1:6:6:1
+1:6:7:1
+1:6:8:1
+1:6:9:1
+1:7:0:1
+1:7:1:1
+1:7:2:1
+1:7:3:1
+1:7:4:1
+1:7:5:1
+1:7:6:1
+1:7:7:1
+1:7:8:1
+1:7:9:1
+1:8:0:1
+1:8:1:1
+1:8:2:1
+1:8:3:1
+1:8:4:1
+1:8:5:1
+1:8:6:1
+1:8:7:1
+1:8:8:1
+1:8:9:1
+1:9:0:1
+1:9:1:1
+1:9:2:1
+1:9:3:1
+1:9:4:1
+1:9:5:1
+1:9:6:1
+1:9:7:1
+1:9:8:1
+1:9:9:1
+2:0:0:0
+2:0:1:2
+2:0:2:4
+2:0:3:6
+2:0:4:8
+2:0:5:10
+2:0:6:12
+2:0:7:14
+2:0:8:16
+2:0:9:18
+2:1:0:1
+2:1:1:2
+2:1:2:4
+2:1:3:8
+2:1:4:16
+2:1:5:32
+2:1:6:64
+2:1:7:128
+2:1:8:256
+2:1:9:512
+2:2:0:1
+2:2:1:2
+2:2:2:4
+2:2:3:16
+2:2:4:65536
+2:3:0:1
+2:3:1:2
+2:3:2:4
+2:3:3:65536
+2:4:0:1
+2:4:1:2
+2:4:2:4
+2:5:0:1
+2:5:1:2
+2:5:2:4
+2:6:0:1
+2:6:1:2
+2:6:2:4
+2:7:0:1
+2:7:1:2
+2:7:2:4
+2:8:0:1
+2:8:1:2
+2:8:2:4
+2:9:0:1
+2:9:1:2
+2:9:2:4
+3:0:0:0
+3:0:1:3
+3:0:2:6
+3:0:3:9
+3:0:4:12
+3:0:5:15
+3:0:6:18
+3:0:7:21
+3:0:8:24
+3:0:9:27
+3:1:0:1
+3:1:1:3
+3:1:2:9
+3:1:3:27
+3:1:4:81
+3:1:5:243
+3:1:6:729
+3:1:7:2187
+3:1:8:6561
+3:1:9:19683
+3:2:0:1
+3:2:1:3
+3:2:2:27
+3:2:3:7625597484987
+3:3:0:1
+3:3:1:3
+3:3:2:7625597484987
+3:4:0:1
+3:4:1:3
+3:5:0:1
+3:5:1:3
+3:6:0:1
+3:6:1:3
+3:7:0:1
+3:7:1:3
+3:8:0:1
+3:8:1:3
+3:9:0:1
+3:9:1:3
+4:0:0:0
+4:0:1:4
+4:0:2:8
+4:0:3:12
+4:0:4:16
+4:0:5:20
+4:0:6:24
+4:0:7:28
+4:0:8:32
+4:0:9:36
+4:1:0:1
+4:1:1:4
+4:1:2:16
+4:1:3:64
+4:1:4:256
+4:1:5:1024
+4:1:6:4096
+4:1:7:16384
+4:1:8:65536
+4:1:9:262144
+4:2:0:1
+4:2:1:4
+4:2:2:256
+4:2:3:13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084096
+4:3:0:1
+4:3:1:4
+4:4:0:1
+4:4:1:4
+4:5:0:1
+4:5:1:4
+4:6:0:1
+4:6:1:4
+4:7:0:1
+4:7:1:4
+4:8:0:1
+4:8:1:4
+4:9:0:1
+4:9:1:4
+5:0:0:0
+5:0:1:5
+5:0:2:10
+5:0:3:15
+5:0:4:20
+5:0:5:25
+5:0:6:30
+5:0:7:35
+5:0:8:40
+5:0:9:45
+5:1:0:1
+5:1:1:5
+5:1:2:25
+5:1:3:125
+5:1:4:625
+5:1:5:3125
+5:1:6:15625
+5:1:7:78125
+5:1:8:390625
+5:1:9:1953125
+5:2:0:1
+5:2:1:5
+5:2:2:3125
+5:2:3:1911012597945477520356404559703964599198081048990094337139512789246520530242615803012059386519739850265586440155794462235359212788673806972288410146915986602087961896757195701839281660338047611225975533626101001482651123413147768252411493094447176965282756285196737514395357542479093219206641883011787169122552421070050709064674382870851449950256586194461543183511379849133691779928127433840431549236855526783596374102105331546031353725325748636909159778690328266459182983815230286936572873691422648131291743762136325730321645282979486862576245362218017673224940567642819360078720713837072355305446356153946401185348493792719514594505508232749221605848912910945189959948686199543147666938013037176163592594479746164220050885079469804487133205133160739134230540198872570038329801246050197013467397175909027389493923817315786996845899794781068042822436093783946335265422815704302832442385515082316490967285712171708123232790481817268327510112746782317410985888683708522000711733492253913322300756147180429007527677793352306200618286012455254243061006894805446584704820650982664319360960388736258510747074340636286976576702699258649953557976318173902550891331223294743930343956161328334072831663498258145226862004307799084688103804187368324800903873596212919633602583120781673673742533322879296907205490595621406888825991244581842379597863476484315673760923625090371511798941424262270220066286486867868710182980872802560693101949280830825044198424796792058908817112327192301455582916746795197430548026404646854002733993860798594465961501752586965811447568510041568687730903712482535343839285397598749458497050038225012489284001826590056251286187629938044407340142347062055785305325034918189589707199305662188512963187501743535960282201038211616048545121039313312256332260766436236688296850208839496142830484739113991669622649948563685234712873294796680884509405893951104650944137909502276545653133018670633521323028460519434381399810561400652595300731790772711065783494174642684720956134647327748584238274899668755052504394218232191357223054066715373374248543645663782045701654593218154053548393614250664498585403307466468541890148134347714650315037954175778622811776585876941680908203125
+5:3:0:1
+5:3:1:5
+5:4:0:1
+5:4:1:5
+5:5:0:1
+5:5:1:5
+5:6:0:1
+5:6:1:5
+5:7:0:1
+5:7:1:5
+5:8:0:1
+5:8:1:5
+5:9:0:1
+5:9:1:5
+6:0:0:0
+6:0:1:6
+6:0:2:12
+6:0:3:18
+6:0:4:24
+6:0:5:30
+6:0:6:36
+6:0:7:42
+6:0:8:48
+6:0:9:54
+6:1:0:1
+6:1:1:6
+6:1:2:36
+6:1:3:216
+6:1:4:1296
+6:1:5:7776
+6:1:6:46656
+6:1:7:279936
+6:1:8:1679616
+6:1:9:10077696
+6:2:0:1
+6:2:1:6
+6:2:2:46656
+6:3:0:1
+6:3:1:6
+6:4:0:1
+6:4:1:6
+6:5:0:1
+6:5:1:6
+6:6:0:1
+6:6:1:6
+6:7:0:1
+6:7:1:6
+6:8:0:1
+6:8:1:6
+6:9:0:1
+6:9:1:6
+7:0:0:0
+7:0:1:7
+7:0:2:14
+7:0:3:21
+7:0:4:28
+7:0:5:35
+7:0:6:42
+7:0:7:49
+7:0:8:56
+7:0:9:63
+7:1:0:1
+7:1:1:7
+7:1:2:49
+7:1:3:343
+7:1:4:2401
+7:1:5:16807
+7:1:6:117649
+7:1:7:823543
+7:1:8:5764801
+7:1:9:40353607
+7:2:0:1
+7:2:1:7
+7:2:2:823543
+7:3:0:1
+7:3:1:7
+7:4:0:1
+7:4:1:7
+7:5:0:1
+7:5:1:7
+7:6:0:1
+7:6:1:7
+7:7:0:1
+7:7:1:7
+7:8:0:1
+7:8:1:7
+7:9:0:1
+7:9:1:7
+8:0:0:0
+8:0:1:8
+8:0:2:16
+8:0:3:24
+8:0:4:32
+8:0:5:40
+8:0:6:48
+8:0:7:56
+8:0:8:64
+8:0:9:72
+8:1:0:1
+8:1:1:8
+8:1:2:64
+8:1:3:512
+8:1:4:4096
+8:1:5:32768
+8:1:6:262144
+8:1:7:2097152
+8:1:8:16777216
+8:1:9:134217728
+8:2:0:1
+8:2:1:8
+8:2:2:16777216
+8:3:0:1
+8:3:1:8
+8:4:0:1
+8:4:1:8
+8:5:0:1
+8:5:1:8
+8:6:0:1
+8:6:1:8
+8:7:0:1
+8:7:1:8
+8:8:0:1
+8:8:1:8
+8:9:0:1
+8:9:1:8
+9:0:0:0
+9:0:1:9
+9:0:2:18
+9:0:3:27
+9:0:4:36
+9:0:5:45
+9:0:6:54
+9:0:7:63
+9:0:8:72
+9:0:9:81
+9:1:0:1
+9:1:1:9
+9:1:2:81
+9:1:3:729
+9:1:4:6561
+9:1:5:59049
+9:1:6:531441
+9:1:7:4782969
+9:1:8:43046721
+9:1:9:387420489
+9:2:0:1
+9:2:1:9
+9:2:2:387420489
+9:3:0:1
+9:3:1:9
+9:4:0:1
+9:4:1:9
+9:5:0:1
+9:5:1:9
+9:6:0:1
+9:6:1:9
+9:7:0:1
+9:7:1:9
+9:8:0:1
+9:8:1:9
+9:9:0:1
+9:9:1:9
index 1bc0f6a..27ada2e 100644 (file)
@@ -5,7 +5,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 148;
+use Test::More tests => 164;
 
 ##############################################################################
 
@@ -76,6 +76,12 @@ __END__
 &is_negative
 1:0
 -1:1
+&is_non_positive
+1:0
+-1:1
+&is_non_negative
+1:1
+-1:0
 &is_nan
 abc:1
 1:0
index 8b0945e..30421da 100644 (file)
@@ -5,7 +5,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 140;
+use Test::More tests => 156;
 
 ##############################################################################
 
@@ -76,6 +76,12 @@ __END__
 &is_negative
 1:0
 -1:1
+&is_non_positive
+1:0
+-1:1
+&is_non_negative
+1:1
+-1:0
 &is_nan
 abc:1
 1:0
index be72db4..4b2690b 100644 (file)
@@ -6,7 +6,7 @@ use strict;
 use warnings;
 use lib 't';
 
-my $VERSION = '1.999816';       # adjust manually to match latest release
+my $VERSION = '1.999817';       # adjust manually to match latest release
 
 use Test::More tests => 5;
 
diff --git a/cpan/Math-BigInt/t/from_ieee754-mbf.t b/cpan/Math-BigInt/t/from_ieee754-mbf.t
new file mode 100644 (file)
index 0000000..99dd6e1
--- /dev/null
@@ -0,0 +1,257 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 230;
+
+use Math::BigFloat;
+
+my @k = (16, 32, 64, 128);
+
+sub stringify {
+    my $x = shift;
+    return "$x" unless $x -> is_finite();
+    my $nstr = $x -> bnstr();
+    my $sstr = $x -> bsstr();
+    return length($nstr) < length($sstr) ? $nstr : $sstr;
+}
+
+for my $k (@k) {
+
+    # Parameters specific to this format:
+
+    my $b = 2;
+    my $p = $k == 16 ? 11
+          : $k == 32 ? 24
+          : $k == 64 ? 53
+          : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13;
+
+    $b = Math::BigFloat -> new($b);
+    $k = Math::BigFloat -> new($k);
+    $p = Math::BigFloat -> new($p);
+    my $w = $k - $p;
+
+    my $emax = 2 ** ($w - 1) - 1;
+    my $emin = 1 - $emax;
+
+    my $format = sprintf 'binary%u', $k;
+
+    my $binv = Math::BigFloat -> new("0.5");
+
+    my $data =
+      [
+
+       {
+        dsc => "smallest positive subnormal number",
+        bin => "0"
+             . ("0" x $w)
+             . ("0" x ($p - 2)) . "1",
+        asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") "
+             . "= $b ** (" . ($emin + 1 - $p) . ")",
+        mbf => $binv ** ($p - 1 - $emin),
+       },
+
+       {
+        dsc => "largest subnormal number",
+        bin => "0"
+             . ("0" x $w)
+             . ("1" x ($p - 1)),
+        asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))",
+        mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)),
+       },
+
+       {
+        dsc => "smallest positive normal number",
+        bin => "0"
+             . ("0" x ($w - 1)) . "1"
+             . ("0" x ($p - 1)),
+        asc => "$b ** ($emin)",
+        mbf => $binv ** (-$emin),
+       },
+
+       {
+        dsc => "largest normal number",
+        bin => "0"
+             . ("1" x ($w - 1)) . "0"
+             . "1" x ($p - 1),
+        asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))",
+        mbf => $b ** $emax * ($b - $binv ** ($p - 1)),
+       },
+
+       {
+        dsc => "largest number less than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 2)) . "0"
+             . "1" x ($p - 1),
+        asc => "1 - $b ** (-$p)",
+        mbf => 1 - $binv ** $p,
+       },
+
+       {
+        dsc => "smallest number larger than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . ("0" x ($p - 2)) . "1",
+        asc => "1 + $b ** (" . (1 - $p) . ")",
+        mbf => 1 + $binv ** ($p - 1),
+       },
+
+       {
+        dsc => "second smallest number larger than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . ("0" x ($p - 3)) . "10",
+        asc => "1 + $b ** (" . (2 - $p) . ")",
+        mbf => 1 + $binv ** ($p - 2),
+       },
+
+       {
+        dsc => "one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . "0" x ($p - 1),
+        asc => "1",
+        mbf => Math::BigFloat -> new("1"),
+       },
+
+       {
+        dsc => "minus one",
+        bin => "1"
+             . "0" . ("1" x ($w - 1))
+             . "0" x ($p - 1),
+        asc => "-1",
+        mbf => Math::BigFloat -> new("-1"),
+       },
+
+       {
+        dsc => "two",
+        bin => "0"
+             . "1" . ("0" x ($w - 1))
+             . ("0" x ($p - 1)),
+        asc => "2",
+        mbf => Math::BigFloat -> new("2"),
+       },
+
+       {
+        dsc => "minus two",
+        bin => "1"
+             . "1" . ("0" x ($w - 1))
+             . ("0" x ($p - 1)),
+        asc => "-2",
+        mbf => Math::BigFloat -> new("-2"),
+       },
+
+       {
+        dsc => "positive zero",
+        bin => "0"
+             . ("0" x $w)
+             . ("0" x ($p - 1)),
+        asc => "+0",
+        mbf => Math::BigFloat -> new("0"),
+       },
+
+       {
+        dsc => "negative zero",
+        bin => "1"
+             . ("0" x $w)
+             . ("0" x ($p - 1)),
+        asc => "-0",
+        mbf => Math::BigFloat -> new("0"),
+       },
+
+       {
+        dsc => "positive infinity",
+        bin => "0"
+             . ("1" x $w)
+             . ("0" x ($p - 1)),
+        asc => "+inf",
+        mbf => Math::BigFloat -> new("inf"),
+       },
+
+       {
+        dsc => "negative infinity",
+        bin =>  "1"
+             . ("1" x $w)
+             . ("0" x ($p - 1)),
+        asc => "-inf",
+        mbf => Math::BigFloat -> new("-inf"),
+       },
+
+       {
+        dsc => "NaN (sNaN on most processors, such as x86 and ARM)",
+        bin => "0"
+             . ("1" x $w)
+             . ("0" x ($p - 2)) . "1",
+        asc => "sNaN",
+        mbf => Math::BigFloat -> new("NaN"),
+       },
+
+       {
+        dsc => "NaN (qNaN on most processors, such as x86 and ARM)",
+        bin => "0"
+             . ("1" x $w)
+             . "1" . ("0" x ($p - 3)) . "1",
+        asc => "qNaN",
+        mbf => Math::BigFloat -> new("NaN"),
+       },
+
+       {
+        dsc => "NaN (an alternative encoding)",
+        bin => "0"
+             . ("1" x $w)
+             . ("1" x ($p - 1)),
+        asc => "NaN",
+        mbf => Math::BigFloat -> new("NaN"),
+       },
+
+       {
+        dsc => "NaN (encoding used by Perl on Cygwin)",
+        bin => "1"
+             . ("1" x $w)
+             . ("1" . ("0" x ($p - 2))),
+        asc => "NaN",
+        mbf => Math::BigFloat -> new("NaN"),
+       },
+
+      ];
+
+    for my $entry (@$data) {
+        my $bin   = $entry -> {bin};
+        my $bytes = pack "B*", $bin;
+        my $hex   = unpack "H*", $bytes;
+
+        note("\n", $entry -> {dsc }, " (k = $k)\n\n");
+
+        my $expected = stringify($entry -> {mbf});
+        my ($got, $test);
+
+        $got = Math::BigFloat -> from_ieee754($bin, $format);
+        $got = stringify($got);
+        $test = qq|Math::BigFloat->from_ieee754("$bin")|;
+        is($got, $expected, $test);
+
+        $got = Math::BigFloat -> from_ieee754($hex, $format);
+        $got = stringify($got);
+        $test = qq|Math::BigFloat->from_ieee754("$hex")|;
+        is($got, $expected, $test);
+
+        $got = Math::BigFloat -> from_ieee754($bytes, $format);
+        $got = stringify($got);
+        (my $str = $hex) =~ s/(..)/\\x$1/g;
+        $test = qq|Math::BigFloat->from_ieee754("$str")|;
+        is($got, $expected, $test);
+    }
+}
+
+note("\nTest as class method vs. instance method.\n\n");
+
+# As class method.
+
+my $x = Math::BigFloat -> from_ieee754("4000000000000000", "binary64");
+is($x, 2, "class method");
+
+# As instance method, the invocand should be modified.
+
+$x -> from_ieee754("4008000000000000", "binary64");
+is($x, 3, "instance method modifies invocand");
index d1edfd4..547a69c 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 50;
+use Test::More tests => 69;
 
 my $class;
 
@@ -81,6 +81,43 @@ infinity:inf
 #-inf:NaN
 0x.p+0:NaN
 
+# This is more or less the same data as in from_oct-mbf.t, except that some of
+# them are commented out, since new() only treats input as octal if it has a
+# "0" prefix and a binary exponent, and possibly a leading "+" or "-" sign.
+# Duplicates from above are also commented out.
+
+01p+0:1
+00.4p+1:1
+00.2p+2:1
+00.1p+3:1
+00.04p+4:1
+02p-1:1
+04p-2:1
+010p-3:1
+
+-01p+0:-1
+
+00p+0:0
+00p+7:0
+00p-7:0
+00.p+0:0
+00.0p+0:0
+#00.0p+0:0
+
+#145376:51966
+#0145376:51966
+#00145376:51966
+
+03.1p+2:12.5
+022.15p-1:9.1015625
+-00.361152746757p+32:-2023406814.9375
+044.3212636115p+30:39093746765
+
+#NaN:NaN
+#+inf:NaN
+#-inf:NaN
+0.p+0:NaN
+
 # This is the same data as in from_bin-mbf.t, except that some of them are
 # commented out, since new() only treats input as binary if it has a "0b" or
 # "0B" prefix, possibly with a leading "+" or "-" sign. Duplicates from above
index 584ea67..2f5d3fc 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2818            # tests in require'd file
+use Test::More tests => 2830            # tests in require'd file
                          + 6;           # tests in this file
 
 use lib 't';
index 3ee6953..97bcdee 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4026            # tests in require'd file
+use Test::More tests => 4038            # tests in require'd file
                          + 5;           # tests in this file
 
 use lib 't';
diff --git a/cpan/Math-BigInt/t/to_ieee754-mbf.t b/cpan/Math-BigInt/t/to_ieee754-mbf.t
new file mode 100644 (file)
index 0000000..047d848
--- /dev/null
@@ -0,0 +1,206 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 60;
+
+use Math::BigFloat;
+
+my @k = (16, 32, 64, 128);
+
+sub stringify {
+    my $x = shift;
+    return "$x" unless $x -> is_finite();
+    my $nstr = $x -> bnstr();
+    my $sstr = $x -> bsstr();
+    return length($nstr) < length($sstr) ? $nstr : $sstr;
+}
+
+for my $k (@k) {
+
+    # Parameters specific to this format:
+
+    my $b = 2;
+    my $p = $k == 16 ? 11
+          : $k == 32 ? 24
+          : $k == 64 ? 53
+          : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13;
+
+    $b = Math::BigFloat -> new($b);
+    $k = Math::BigFloat -> new($k);
+    $p = Math::BigFloat -> new($p);
+    my $w = $k - $p;
+
+    my $emax = 2 ** ($w - 1) - 1;
+    my $emin = 1 - $emax;
+
+    my $format = 'binary' . $k;
+
+    note("\nComputing test data for k = $k ...\n\n");
+
+    my $binv = Math::BigFloat -> new("0.5");
+
+    my $data =
+      [
+
+       {
+        dsc => "smallest positive subnormal number",
+        bin => "0"
+             . ("0" x $w)
+             . ("0" x ($p - 2)) . "1",
+        asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") "
+             . "= $b ** (" . ($emin + 1 - $p) . ")",
+        mbf => $binv ** ($p - 1 - $emin),
+       },
+
+       {
+        dsc => "largest subnormal number",
+        bin => "0"
+             . ("0" x $w)
+             . ("1" x ($p - 1)),
+        asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))",
+        mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)),
+       },
+
+       {
+        dsc => "smallest positive normal number",
+        bin => "0"
+             . ("0" x ($w - 1)) . "1"
+             . ("0" x ($p - 1)),
+        asc => "$b ** ($emin)",
+        mbf => $binv ** (-$emin),
+       },
+
+       {
+        dsc => "largest normal number",
+        bin => "0"
+             . ("1" x ($w - 1)) . "0"
+             . "1" x ($p - 1),
+        asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))",
+        mbf => $b ** $emax * ($b - $binv ** ($p - 1)),
+       },
+
+       {
+        dsc => "largest number less than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 2)) . "0"
+             . "1" x ($p - 1),
+        asc => "1 - $b ** (-$p)",
+        mbf => 1 - $binv ** $p,
+       },
+
+       {
+        dsc => "smallest number larger than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . ("0" x ($p - 2)) . "1",
+        asc => "1 + $b ** (" . (1 - $p) . ")",
+        mbf => 1 + $binv ** ($p - 1),
+       },
+
+       {
+        dsc => "second smallest number larger than one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . ("0" x ($p - 3)) . "10",
+        asc => "1 + $b ** (" . (2 - $p) . ")",
+        mbf => 1 + $binv ** ($p - 2),
+       },
+
+       {
+        dsc => "one",
+        bin => "0"
+             . "0" . ("1" x ($w - 1))
+             . "0" x ($p - 1),
+        asc => "1",
+        mbf => Math::BigFloat -> new("1"),
+       },
+
+       {
+        dsc => "minus one",
+        bin => "1"
+             . "0" . ("1" x ($w - 1))
+             . "0" x ($p - 1),
+        asc => "-1",
+        mbf => Math::BigFloat -> new("-1"),
+       },
+
+       {
+        dsc => "two",
+        bin => "0"
+             . "1" . ("0" x ($w - 1))
+             . ("0" x ($p - 1)),
+        asc => "2",
+        mbf => Math::BigFloat -> new("2"),
+       },
+
+       {
+        dsc => "minus two",
+        bin => "1"
+             . "1" . ("0" x ($w - 1))
+             . ("0" x ($p - 1)),
+        asc => "-2",
+        mbf => Math::BigFloat -> new("-2"),
+       },
+
+       {
+        dsc => "positive zero",
+        bin => "0"
+             . ("0" x $w)
+             . ("0" x ($p - 1)),
+        asc => "+0",
+        mbf => Math::BigFloat -> new("0"),
+       },
+
+       {
+        dsc => "positive infinity",
+        bin => "0"
+             . ("1" x $w)
+             . ("0" x ($p - 1)),
+        asc => "+inf",
+        mbf => Math::BigFloat -> new("inf"),
+       },
+
+       {
+        dsc => "negative infinity",
+        bin =>  "1"
+             . ("1" x $w)
+             . ("0" x ($p - 1)),
+        asc => "-inf",
+        mbf => Math::BigFloat -> new("-inf"),
+       },
+
+       {
+        dsc => "NaN (encoding used by Perl on Cygwin)",
+        bin => "1"
+             . ("1" x $w)
+             . ("1" . ("0" x ($p - 2))),
+        asc => "NaN",
+        mbf => Math::BigFloat -> new("NaN"),
+       },
+
+      ];
+
+    for my $entry (@$data) {
+        my $bin   = $entry -> {bin};
+        my $bytes = pack "B*", $bin;
+        my $hex   = unpack "H*", $bytes;
+
+        note("\n", $entry -> {dsc}, " (k = $k)\n\n");
+
+        my $x = Math::BigFloat -> new($entry -> {mbf});
+
+        my $test = qq|Math::BigFloat -> new("| . stringify($x)
+                 . qq|") -> to_ieee754("$format")|;
+
+        my $got_bytes = $x -> to_ieee754($format);
+        my $got_hex = unpack "H*", $got_bytes;
+        $got_hex =~ s/(..)/\\x$1/g;
+
+        my $expected_hex = $hex;
+        $expected_hex =~ s/(..)/\\x$1/g;
+
+        is($got_hex, $expected_hex);
+    }
+}
index 9cdba4e..d58376f 100644 (file)
@@ -80,7 +80,7 @@ while (<DATA>) {
     $try = qq|\$x = $CLASS->new("$args[0]");|;
     if ($f eq "bnorm") {
         $try = qq|\$x = $CLASS->bnorm("$args[0]");|;
-    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
+    } elsif ($f =~ /^is_(zero|one|odd|even||(non_)?(negative|positive)|nan|int)$/) {
         $try .= " \$x->$f();";
     } elsif ($f =~ /^(to|as)_(hex|oct|bin)$/) {
         $try .= " \$x->$f();";
@@ -304,6 +304,22 @@ NaNneg:0
 -inf:0
 NaNneg:0
 
+&is_non_negative
+0:1
+-1:0
+1:1
++inf:1
+-inf:0
+NaN:0
+
+&is_non_positive
+0:1
+-1:1
+1:0
++inf:0
+-inf:1
+NaN:0
+
 &is_odd
 abc:0
 0:0
index b373ceb..552c8ae 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2196            # tests in require'd file
+use Test::More tests => 2208            # tests in require'd file
                          + 2;           # tests in this file
 
 use Math::BigInt upgrade => 'Math::BigFloat';
index ca78927..0ce15d1 100644 (file)
@@ -5,7 +5,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2818            # tests in require'd file
+use Test::More tests => 2830            # tests in require'd file
                          + 1;           # tests in this file
 
 use Math::BigFloat with => 'Math::BigInt::Subclass',