In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ef07b9e56353ef13f6b999d0ebae0466282a9fcc?hp=3a6ace9d060d0113acf0d931ae5d1f0fe0b46260>
- Log ----------------------------------------------------------------- commit ef07b9e56353ef13f6b999d0ebae0466282a9fcc Author: Steve Hay <[email protected]> Date: Mon Jul 18 08:38:24 2016 +0100 Upgrade Math-BigInt from version 1.999724 to 1.999726 ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Math-BigInt/lib/Math/BigFloat.pm | 327 ++++++------------ cpan/Math-BigInt/lib/Math/BigInt.pm | 104 +++--- cpan/Math-BigInt/lib/Math/BigInt/Calc.pm | 444 ++++++++++++------------- cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm | 8 +- cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm | 37 +++ cpan/Math-BigInt/t/big_pi_e.t | 16 +- cpan/Math-BigInt/t/calling.t | 2 +- 9 files changed, 430 insertions(+), 511 deletions(-) create mode 100644 cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm diff --git a/MANIFEST b/MANIFEST index 64d61b3..a97d900 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1706,6 +1706,7 @@ cpan/Math-BigInt/t/isa.t Test for Math::BigInt inheritance cpan/Math-BigInt/t/lib_load.t Test sane lib names cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm Bigint's simulation of Calc +cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm Test Math::BigInt cpan/Math-BigInt/t/Math/BigInt/Scalar.pm Pure Perl module to support Math::BigInt cpan/Math-BigInt/t/Math/BigInt/Subclass.pm Empty subclass of BigInt for test cpan/Math-BigInt/t/mbf_ali.t Tests for BigFloat diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index ab21522..38e6eca 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -713,7 +713,7 @@ use File::Glob qw(:case); }, 'Math::BigInt' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999724.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999726.tar.gz', 'FILES' => q[cpan/Math-BigInt], 'EXCLUDED' => [ qr{^inc/}, diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 45c32c9..dd625bd 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -19,7 +19,7 @@ use warnings; use Carp (); use Math::BigInt (); -our $VERSION = '1.999724'; +our $VERSION = '1.999726'; $VERSION = eval $VERSION; require Exporter; @@ -272,8 +272,6 @@ sub DESTROY { } sub AUTOLOAD { - # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx() - # or falling back to MBI::bxxx() my $name = $AUTOLOAD; $name =~ s/(.*):://; # split package @@ -767,8 +765,8 @@ sub bzero { # create/assign '+0' if (@_ == 0) { - Carp::carp("Using bone() as a function is deprecated;", - " use bone() as a method instead"); + #Carp::carp("Using bone() as a function is deprecated;", + # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -806,8 +804,8 @@ sub bone { # Create or assign '+1' (or -1 if given sign '-'). if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - Carp::carp("Using bone() as a function is deprecated;", - " use bone() as a method instead"); + #Carp::carp("Using bone() as a function is deprecated;", + # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -850,8 +848,8 @@ sub binf { if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) { - Carp::carp("Using binf() as a function is deprecated;", - " use binf() as a method instead"); + #Carp::carp("Using binf() as a function is deprecated;", + # " use binf() as a method instead"); unshift @_, __PACKAGE__; } @@ -886,8 +884,8 @@ sub bnan { # create/assign a 'NaN' if (@_ == 0) { - Carp::carp("Using bnan() as a function is deprecated;", - " use bnan() as a method instead"); + #Carp::carp("Using bnan() as a function is deprecated;", + # " use bnan() as a method instead"); unshift @_, __PACKAGE__; } @@ -939,9 +937,7 @@ sub bpi { my $selfref = ref $self; my $class = $selfref || $self; - my $accu; # accuracy (number of digits) - my $prec; # precision - my $rndm; # round mode + my @r; # rounding paramters # If bpi() is called as a function ... # @@ -955,103 +951,107 @@ sub bpi { || !defined($self)) { - $accu = $self; + $r[0] = $self; $class = __PACKAGE__; - $self = $class -> bzero(); # initialize + $self = $class -> bzero(@r); # initialize } # ... or if bpi() is called as a method ... else { - if ($selfref) { # bpi() called as instance method + @r = @_; + if ($selfref) { # bpi() called as instance method return $self if $self -> modify('bpi'); - } else { # bpi() called as class method - $self = $class -> bzero(); # initialize + } else { # bpi() called as class method + $self = $class -> bzero(@r); # initialize } - $accu = shift; - $prec = shift; - $rndm = shift; } - my @r = ($accu, $prec, $rndm); + ($self, @r) = $self -> _find_round_parameters(@r); - # We need to limit the accuracy to protect against overflow. - my $fallback = 0; - my ($scale, @params); - ($self, @params) = $self -> _find_round_parameters(@r); + # The accuracy, i.e., the number of digits. Pi has one digit before the + # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits. - # Error in _find_round_parameters? - # - # We can't return here, because that will fail if $self was a NaN when - # bpi() was invoked, and we want to assign pi to $x. It is probably not a - # good idea that _find_round_parameters() signals invalid round parameters - # by silently returning a NaN. Fixme! - #return $self if $self && $self->is_nan(); + my $n = defined $r[0] ? $r[0] + : defined $r[1] ? 1 - $r[1] + : $self -> div_scale(); - # No rounding at all, so must use fallback. - if (scalar @params == 0) { - # Simulate old behaviour - $params[0] = $self -> div_scale(); # and round to it as accuracy - $params[1] = undef; # disable P - $params[2] = $r[2]; # round mode by caller or undef - $fallback = 1; # to clear a/p afterwards - } + my $rmode = defined $r[2] ? $r[2] : $self -> round_mode(); - # The accuracy, i.e., the number of digits. Pi has one digit before the - # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits. + my $pi; - my $n = $params[0] || 1 - $params[1]; + if ($n <= 1000) { - if ($n < 1000) { + # 75 x 14 = 1050 digits - # after é»è¦å© (Hwang Chien-Lih) (1997) - # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) â 68 * atan(1/5832) - # + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318) + my $all_digits = <<EOF; +314159265358979323846264338327950288419716939937510582097494459230781640628 +620899862803482534211706798214808651328230664709384460955058223172535940812 +848111745028410270193852110555964462294895493038196442881097566593344612847 +564823378678316527120190914564856692346034861045432664821339360726024914127 +372458700660631558817488152092096282925409171536436789259036001133053054882 +046652138414695194151160943305727036575959195309218611738193261179310511854 +807446237996274956735188575272489122793818301194912983367336244065664308602 +139494639522473719070217986094370277053921717629317675238467481846766940513 +200056812714526356082778577134275778960917363717872146844090122495343014654 +958537105079227968925892354201995611212902196086403441815981362977477130996 +051870721134999999837297804995105973173281609631859502445945534690830264252 +230825334468503526193118817101000313783875288658753320838142061717766914730 +359825349042875546873115956286388235378759375195778185778053217122680661300 +192787661119590921642019893809525720106548586327886593615338182796823030195 +EOF - # Use a few more digits in the intermediate computations. + # Should we round up? + + my $round_up; + + # From the string above, we need to extract the number of digits we + # want plus extra characters for the newlines. + + my $nchrs = $n + int($n / 75); + + # Extract the digits we want. + + my $digits = substr($all_digits, 0, $nchrs); + + # Find out whether we should round up or down. Since pi is a + # transcendental number, we only have to look at one digit after the + # last digit we want. + + if ($rmode eq '+inf') { + $round_up = 1; + } elsif ($rmode eq 'trunc' || $rmode eq 'zero' || $rmode eq '-inf') { + $round_up = 0; + } else { + my $next_digit = substr($all_digits, $nchrs, 1); + $round_up = $next_digit lt '5' ? 0 : 1; + } + + # Remove the newlines. + + $digits =~ tr/0-9//cd; + + # Now do the rounding. We could easily make the regex substitution + # handle all cases, but we avoid using the regex engine when it is + # simple to avoid it. - my $nextra = $n < 800 ? 4 : 5; - $n += $nextra; - - my ($a, $b) = $class->_atan_inv($MBI->_new(239), $n); - my ($c, $d) = $class->_atan_inv($MBI->_new(1023), $n); - my ($e, $f) = $class->_atan_inv($MBI->_new(5832), $n); - my ($g, $h) = $class->_atan_inv($MBI->_new(110443), $n); - my ($i, $j) = $class->_atan_inv($MBI->_new(4841182), $n); - my ($k, $l) = $class->_atan_inv($MBI->_new(6826318), $n); - - $MBI->_mul($a, $MBI->_new(732)); - $MBI->_mul($c, $MBI->_new(128)); - $MBI->_mul($e, $MBI->_new(272)); - $MBI->_mul($g, $MBI->_new(48)); - $MBI->_mul($i, $MBI->_new(48)); - $MBI->_mul($k, $MBI->_new(400)); - - my $x = $class->bone(); $x->{_m} = $a; my $x_d = $class->bone(); $x_d->{_m} = $b; - my $y = $class->bone(); $y->{_m} = $c; my $y_d = $class->bone(); $y_d->{_m} = $d; - my $z = $class->bone(); $z->{_m} = $e; my $z_d = $class->bone(); $z_d->{_m} = $f; - my $u = $class->bone(); $u->{_m} = $g; my $u_d = $class->bone(); $u_d->{_m} = $h; - my $v = $class->bone(); $v->{_m} = $i; my $v_d = $class->bone(); $v_d->{_m} = $j; - my $w = $class->bone(); $w->{_m} = $k; my $w_d = $class->bone(); $w_d->{_m} = $l; - $x->bdiv($x_d, $n); - $y->bdiv($y_d, $n); - $z->bdiv($z_d, $n); - $u->bdiv($u_d, $n); - $v->bdiv($v_d, $n); - $w->bdiv($w_d, $n); - - delete $x->{_a}; delete $y->{_a}; delete $z->{_a}; - delete $u->{_a}; delete $v->{_a}; delete $w->{_a}; - $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w); - - for my $key (qw/ sign _m _es _e _a _p /) { - $self -> {$key} = $x -> {$key} if exists $x -> {$key}; + if ($round_up) { + my $last_digit = substr($digits, -1, 1); + if ($last_digit lt '9') { + substr($digits, -1, 1) = ++$last_digit; + } else { + $digits =~ s/([0-8])(9+)$/ ($1 + 1) . ("0" x CORE::length($2)) /e; + } } + # Append the exponent and convert to an object. + + $pi = Math::BigFloat -> new($digits . 'e-' . ($n - 1)); + } else { # For large accuracy, the arctan formulas become very inefficient with - # Math::BigFloat. Switch to Brent-Salamin (aka AGM or Gauss-Legendre). + # Math::BigFloat, so use Brent-Salamin (aka AGM or Gauss-Legendre). # Use a few more digits in the intermediate computations. my $nextra = 8; @@ -1070,16 +1070,18 @@ sub bpi { $an -> badd($bn); $an -> bmul($an, $n) -> bdiv(4 * $tn, $n); - for my $key (qw/ sign _m _es _e _a _p /) { - $self -> {$key} = $an -> {$key} if exists $an -> {$key};; - } + $an -> round(@r); + $pi = $an; } - $self -> round(@params); + if (defined $r[0]) { + $pi -> accuracy($r[0]); + } elsif (defined $r[1]) { + $pi -> precision($r[1]); + } - if ($fallback) { - delete $self->{_a}; - delete $self->{_p}; + for my $key (qw/ sign _m _es _e _a _p /) { + $self -> {$key} = $pi -> {$key}; } return $self; @@ -2892,14 +2894,14 @@ sub batan2 { } else { # -inf < y < inf $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x) } - } elsif ($x < 0) { # -inf < x < 0 + } elsif ($x < 0) { # -inf < x < 0 my $pi = $class -> bpi($scale); if ($y >= 0) { # y >= 0 $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi - -> badd($pi); + -> badd($pi); } else { # y < 0 $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi - -> bsub($pi); + -> bsub($pi); } } else { # x = 0 if ($y > 0) { # y > 0 @@ -4505,7 +4507,7 @@ sub _pow { # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; -delete $x->{_p}; + delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; @@ -4562,135 +4564,6 @@ delete $x->{_p}; $x; } -# helper function for bpi() and batan2(), calculates arcus tanges (1/x) - -sub _atan_inv { - # return a/b so that a/b approximates atan(1/x) to at least limit digits - my ($class, $x, $limit) = @_; - - # Taylor: x^3 x^5 x^7 x^9 - # atan = x - --- + --- - --- + --- - ... - # 3 5 7 9 - - # 1 1 1 1 - # atan 1/x = - - ------- + ------- - ------- + ... - # x x^3 * 3 x^5 * 5 x^7 * 7 - - # 1 1 1 1 - # atan 1/x = - - --------- + ---------- - ----------- + ... - # 5 3 * 125 5 * 3125 7 * 78125 - - # Subtraction/addition of a rational: - - # 5 7 5*3 +- 7*4 - # - +- - = ---------- - # 4 3 4*3 - - # Term: N N+1 - # - # a 1 a * d * c +- b - # ----- +- ------------------ = ---------------- - # b d * c b * d * c - - # since b1 = b0 * (d-2) * c - - # a 1 a * d +- b / c - # ----- +- ------------------ = ---------------- - # b d * c b * d - - # and d = d + 2 - # and c = c * x * x - - # u = d * c - # stop if length($u) > limit - # a = a * u +- b - # b = b * u - # d = d + 2 - # c = c * x * x - # sign = 1 - sign - - my $a = $MBI->_one(); - my $b = $MBI->_copy($x); - - my $x2 = $MBI->_mul($MBI->_copy($x), $b); # x2 = x * x - my $d = $MBI->_new(3); # d = 3 - my $c = $MBI->_mul($MBI->_copy($x), $x2); # c = x ^ 3 - my $two = $MBI->_new(2); - - # run the first step unconditionally - my $u = $MBI->_mul($MBI->_copy($d), $c); - $a = $MBI->_mul($a, $u); - $a = $MBI->_sub($a, $b); - $b = $MBI->_mul($b, $u); - $d = $MBI->_add($d, $two); - $c = $MBI->_mul($c, $x2); - - # a is now a * (d-3) * c - # b is now b * (d-2) * c - - # run the second step unconditionally - $u = $MBI->_mul($MBI->_copy($d), $c); - $a = $MBI->_mul($a, $u); - $a = $MBI->_add($a, $b); - $b = $MBI->_mul($b, $u); - $d = $MBI->_add($d, $two); - $c = $MBI->_mul($c, $x2); - - # a is now a * (d-3) * (d-5) * c * c - # b is now b * (d-2) * (d-4) * c * c - - # so we can remove c * c from both a and b to shorten the numbers involved: - $a = $MBI->_div($a, $x2); - $b = $MBI->_div($b, $x2); - $a = $MBI->_div($a, $x2); - $b = $MBI->_div($b, $x2); - - # my $step = 0; - my $sign = 0; # 0 => -, 1 => + - while (3 < 5) { - # $step++; - # if (($i++ % 100) == 0) - # { - # print "a=", $MBI->_str($a), "\n"; - # print "b=", $MBI->_str($b), "\n"; - # } - # print "d=", $MBI->_str($d), "\n"; - # print "x2=", $MBI->_str($x2), "\n"; - # print "c=", $MBI->_str($c), "\n"; - - my $u = $MBI->_mul($MBI->_copy($d), $c); - # use _alen() for libs like GMP where _len() would be O(N^2) - last if $MBI->_alen($u) > $limit; - my ($bc, $r) = $MBI->_div($MBI->_copy($b), $c); - if ($MBI->_is_zero($r)) { - # b / c is an integer, so we can remove c from all terms - # this happens almost every time: - $a = $MBI->_mul($a, $d); - $a = $MBI->_sub($a, $bc) if $sign == 0; - $a = $MBI->_add($a, $bc) if $sign == 1; - $b = $MBI->_mul($b, $d); - } else { - # b / c is not an integer, so we keep c in the terms - # this happens very rarely, for instance for x = 5, this happens only - # at the following steps: - # 1, 5, 14, 32, 72, 157, 340, ... - $a = $MBI->_mul($a, $u); - $a = $MBI->_sub($a, $b) if $sign == 0; - $a = $MBI->_add($a, $b) if $sign == 1; - $b = $MBI->_mul($b, $u); - } - $d = $MBI->_add($d, $two); - $c = $MBI->_mul($c, $x2); - $sign = 1 - $sign; - - } - - # print "Took $step steps for ", $MBI->_str($x), "\n"; - # print "a=", $MBI->_str($a), "\n"; print "b=", $MBI->_str($b), "\n"; - # return a/b so that a/b approximates atan(1/x) - ($a, $b); -} - 1; __END__ diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 72fb3d7..d0d6b74 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -20,7 +20,7 @@ use warnings; use Carp (); -our $VERSION = '1.999724'; +our $VERSION = '1.999726'; $VERSION = eval $VERSION; our @ISA = qw(Exporter); @@ -870,8 +870,8 @@ sub bzero { # create/assign '+0' if (@_ == 0) { - Carp::carp("Using bzero() as a function is deprecated;", - " use bzero() as a method instead"); + #Carp::carp("Using bzero() as a function is deprecated;", + # " use bzero() as a method instead"); unshift @_, __PACKAGE__; } @@ -907,8 +907,8 @@ sub bone { # Create or assign '+1' (or -1 if given sign '-'). if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - Carp::carp("Using bone() as a function is deprecated;", - " use bone() as a method instead"); + #Carp::carp("Using bone() as a function is deprecated;", + # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -949,8 +949,8 @@ sub binf { if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) { - Carp::carp("Using binf() as a function is deprecated;", - " use binf() as a method instead"); + #Carp::carp("Using binf() as a function is deprecated;", + # " use binf() as a method instead"); unshift @_, __PACKAGE__; } @@ -983,8 +983,8 @@ sub bnan { # create/assign a 'NaN' if (@_ == 0) { - Carp::carp("Using bnan() as a function is deprecated;", - " use bnan() as a method instead"); + #Carp::carp("Using bnan() as a function is deprecated;", + # " use bnan() as a method instead"); unshift @_, __PACKAGE__; } @@ -1075,6 +1075,11 @@ sub is_one { $CALC->_is_one($x->{value}); } +sub is_finite { + my $x = shift; + return $x->{sign} eq '+' || $x->{sign} eq '-'; +} + sub is_inf { # return true if arg (BINT or num_str) is +-inf my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); @@ -1144,12 +1149,9 @@ sub bcmp { # (BINT or num_str, BINT or num_str) return cond_code # set up parameters - my ($class, $x, $y) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y) = objectify(2, @_); - } + my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $upgrade->bcmp($x, $y) if defined $upgrade && ((!$x->isa($class)) || (!$y->isa($class))); @@ -1187,11 +1189,9 @@ sub bacmp { # (BINT, BINT) return cond_code # set up parameters - my ($class, $x, $y) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y) = objectify(2, @_); - } + my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $upgrade->bacmp($x, $y) if defined $upgrade && ((!$x->isa($class)) || (!$y->isa($class))); @@ -2443,9 +2443,7 @@ sub bnok { # k > n or k < 0 => 0 my $cmp = $x->bacmp($y); - return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/; - # k == n => 1 - return $x->bone(@r) if $cmp == 0; + return $x->bzero() if $cmp < 0 || substr($y->{sign}, 0, 1) eq "-"; if ($CALC->can('_nok')) { $x->{value} = $CALC->_nok($x->{value}, $y->{value}); @@ -2454,24 +2452,49 @@ sub bnok { # ( - ) = --------- = --------------- = --------- = 5 * - * - # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 - if (!$y->is_zero()) { - my $z = $x - $y; - $z->binc(); - my $r = $z->copy(); - $z->binc(); - my $d = $class->new(2); - while ($z->bacmp($x) <= 0) { # f <= x ? - $r->bmul($z); - $r->bdiv($d); - $z->binc(); - $d->binc(); + my $n = $x -> {value}; + my $k = $y -> {value}; + + # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as + # nok(n, n-k) to minimize the number if iterations in the loop. + + { + my $twok = $CALC->_mul($CALC->_two(), $CALC->_copy($k)); + if ($CALC->_acmp($twok, $n) > 0) { + $k = $CALC->_sub($CALC->_copy($n), $k); } - $x->{value} = $r->{value}; - $x->{sign} = '+'; + } + + if ($CALC->_is_zero($k)) { + $n = $CALC->_one(); } else { - $x->bone(); + + # Make a copy of the original n, since we'll be modifying n + # in-place. + + my $n_orig = $CALC->_copy($n); + + $CALC->_sub($n, $k); + $CALC->_inc($n); + + my $f = $CALC->_copy($n); + $CALC->_inc($f); + + my $d = $CALC->_two(); + + # while f <= n (the original n, that is) ... + + while ($CALC->_acmp($f, $n_orig) <= 0) { + $CALC->_mul($n, $f); + $CALC->_div($n, $d); + $CALC->_inc($f); + $CALC->_inc($d); + } } + + $x -> {value} = $n; } + $x->round(@r); } @@ -4604,6 +4627,13 @@ Returns true if the invocand is zero and false otherwise. Returns true if the invocand is one and false otherwise. +=item is_finite() + + $x->is_finite(); # true if $x is not +inf, -inf or NaN + +Returns true if the invocand is a finite number, i.e., it is neither +inf, +-inf, nor NaN. + =item is_inf( [ SIGN ] ) $x->is_inf(); # true if $x is +inf diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index f81fe24..4be50f4 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999724'; +our $VERSION = '1.999726'; $VERSION = eval $VERSION; # Package to store unsigned big integers in decimal and do math with them @@ -97,18 +97,22 @@ sub _base_len { sub _new { # Given a string representing an integer, returns a reference to an array # of integers, where each integer represents a chunk of the original input - # integer. Assumes normalized value as input. + # integer. my ($proto, $str) = @_; + #unless ($str =~ /^([1-9]\d*|0)\z/) { + # require Carp; + # Carp::croak("Invalid input string '$str'"); + #} my $input_len = length($str) - 1; # Shortcut for small numbers. - return [ int($str) ] if $input_len < $BASE_LEN; + return [ $str ] if $input_len < $BASE_LEN; my $format = "a" . (($input_len % $BASE_LEN) + 1); $format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN) - : "(a$BASE_LEN)*"; + : "(a$BASE_LEN)*"; [ reverse(map { 0 + $_ } unpack($format, $str)) ]; } @@ -134,8 +138,7 @@ BEGIN { use integer; my $e1 = 7; $num = 7; - do - { + do { $num = ('9' x ++$e1) + 0; $num *= $num + 1; } while ("$num" =~ /9{$e1}0{$e1}/); # must be a certain pattern @@ -154,7 +157,7 @@ BEGIN { local $^W = 0; # don't warn about 'nonportable number' $AND_BITS = 15; $XOR_BITS = 15; - $OR_BITS = 15; + $OR_BITS = 15; # find max bits, we will not go higher than numberofbits that fit into $BASE # to make _and etc simpler (and faster for smaller, slower for large numbers) @@ -167,6 +170,7 @@ BEGIN { $max = 16 if $] < 5.006; # older Perls might not take >16 too well } my ($x, $y, $z); + do { $AND_BITS++; $x = CORE::oct('0b' . '1' x $AND_BITS); @@ -174,6 +178,7 @@ BEGIN { $z = (2 ** $AND_BITS) - 1; } while ($AND_BITS < $max && $x == $z && $y == $x); $AND_BITS --; # retreat one step + do { $XOR_BITS++; $x = CORE::oct('0b' . '1' x $XOR_BITS); @@ -181,6 +186,7 @@ BEGIN { $z = (2 ** $XOR_BITS) - 1; } while ($XOR_BITS < $max && $x == $z && $y == $x); $XOR_BITS --; # retreat one step + do { $OR_BITS++; $x = CORE::oct('0b' . '1' x $OR_BITS); @@ -189,9 +195,9 @@ BEGIN { } while ($OR_BITS < $max && $x == $z && $y == $x); $OR_BITS--; # retreat one step - $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS )); - $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS )); - $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS )); + $AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS )); + $XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS )); + $OR_MASK = __PACKAGE__->_new(( 2 ** $OR_BITS )); # We can compute the approximate length no faster than the real length: *_alen = \&_len; @@ -221,8 +227,8 @@ sub _ten { sub _1ex { # create a 1Ex - my $rem = $_[1] % $BASE_LEN; # remainder - my $parts = $_[1] / $BASE_LEN; # parts + my $rem = $_[1] % $BASE_LEN; # remainder + my $parts = $_[1] / $BASE_LEN; # parts # 000000, 000000, 100 [ (0) x $parts, '1' . ('0' x $rem) ]; @@ -270,7 +276,7 @@ sub _num { # Make a Perl scalar number (int/float) from a BigInt object. my $x = $_[1]; - return 0 + $x->[0] if @$x == 1; # below $BASE + return $x->[0] if @$x == 1; # below $BASE # Start with the most significant element and work towards the least # significant element. Avoid multiplying "inf" (which happens if the number @@ -297,9 +303,13 @@ sub _add { my ($c, $x, $y) = @_; - return $x if @$y == 1 && $y->[0] == 0; # $x + 0 => $x - if (@$x == 1 && $x->[0] == 0) { # 0 + $y => $y->copy - # Twice as slow as $x = [ @$y ], but necessary to modify $x in-place. + # $x + 0 => $x + + return $x if @$y == 1 && $y->[0] == 0; + + # 0 + $y => $y->copy + + if (@$x == 1 && $x->[0] == 0) { @$x = @$y; return $x; } @@ -626,9 +636,8 @@ sub _div_use_mul { # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; - $rem = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to original array - $x->[0] = 0; # set to 0 + $rem = [ @$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 } @@ -639,10 +648,9 @@ sub _div_use_mul { # 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 = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to org array - $x->[0] = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? + $rem = [ @$x ] if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? return $x; } # now calculate $x / $yorg @@ -659,10 +667,9 @@ sub _div_use_mul { # $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 = [ 0 ]; # a = 0 => x == y => rem 0 + $rem = [ 0 ]; # a = 0 => x == y => rem 0 $rem = [ @$x ] if $a != 0; # a < 0 => x < y => rem = x - splice(@$x, 1); # keep single element - $x->[0] = 0; # if $a < 0 + @$x = 0; # if $a < 0 $x->[0] = 1 if $a == 0; # $x == $y return ($x, $rem) if wantarray; return $x; @@ -793,9 +800,8 @@ sub _div_use_div_64 { # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; - $rem = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to original array - $x->[0] = 0; # set to 0 + $rem = [ @$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 } @@ -807,8 +813,7 @@ sub _div_use_div_64 { # the one from $x), the result will also be 0: if (length(int($yorg->[-1])) > length(int($x->[-1]))) { $rem = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to org array - $x->[0] = 0; # set to 0 + @$x = 0; # set to 0 return ($x, $rem) if wantarray; # including remainder? return $x; } @@ -829,8 +834,7 @@ sub _div_use_div_64 { if ($a <= 0) { $rem = [ 0 ]; # a = 0 => x == y => rem 0 $rem = [ @$x ] if $a != 0; # a < 0 => x < y => rem = x - splice(@$x, 1); # keep single element - $x->[0] = 0; # if $a < 0 + @$x = 0; # if $a < 0 $x->[0] = 1 if $a == 0; # $x == $y return ($x, $rem) if wantarray; # including remainder? return $x; @@ -964,11 +968,10 @@ sub _div_use_div { # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; - $rem = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to original array - $x->[0] = 0; # set to 0 + $rem = [ @$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 + 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 @@ -977,10 +980,9 @@ sub _div_use_div { # 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 = [ @$x ] if wantarray; # make copy - splice(@$x, 1); # keep ref to org array - $x->[0] = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? + $rem = [ @$x ] if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? return $x; } # now calculate $x / $yorg @@ -998,11 +1000,11 @@ sub _div_use_div { # $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 = [ 0 ]; # a = 0 => x == y => rem 0 - $rem = [ @$x ] if $a != 0; # a < 0 => x < y => rem = x - splice(@$x, 1); # keep single element - $x->[0] = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y + $rem = [ 0 ]; # a = 0 => x == y => rem 0 + $rem = [ @$x ] if $a != 0; # a < 0 => x < y => rem = 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; } @@ -1099,7 +1101,7 @@ sub _acmp { # shortcut for short numbers return (($cx->[0] <=> $cy->[0]) <=> 0) - if @$cx == @$cy && @$cx == 1; + if @$cx == 1 && @$cy == 1; # fast comp based on number of array elements (aka pseudo-length) my $lxy = (@$cx - @$cy) @@ -1138,11 +1140,15 @@ sub _digit { my $len = _len('', $x); $n += $len if $n < 0; # -1 last, -2 second-to-last + + # Math::BigInt::Calc returns 0 if N is out of range, but this is not done + # by the other backend libraries. + return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range - my $elem = int($n / $BASE_LEN); # which array element - my $digit = $n % $BASE_LEN; # which digit in this element - substr("$x->[$elem]", -$digit - 1, 1); + my $elem = int($n / $BASE_LEN); # index of array element + my $digit = $n % $BASE_LEN; # index of digit within the element + substr("0" x $BASE_LEN . "$x->[$elem]", -1 - $digit, 1); } sub _zeros { @@ -1155,16 +1161,13 @@ sub _zeros { return 0 if @$x == 1 && $x->[0] == 0; my $zeros = 0; - my $elem; - foreach my $e (@$x) { - if ($e != 0) { - $elem = "$e"; # preserve x - $elem =~ s/.*?(0*$)/$1/; # strip anything not zero - $zeros *= $BASE_LEN; # elems * 5 - $zeros += length($elem); # count trailing zeros - last; # early out + foreach my $elem (@$x) { + if ($elem != 0) { + $elem =~ /[^0](0*)\z/; + $zeros += length($1); # count trailing zeros + last; # early out } - $zeros ++; # real else branch: 50% slower! + $zeros += $BASE_LEN; } $zeros; } @@ -1205,13 +1208,10 @@ sub _is_ten { sub __strip_zeros { # Internal normalization function that strips leading zeros from the array. # Args: ref to array - my $s = shift; - - my $cnt = @$s; # get count of parts - my $i = $cnt - 1; - push @$s, 0 if $i < 0; # div might return empty results, so fix it + my $x = shift; - return $s if @$s == 1; # early out + push @$x, 0 if @$x == 0; # div might return empty results, so fix it + return $x if @$x == 1; # early out #print "strip: cnt $cnt i $i\n"; # '0', '3', '4', '0', '0', @@ -1221,13 +1221,15 @@ sub __strip_zeros { # i = 3 # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos) # >= 1: skip first part (this can be zero) + + my $i = $#$x; while ($i > 0) { - last if $s->[$i] != 0; + last if $x->[$i] != 0; $i--; } $i++; - splice(@$s, $i) if $i < $cnt; # $i cant be 0 - $s; + splice(@$x, $i) if $i < @$x; + $x; } ############################################################################### @@ -1237,31 +1239,37 @@ sub _check { # used by the test suite my $x = $_[1]; - return "$x is not a reference" if !ref($x); - - # are all parts are valid? - my $i = 0; - my $j = @$x; - my ($e, $try); - while ($i < $j) { - $e = $x->[$i]; - $e = 'undef' unless defined $e; - $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)"; - last if $e !~ /^[+]?[0-9]+$/; - $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)"; - last if "$e" !~ /^[+]?[0-9]+$/; - $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)"; - last if '' . "$e" !~ /^[+]?[0-9]+$/; - $try = ' < 0 || >= $BASE; '."($x, $e)"; - last if $e <0 || $e >= $BASE; - # This test is disabled, since new/bnorm and certain ops (like early out - # in add/sub) are allowed/expected to leave '00000' in some elements. - #$try = '=~ /^00+/; '."($x, $e)"; - #last if $e =~ /^00+/; - $i++; - } - return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j; - 0; + return "Undefined" unless defined $x; + return "$x is not a reference" unless ref($x); + return "Not an ARRAY reference" unless ref($x) eq 'ARRAY'; + + for (my $i = 0 ; $i <= $#$x ; ++ $i) { + my $e = $x -> [$i]; + + return "Element at index $i is undefined" + unless defined $e; + + return "Element at index $i is a '" . ref($e) . + "', which is not a scalar" + unless ref($e) eq ""; + + return "Element at index $i is '$e', which does not look like an" . + " normal integer" + #unless $e =~ /^([1-9]\d*|0)\z/; + unless $e =~ /^\d+\z/; + + return "Element at index $i is '$e', which is negative" + if $e < 0; + + return "Element at index $i is '$e', which is not smaller than" . + " the base '$BASE'" + if $e >= $BASE; + + return "Element at index $i (last element) is zero" + if $#$x > 0 && $i == $#$x && $e == 0; + } + + return 0; } ############################################################################### @@ -1330,7 +1338,7 @@ sub _rsft { if ($n != 10) { $n = _new($c, $n); - return _div($c, $x, _pow($c, $n, $y)); + return scalar _div($c, $x, _pow($c, $n, $y)); } # shortcut (faster) for shifting by 10) @@ -1369,40 +1377,51 @@ sub _rsft { } sub _lsft { - my ($c, $x, $y, $n) = @_; - - if ($n != 10) { - $n = _new($c, $n); - return _mul($c, $x, _pow($c, $n, $y)); - } - - # shortcut (faster) for shifting by 10) since we are in base 10eX - # multiples of $BASE_LEN: - my $src = @$x; # source - my $len = _num($c, $y); # 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--; - } - # set lowest parts to 0 - while ($dst >= 0) { - $x->[$dst--] = 0; - } - # fix spurious last zero element - splice @$x, -1 if $x->[-1] == 0; - $x; + my ($c, $x, $n, $b) = @_; + + return $x if _is_zero($c, $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 = _mul($c, $n, _new($c, $log10)); + + # shortcut (faster) for shifting by 10) since we are in base 10eX + # multiples of $BASE_LEN: + my $src = @$x; # source + my $len = _num($c, $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--; + } + # set lowest parts to 0 + while ($dst >= 0) { + $x->[$dst--] = 0; + } + # fix spurious last zero element + splice @$x, -1 if $x->[-1] == 0; + return $x; + } else { + $b = _new($c, $b); + #print $c->_str($b); + return _mul($c, $x, _pow($c, $b, $n)); + } } sub _pow { @@ -1699,33 +1718,38 @@ sub _fac { $cx; # return result } -############################################################################# - sub _log_int { # calculate integer log of $x to base $base # ref to array, ref to array - return ref to array my ($c, $x, $base) = @_; # X == 0 => NaN - return if (@$x == 1 && $x->[0] == 0); + return if @$x == 1 && $x->[0] == 0; + # BASE 0 or 1 => NaN - return if (@$base == 1 && $base->[0] < 2); - my $cmp = _acmp($c, $x, $base); # X == BASE => 1 + return if @$base == 1 && $base->[0] < 2; + + # X == 1 => 0 (is exact) + if (@$x == 1 && $x->[0] == 1) { + @$x = 0; + return $x, 1; + } + + my $cmp = _acmp($c, $x, $base); + + # X == BASE => 1 (is exact) if ($cmp == 0) { - splice (@$x, 1); - $x->[0] = 1; - return ($x, 1) + @$x = 1; + return $x, 1; } - # X < BASE + + # 1 < X < BASE => 0 (is truncated) if ($cmp < 0) { - splice (@$x, 1); - $x->[0] = 0; - return ($x, undef); + @$x = 0; + return $x, 0; } - my $x_org = _copy($c, $x); # preserve x - splice(@$x, 1); - $x->[0] = 1; # keep ref to $x + my $x_org = _copy($c, $x); # preserve x # Compute a guess for the result based on: # $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) ) @@ -1740,69 +1764,32 @@ sub _log_int { # calculate now a guess based on the values obtained above: my $res = int($len / $log); - $x->[0] = $res; - my $trial = _pow ($c, _copy($c, $base), $x); - my $a = _acmp($c, $trial, $x_org); + @$x = $res; + my $trial = _pow($c, _copy($c, $base), $x); + my $acmp = _acmp($c, $trial, $x_org); - # print STDERR "# trial ", _str($c, $x), " was: $a (0 = exact, -1 too small, +1 too big)\n"; + # Did we get the exact result? - # found an exact result? - return ($x, 1) if $a == 0; + return $x, 1 if $acmp == 0; - if ($a > 0) { - # or too big - _div($c, $trial, $base); - _dec($c, $x); - while (($a = _acmp($c, $trial, $x_org)) > 0) { - # print STDERR "# big _log_int at ", _str($c, $x), "\n"; - _div($c, $trial, $base); - _dec($c, $x); - } - # result is now exact (a == 0), or too small (a < 0) - return ($x, $a == 0 ? 1 : 0); - } - - # else: result was to small - _mul($c, $trial, $base); + # Too small? - # did we now get the right result? - $a = _acmp($c, $trial, $x_org); - - if ($a == 0) # yes, exactly - { + while ($acmp < 0) { + _mul($c, $trial, $base); _inc($c, $x); - return ($x, 1); + $acmp = _acmp($c, $trial, $x_org); } - return ($x, 0) if $a > 0; - # Result still too small (we should come here only if the estimate above - # was very off base): + # Too big? - # Now let the normal trial run obtain the real result - # Simple loop that increments $x by 2 in each step, possible overstepping - # the real result - - my $base_mul = _mul($c, _copy($c, $base), $base); # $base * $base - - while (($a = _acmp($c, $trial, $x_org)) < 0) { - # print STDERR "# small _log_int at ", _str($c, $x), "\n"; - _mul($c, $trial, $base_mul); - _add($c, $x, [2]); - } - - my $exact = 1; - if ($a > 0) { - # overstepped the result - _dec($c, $x); + while ($acmp > 0) { _div($c, $trial, $base); - $a = _acmp($c, $trial, $x_org); - if ($a > 0) { - _dec($c, $x); - } - $exact = 0 if $a != 0; # a = -1 => not exact result, a = 0 => exact + _dec($c, $x); + $acmp = _acmp($c, $trial, $x_org); } - ($x, $exact); # return result + return $x, 1 if $acmp == 0; # result is exact + return $x, 0; # result is too small } # for debugging: @@ -1924,7 +1911,7 @@ sub _root { _sqrt($c, $x); } # $x is now one element to big, so truncate result by removing it - splice (@$x, 0, 1); + shift @$x; } else { # trial computation by starting with 2, 4, 8, 16 etc until we overstep my $step; @@ -1990,29 +1977,21 @@ sub _and { my ($xr, $yr); my $mask = $AND_MASK; - my $x1 = $x; - my $y1 = _copy($c, $y); # make copy - $x = _zero(); - my ($b, $xrr, $yrr); + my $x1 = _copy($c, $x); + my $y1 = _copy($c, $y); + my $z = _zero($c); + use integer; - while (!_is_zero($c, $x1) && !_is_zero($c, $y1)) { + until (_is_zero($c, $x1) || _is_zero($c, $y1)) { ($x1, $xr) = _div($c, $x1, $mask); ($y1, $yr) = _div($c, $y1, $mask); - # make ints() from $xr, $yr - # this is when the AND_BITS are greater than $BASE and is slower for - # small (<256 bits) numbers, but faster for large numbers. Disabled - # due to KISS principle - - # $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } - # $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } - # _add($c, $x, _mul($c, _new( $c, ($xrr & $yrr) ), $m) ); - - # 0+ due to '&' doesn't work in strings - _add($c, $x, _mul($c, [ 0 + $xr->[0] & 0 + $yr->[0] ], $m) ); + _add($c, $z, _mul($c, [ 0 + $xr->[0] & 0 + $yr->[0] ], $m)); _mul($c, $m, $mask); } - $x; + + @$x = @$z; + return $x; } sub _xor { @@ -2024,12 +2003,12 @@ sub _xor { my ($xr, $yr); my $mask = $XOR_MASK; - my $x1 = $x; + my $x1 = _copy($c, $x); my $y1 = _copy($c, $y); # make copy - $x = _zero(); - my ($b, $xrr, $yrr); + my $z = _zero($c); + use integer; - while (!_is_zero($c, $x1) && !_is_zero($c, $y1)) { + until (_is_zero($c, $x1) || _is_zero($c, $y1)) { ($x1, $xr) = _div($c, $x1, $mask); ($y1, $yr) = _div($c, $y1, $mask); # make ints() from $xr, $yr (see _and()) @@ -2037,17 +2016,17 @@ sub _xor { #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } #_add($c, $x, _mul($c, _new( $c, ($xrr ^ $yrr) ), $m) ); - # 0+ due to '^' doesn't work in strings - _add($c, $x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) ); + _add($c, $z, _mul($c, [ 0 + $xr->[0] ^ 0 + $yr->[0] ], $m)); _mul($c, $m, $mask); } # the loop stops when the shorter of the two numbers is exhausted # the remainder of the longer one will survive bit-by-bit, so we simple # multiply-add it in - _add($c, $x, _mul($c, $x1, $m) ) if !_is_zero($c, $x1); - _add($c, $x, _mul($c, $y1, $m) ) if !_is_zero($c, $y1); + _add($c, $z, _mul($c, $x1, $m) ) if !_is_zero($c, $x1); + _add($c, $z, _mul($c, $y1, $m) ) if !_is_zero($c, $y1); - $x; + @$x = @$z; + return $x; } sub _or { @@ -2059,12 +2038,12 @@ sub _or { my ($xr, $yr); my $mask = $OR_MASK; - my $x1 = $x; + my $x1 = _copy($c, $x); my $y1 = _copy($c, $y); # make copy - $x = _zero(); - my ($b, $xrr, $yrr); + my $z = _zero($c); + use integer; - while (!_is_zero($c, $x1) && !_is_zero($c, $y1)) { + until (_is_zero($c, $x1) || _is_zero($c, $y1)) { ($x1, $xr) = _div($c, $x1, $mask); ($y1, $yr) = _div($c, $y1, $mask); # make ints() from $xr, $yr (see _and()) @@ -2072,17 +2051,17 @@ sub _or { # $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } # _add($c, $x, _mul($c, _new( $c, ($xrr | $yrr) ), $m) ); - # 0+ due to '|' doesn't work in strings - _add($c, $x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) ); + _add($c, $z, _mul($c, [ 0 + $xr->[0] | 0 + $yr->[0] ], $m)); _mul($c, $m, $mask); } # the loop stops when the shorter of the two numbers is exhausted # the remainder of the longer one will survive bit-by-bit, so we simple # multiply-add it in - _add($c, $x, _mul($c, $x1, $m) ) if !_is_zero($c, $x1); - _add($c, $x, _mul($c, $y1, $m) ) if !_is_zero($c, $y1); + _add($c, $z, _mul($c, $x1, $m) ) if !_is_zero($c, $x1); + _add($c, $z, _mul($c, $y1, $m) ) if !_is_zero($c, $y1); - $x; + @$x = @$z; + return $x; } sub _as_hex { @@ -2755,8 +2734,7 @@ Return the binomial coefficient OBJ1 over OBJ1. =item I<_alen(OBJ)> Return the approximate number of decimal digits of the object. The output is -one Perl scalar. This estimate must be greater than or equal to what C<_len()> -returns. +one Perl scalar. =back diff --git a/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm b/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm index 509a071..006a6ec 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999724'; +our $VERSION = '1.999726'; $VERSION = eval $VERSION; package Math::BigInt; @@ -25,7 +25,7 @@ sub __emu_band my ($self,$x,$y,$sx,$sy,@r) = @_; return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); - + my $sign = 0; # sign of result $sign = 1 if $sx == -1 && $sy == -1; @@ -75,7 +75,7 @@ sub __emu_band # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx $bx .= $xx x abs($diff); } - + # and the strings together my $r = $bx & $by; @@ -380,7 +380,7 @@ L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum> =head1 LICENSE This program is free software; you may redistribute it and/or modify it under -the same terms as Perl itself. +the same terms as Perl itself. =head1 AUTHORS diff --git a/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm new file mode 100644 index 0000000..94aa7b9 --- /dev/null +++ b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm @@ -0,0 +1,37 @@ +#!perl + +use strict; +use warnings; + +package Math::BigInt::Lib::TestUtil; + +our @ISA = qw< Exporter >; +our @EXPORT_OK = qw< randstr >; + +# randstr NUM, BASE +# +# Generate a string representing a NUM digit number in base BASE. + +sub randstr { + die "randstr: wrong number of input arguments\n" + unless @_ == 2; + + my $n = shift; + my $b = shift; + + die "randstr: first input argument must be >= 0" + unless $n >= 0; + die "randstr: second input argument must be in the range 2 .. 36\n" + unless 2 <= $b && $b <= 36; + + return '' if $n == 0; + + my @dig = (0 .. 9, 'a' .. 'z'); + + my $str = $dig[ 1 + int rand ($b - 1) ]; + $str .= $dig[ int rand $b ] for 2 .. $n; + + return $str; +} + +1; diff --git a/cpan/Math-BigInt/t/big_pi_e.t b/cpan/Math-BigInt/t/big_pi_e.t index f846a95..66705da 100644 --- a/cpan/Math-BigInt/t/big_pi_e.t +++ b/cpan/Math-BigInt/t/big_pi_e.t @@ -13,22 +13,22 @@ use Math::BigFloat; my $pi = Math::BigFloat::bpi(); -ok(!exists $pi->{_a}, 'A not set'); -ok(!exists $pi->{_p}, 'P not set'); +is($pi->{_a}, undef, 'A is not defined'); +is($pi->{_p}, undef, 'P is not defined'); $pi = Math::BigFloat->bpi(); -ok(!exists $pi->{_a}, 'A not set'); -ok(!exists $pi->{_p}, 'P not set'); +is($pi->{_a}, undef, 'A is not defined'); +is($pi->{_p}, undef, 'P is not defined'); $pi = Math::BigFloat->bpi(10); -is($pi->{_a}, 10, 'A set'); -is($pi->{_p}, undef, 'P not set'); +is($pi->{_a}, 10, 'A is defined'); +is($pi->{_p}, undef, 'P is not defined'); ############################################################################# my $e = Math::BigFloat->new(1)->bexp(); -ok(!exists $e->{_a}, 'A not set'); -ok(!exists $e->{_p}, 'P not set'); +is($e->{_a}, undef, 'A is not defined'); +is($e->{_p}, undef, 'P is not defined'); diff --git a/cpan/Math-BigInt/t/calling.t b/cpan/Math-BigInt/t/calling.t index d19d637..b81423c 100644 --- a/cpan/Math-BigInt/t/calling.t +++ b/cpan/Math-BigInt/t/calling.t @@ -6,7 +6,7 @@ use strict; use warnings; use lib 't'; -my $VERSION = '1.999724'; # adjust manually to match latest release +my $VERSION = '1.999726'; # adjust manually to match latest release $VERSION = eval $VERSION; use Test::More tests => 5; -- Perl5 Master Repository
