In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4f738c750ddb40ef82b46158f89572739a8b186a?hp=fa951d2c91f349f100412a541b9fa2f6122af080>
- Log ----------------------------------------------------------------- commit 4f738c750ddb40ef82b46158f89572739a8b186a Author: Chris 'BinGOs' Williams <[email protected]> Date: Sat Dec 3 07:34:55 2016 +0000 Update bignum to CPAN version 0.44 [DELTA] 2016-11-15 pjacklam 0.44 * Update bundled Module::Install from version 1.16 to version 1.17. * Replace function calls with method calls. * Include patch for CPAN RT #116506. M Porting/Maintainers.pl M cpan/bignum/lib/Math/BigFloat/Trace.pm M cpan/bignum/lib/Math/BigInt/Trace.pm M cpan/bignum/lib/bigint.pm M cpan/bignum/lib/bignum.pm M cpan/bignum/lib/bigrat.pm M t/porting/customized.dat commit 0c2fbbe34d71068f88fd77ca133a96c10b6ef5d8 Author: Chris 'BinGOs' Williams <[email protected]> Date: Sat Dec 3 07:25:54 2016 +0000 Update Math-BigRat to CPAN version 0.260805 [DELTA] 2016-11-15 v0.260805 pjacklam * Standardize on using $LIB for the variable holding the class of the backend library. * Improve bmul() by doing _gcd() twice on smaller numbers rather than once on larger numbers. M Porting/Maintainers.pl M cpan/Math-BigRat/lib/Math/BigRat.pm M cpan/Math-BigRat/t/bigfltrt.t M cpan/Math-BigRat/t/bigratpm.t commit d239a8c7513e81cdb8d891f44da53ca5adcebeae Author: Chris 'BinGOs' Williams <[email protected]> Date: Sat Dec 3 07:23:23 2016 +0000 Update Math-BigInt-FastCalc to CPAN version 0.5002 [DELTA] 2016-11-23 v0.5002 pjacklam * Sync test files with Math-BigInt-1.999801. Add t/biglog.t and t/bigroot.t since these are included in the test suite for the other backend libraries (GMP and Pari). 2016-11-17 v0.5001 pjacklam * Avoid 'use parent' to retain compatibility with old Perls. * Fix incorrect version numbers in the CHANGES file. * Trim whitespace. 2016-11-15 v0.5000 pjacklam * Sync test files with Math-BigInt-1.999800. * Math::BigInt::FastCalc is now a subclass of Math::BigInt::Calc, so remove aliases like *Math::BigInt::FastCalc::_xxx = \&Math::BigInt::Calc::_xxx. * Use OO-calls rather than function calls. * Fix documentation error in Math::BigInt::FastCalc M MANIFEST M Porting/Maintainers.pl M cpan/Math-BigInt-FastCalc/FastCalc.xs M cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm M cpan/Math-BigInt-FastCalc/t/bigintfc.t A cpan/Math-BigInt-FastCalc/t/biglog.t A cpan/Math-BigInt-FastCalc/t/bigroot.t M cpan/Math-BigInt-FastCalc/t/bootstrap.t M cpan/Math-BigInt-FastCalc/t/leak.t M cpan/Math-BigInt-FastCalc/t/mbi_rand.t commit 54b49d9685a18180ada6dbdb5bb02cb8459e6bd7 Author: Chris 'BinGOs' Williams <[email protected]> Date: Sat Dec 3 07:14:13 2016 +0000 Update Math-BigInt to CPAN version 1.999802 [DELTA] 2016-11-15 v1.999800 pjacklam * Upgrade bundled Module::Install from version 1.16 to version 1.17. * Add Math::BigInt::Lib (lib/Math/BigInt/Lib.pm), a parent class for Math::BigInt backend libraries. * Use objects in Math::BigInt::Calc, not just array refs. Also use OO-style, i.e., use $class->_add($x, $y) rather than _add($class, $x, $y). * Not all library methods modify the invocand, so call library methods as, e.g, $x = $LIB->method($x, $y) rather than just $LIB->method($x, $y). * Math::BigInt::Calc is now a subclass of Math::BigInt::Lib. * Add Math::BigInt::Lib::Minimal (t/Math/BigInt/Lib/Minimal.pm) for testing inheritance from Math::BigInt::Lib. * Minor simplification in Math::BigInt::Calc->_str(). * Speed up Math::BigInt::Calc->_root(). * Remove test files that were included in the previous release by accident. * Add more tests and use more verbose output in some tests. * Fix typo in lib/Math/BigFloat.pm * Fix documentation error in lib/Math/Calc.pm * Use Config::Tiny and an .ini file to handle the library specific configuration for the author-lib*.t test files. 2016-11-23 v1.999801 pjacklam * Fix, hopefully once and for all, the longstanding problem of handling undef as an operand to mathematical methods. The only method that accepts undef as an operand is blog(), where the second operand might be undef, as in $x->blog() or $x->blog($b), where $b is undef. The undef signifies that Euler's number should be used as the base. With this fix, we should be able to get Math::BigInt::Lite working again. * Add least common multiple method _lcm() to Math::BigInt::Lib, and add corresponding test file t/author-lib-arithmetic-binary-_lcm.t and test data file t/author-lib-arithmetic-binary-_lcm.dat. * Remove internal function __lcm() which has become redundant now that _lcm() is in the library. * Make it possible to use bgcd() and blcm() as class methods, since other methods can be used as class methods. This applies to both Math::BigInt and Math::BigFloat. * Fix blcm() with negative input. The LCM should always be non-negative. This applies to both Math::BigInt and Math::BigFloat. * Add tests for bgcd() and blcm() in t/bigintpm.t and t/bigfltpm.t. * Fix tests for blcm() assuming that LCM(0,0) should be a NaN. LCM(0,0) is 0 by convention. * Prefer Class->config('option') over Class->config()->{option}. However, this does not seem to be working for all options. It seems that this won't work properly until we move the global variables into the OO interface. * Explicitly specify the library in all test files that are shared between Math-BigInt and the library distributions (FaatCalc, GMP, Pari, ...) with, e.g., "use Math::BigInt only => 'Calc';". This way, it will fail immediately if the specified library can't be loaded rather than using the fallback library. 2016-11-28 v1.999802 pjacklam * When bzero(), bone(), binf(), and bnan() are used as constructors, don't check whether the class allows the object to be modified. This applies to both Math::BigInt and Math::BigFloat. * Improve bgcd() and blcm(). This applies to both Math::BigInt and Math::BigFloat. M MANIFEST M Porting/Maintainers.pl M cpan/Math-BigInt/lib/Math/BigFloat.pm M cpan/Math-BigInt/lib/Math/BigInt.pm M cpan/Math-BigInt/lib/Math/BigInt/Calc.pm M cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm A cpan/Math-BigInt/lib/Math/BigInt/Lib.pm M cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm A cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm M cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm M cpan/Math-BigInt/t/bare_mbf.t M cpan/Math-BigInt/t/bare_mbi.t M cpan/Math-BigInt/t/bare_mif.t M cpan/Math-BigInt/t/bigfltpm.inc M cpan/Math-BigInt/t/bigfltpm.t M cpan/Math-BigInt/t/bigintc.t M cpan/Math-BigInt/t/bigintpm.inc M cpan/Math-BigInt/t/bigintpm.t M cpan/Math-BigInt/t/biglog.t M cpan/Math-BigInt/t/bigroot.t M cpan/Math-BigInt/t/calling.t M cpan/Math-BigInt/t/mbf_ali.t M cpan/Math-BigInt/t/mbi_ali.t M cpan/Math-BigInt/t/mbi_rand.t M cpan/Math-BigInt/t/mbimbf.inc M cpan/Math-BigInt/t/mbimbf.t M cpan/Math-BigInt/t/new-mbf.t M cpan/Math-BigInt/t/sub_ali.t M cpan/Math-BigInt/t/sub_mbf.t M cpan/Math-BigInt/t/sub_mbi.t M cpan/Math-BigInt/t/sub_mif.t M cpan/Math-BigInt/t/upgrade.inc M cpan/Math-BigInt/t/upgrade.t M cpan/Math-BigInt/t/upgradef.t M cpan/Math-BigInt/t/use_lib1.t M cpan/Math-BigInt/t/use_lib2.t M cpan/Math-BigInt/t/use_lib3.t M cpan/Math-BigInt/t/use_lib4.t M cpan/Math-BigInt/t/use_mbfw.t M cpan/Math-BigInt/t/with_sub.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 4 + Porting/Maintainers.pl | 17 +- cpan/Math-BigInt-FastCalc/FastCalc.xs | 13 +- .../lib/Math/BigInt/FastCalc.pm | 59 +- cpan/Math-BigInt-FastCalc/t/bigintfc.t | 25 +- .../t/biglog.t | 2 +- .../t/bigroot.t | 2 +- cpan/Math-BigInt-FastCalc/t/bootstrap.t | 1 - cpan/Math-BigInt-FastCalc/t/leak.t | 5 +- cpan/Math-BigInt-FastCalc/t/mbi_rand.t | 123 +- cpan/Math-BigInt/lib/Math/BigFloat.pm | 147 +- cpan/Math-BigInt/lib/Math/BigInt.pm | 92 +- cpan/Math-BigInt/lib/Math/BigInt/Calc.pm | 1240 ++++++--------- cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm | 4 +- cpan/Math-BigInt/lib/Math/BigInt/Lib.pm | 1674 ++++++++++++++++++++ cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm | 36 +- cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm | 1018 ++++++++++++ cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm | 4 +- cpan/Math-BigInt/t/bare_mbf.t | 2 +- cpan/Math-BigInt/t/bare_mbi.t | 4 +- cpan/Math-BigInt/t/bare_mif.t | 6 +- cpan/Math-BigInt/t/bigfltpm.inc | 2 +- cpan/Math-BigInt/t/bigfltpm.t | 49 +- cpan/Math-BigInt/t/bigintc.t | 9 +- cpan/Math-BigInt/t/bigintpm.inc | 10 +- cpan/Math-BigInt/t/bigintpm.t | 42 +- cpan/Math-BigInt/t/biglog.t | 2 +- cpan/Math-BigInt/t/bigroot.t | 2 +- cpan/Math-BigInt/t/calling.t | 6 +- cpan/Math-BigInt/t/mbf_ali.t | 2 +- cpan/Math-BigInt/t/mbi_ali.t | 2 +- cpan/Math-BigInt/t/mbi_rand.t | 22 +- cpan/Math-BigInt/t/mbimbf.inc | 2 +- cpan/Math-BigInt/t/mbimbf.t | 4 +- cpan/Math-BigInt/t/new-mbf.t | 1 - cpan/Math-BigInt/t/sub_ali.t | 2 +- cpan/Math-BigInt/t/sub_mbf.t | 4 +- cpan/Math-BigInt/t/sub_mbi.t | 2 +- cpan/Math-BigInt/t/sub_mif.t | 2 +- cpan/Math-BigInt/t/upgrade.inc | 4 +- cpan/Math-BigInt/t/upgrade.t | 2 +- cpan/Math-BigInt/t/upgradef.t | 2 +- cpan/Math-BigInt/t/use_lib1.t | 4 +- cpan/Math-BigInt/t/use_lib2.t | 4 +- cpan/Math-BigInt/t/use_lib3.t | 4 +- cpan/Math-BigInt/t/use_lib4.t | 4 +- cpan/Math-BigInt/t/use_mbfw.t | 8 +- cpan/Math-BigInt/t/with_sub.t | 6 +- cpan/Math-BigRat/lib/Math/BigRat.pm | 384 ++--- cpan/Math-BigRat/t/bigfltrt.t | 2 +- cpan/Math-BigRat/t/bigratpm.t | 2 +- cpan/bignum/lib/Math/BigFloat/Trace.pm | 2 +- cpan/bignum/lib/Math/BigInt/Trace.pm | 2 +- cpan/bignum/lib/bigint.pm | 2 +- cpan/bignum/lib/bignum.pm | 2 +- cpan/bignum/lib/bigrat.pm | 2 +- t/porting/customized.dat | 5 - 57 files changed, 3762 insertions(+), 1322 deletions(-) copy cpan/{Math-BigInt => Math-BigInt-FastCalc}/t/biglog.t (99%) copy cpan/{Math-BigInt => Math-BigInt-FastCalc}/t/bigroot.t (97%) create mode 100644 cpan/Math-BigInt/lib/Math/BigInt/Lib.pm create mode 100644 cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm diff --git a/MANIFEST b/MANIFEST index 83c1767ae3..69df013795 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1684,6 +1684,7 @@ cpan/Math-BigInt/lib/Math/BigFloat.pm An arbitrary precision floating-point ari cpan/Math-BigInt/lib/Math/BigInt.pm An arbitrary precision integer arithmetic package cpan/Math-BigInt/lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm Pure Perl module to support Math::BigInt +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/bare_mbf.t Test MBF under Math::BigInt::BareCalc @@ -1725,6 +1726,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/Minimal.pm 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 @@ -1770,6 +1772,8 @@ cpan/Math-BigInt/t/with_sub.t Test use Math::BigFloat with => package cpan/Math-BigInt-FastCalc/FastCalc.xs Math::BigInt::FastCalc extension cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm Math::BigInt::FastCalc extension cpan/Math-BigInt-FastCalc/t/bigintfc.t Math::BigInt::FastCalc extension +cpan/Math-BigInt-FastCalc/t/biglog.t +cpan/Math-BigInt-FastCalc/t/bigroot.t cpan/Math-BigInt-FastCalc/t/bootstrap.t Math::BigInt::FastCalc extension cpan/Math-BigInt-FastCalc/t/leak.t test for memory leaks in Math::BigInt::FastCalc cpan/Math-BigInt-FastCalc/t/mbi_rand.t Math::BigInt::FastCalc extension diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 20a6b15c24..49bdc31474 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -188,7 +188,7 @@ use File::Glob qw(:case); }, 'bignum' => { - 'DISTRIBUTION' => 'PJACKLAM/bignum-0.43.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/bignum-0.44.tar.gz', 'FILES' => q[cpan/bignum], 'EXCLUDED' => [ qr{^inc/Module/}, @@ -199,13 +199,6 @@ use File::Glob qw(:case); t/03podcov.t ), ], - 'CUSTOMIZED' => [ - qw( - lib/Math/BigFloat/Trace.pm - lib/Math/BigInt/Trace.pm lib/bigint.pm - lib/bignum.pm lib/bigrat.pm - ) - ], }, 'Carp' => { @@ -769,7 +762,7 @@ use File::Glob qw(:case); }, 'Math::BigInt' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999727.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999802.tar.gz', 'FILES' => q[cpan/Math-BigInt], 'EXCLUDED' => [ qr{^inc/}, @@ -784,10 +777,12 @@ use File::Glob qw(:case); }, 'Math::BigInt::FastCalc' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.42.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.5002.tar.gz', 'FILES' => q[cpan/Math-BigInt-FastCalc], 'EXCLUDED' => [ qr{^inc/}, + qr{^t/author-}, + qr{^t/Math/BigInt/Lib/TestUtil.pm}, qw( t/00sig.t t/01load.t t/02pod.t @@ -807,7 +802,7 @@ use File::Glob qw(:case); }, 'Math::BigRat' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.260804.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.260805.tar.gz', 'FILES' => q[cpan/Math-BigRat], 'EXCLUDED' => [ qr{^inc/}, diff --git a/cpan/Math-BigInt-FastCalc/FastCalc.xs b/cpan/Math-BigInt-FastCalc/FastCalc.xs index eb228e4ca5..f8bb3140e8 100644 --- a/cpan/Math-BigInt-FastCalc/FastCalc.xs +++ b/cpan/Math-BigInt-FastCalc/FastCalc.xs @@ -152,7 +152,7 @@ __strip_zeros(x) elems = av_len(a); /* number of elems in array */ ST(0) = x; /* we return x */ if (elems == -1) - { + { av_push (a, newSViv(0)); /* correct empty arrays */ XSRETURN(1); } @@ -210,13 +210,13 @@ _dec(class,x) } sv_setnv (temp, MAX); /* overflow, so set this to $MAX */ index++; - } + } /* do have more than one element? */ /* (more than one because [0] should be kept as single-element) */ if (elems > 0) { temp = *av_fetch(a, elems, 0); /* fetch last element */ - if (SvIV(temp) == 0) /* did last elem overflow? */ + if (SvIV(temp) == 0) /* did last elem overflow? */ { av_pop(a); /* yes, so shrink array */ /* aka remove leading zeros */ @@ -254,7 +254,7 @@ _inc(class,x) } sv_setiv (temp, 0); /* overflow, so set this elem to 0 */ index++; - } + } temp = *av_fetch(a, elems, 0); /* fetch last element */ if (SvIV(temp) == 0) /* did last elem overflow? */ { @@ -394,10 +394,10 @@ _acmp(class, cx, cy); diff_nv = SvNV(tempx) - SvNV(tempy); if (diff_nv != 0) { - break; + break; } elemsx--; - } + } if (diff_nv > 0) { RETURN_MORTAL_INT(1); @@ -407,4 +407,3 @@ _acmp(class, cx, cy); RETURN_MORTAL_INT(-1); } ST(0) = sv_2mortal(newSViv(0)); /* X and Y are equal */ - diff --git a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm index 09409b883f..6520d721a9 100644 --- a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm +++ b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm @@ -4,9 +4,11 @@ use 5.006; use strict; use warnings; -use Math::BigInt::Calc 1.999706; +use Math::BigInt::Calc '1.999801'; -our $VERSION = '0.42'; +our @ISA = qw< Math::BigInt::Calc >; + +our $VERSION = '0.5002'; ############################################################################## # global constants, flags and accessory @@ -16,26 +18,8 @@ sub api_version () { 2; } # use Calc to override the methods that we do not provide in XS -for my $method (qw/ - str num - add sub mul div - rsft lsft - mod modpow modinv - gcd - pow root sqrt log_int fac nok - digit check - from_hex from_bin from_oct as_hex as_bin as_oct - zeros base_len - xor or and - alen 1ex - /) - { - no strict 'refs'; - *{'Math::BigInt::FastCalc::_' . $method} = \&{'Math::BigInt::Calc::_' . $method}; - } - require XSLoader; -XSLoader::load(__PACKAGE__, $VERSION, Math::BigInt::Calc::_base_len()); +XSLoader::load(__PACKAGE__, $VERSION, Math::BigInt::Calc->_base_len()); ############################################################################## ############################################################################## @@ -52,12 +36,23 @@ Math::BigInt::FastCalc - Math::BigInt::Calc with some XS for more speed =head1 SYNOPSIS + # to use it with Math::BigInt + use Math::BigInt lib => 'FastCalc'; + + # to use it with Math::BigFloat + use Math::BigFloat lib => 'FastCalc'; + + # to use it with Math::BigRat + use Math::BigRat lib => 'FastCalc'; + +=head1 DESCRIPTION + +Math::BigInt::FastCalc inherits from Math::BigInt::Calc. + Provides support for big integer calculations. Not intended to be used by other modules. Other modules which sport the same functions can also be used to support Math::BigInt, like L<Math::BigInt::GMP> or L<Math::BigInt::Pari>. -=head1 DESCRIPTION - In order to allow for multiple big integer libraries, Math::BigInt was rewritten to use library modules for core math routines. Any module which follows the same API as this can be used instead by using the following: @@ -69,13 +64,10 @@ version like 'Pari'. To use this library: use Math::BigInt lib => 'FastCalc'; -Note that from L<Math::BigInt> v1.76 onwards, FastCalc will be loaded -automatically, if possible. - =head1 STORAGE -FastCalc works exactly like Calc, in stores the numbers in decimal form, -chopped into parts. +Math::BigInt::FastCalc works exactly like Math::BigInt::Calc. Numbers are +stored in decimal form chopped into parts. =head1 METHODS @@ -161,11 +153,16 @@ Separated from BigInt and shaped API with the help of John Peacock. Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003. Further streamlining (api_version 1 etc.) by Tels 2004-2007. -Bug-fixing by Peter John Acklam E<lt>[email protected]<gt> 2010-2015. +Bug-fixing by Peter John Acklam E<lt>[email protected]<gt> 2010-2016. =head1 SEE ALSO -L<Math::BigInt>, L<Math::BigFloat>, and the other backends -L<Math::BigInt::Calc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. +L<Math::BigInt::Lib> for a description of the API. + +Alternative libraries L<Math::BigInt::Calc>, L<Math::BigInt::GMP>, and +L<Math::BigInt::Pari>. + +Some of the modules that use these libraries L<Math::BigInt>, +L<Math::BigFloat>, and L<Math::BigRat>. =cut diff --git a/cpan/Math-BigInt-FastCalc/t/bigintfc.t b/cpan/Math-BigInt-FastCalc/t/bigintfc.t index c8751ad81b..a3dd4a8d37 100644 --- a/cpan/Math-BigInt-FastCalc/t/bigintfc.t +++ b/cpan/Math-BigInt-FastCalc/t/bigintfc.t @@ -148,17 +148,17 @@ $x = $C->_new("123000"); is ($C->_zeros($x),3); $x = $C->_new("0"); is ($C->_zeros($x),0); # _lsft, _rsft -$x = $C->_new("10"); $y = $C->_new("3"); +$x = $C->_new("10"); $y = $C->_new("3"); is ($C->_str($C->_lsft($x,$y,10)),10000); -$x = $C->_new("20"); $y = $C->_new("3"); +$x = $C->_new("20"); $y = $C->_new("3"); is ($C->_str($C->_lsft($x,$y,10)),20000); $x = $C->_new("128"); $y = $C->_new("4"); is ($C->_str($C->_lsft($x,$y,2)), 128 << 4); -$x = $C->_new("1000"); $y = $C->_new("3"); +$x = $C->_new("1000"); $y = $C->_new("3"); is ($C->_str($C->_rsft($x,$y,10)),1); -$x = $C->_new("20000"); $y = $C->_new("3"); +$x = $C->_new("20000"); $y = $C->_new("3"); is ($C->_str($C->_rsft($x,$y,10)),20); $x = $C->_new("256"); $y = $C->_new("4"); is ($C->_str($C->_rsft($x,$y,2)),256 >> 4); @@ -211,13 +211,13 @@ $x = $C->_new("3333"); $y = $C->_new("1111"); is ($C->_str(scalar $C->_div($x,$y)),3); $x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y); is ($C->_str($x),30); is ($C->_str($y),3); -$x = $C->_new("123"); $y = $C->_new("1111"); +$x = $C->_new("123"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y); is ($C->_str($x),0); is ($C->_str($y),123); # _num foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) { - $x = $C->_new("$_"); + $x = $C->_new("$_"); is (ref($x),'ARRAY'); is ($C->_str($x),"$_"); $x = $C->_num($x); is (ref($x),''); is ($x,$_); } @@ -242,7 +242,7 @@ is ($C->_str($C->_pow($x,$n)), 1); $x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x is ($C->_str($C->_pow($x,$n)), 5); -$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441 +$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441 is ($C->_str($C->_pow($x,$n)),81 ** 3); is ($C->_str($C->_root($x,$n)),81); @@ -254,7 +254,7 @@ is ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 == is ($C->_str($C->_root($x,$n)),'531441'); is ($C->_str($C->_root($x,$n)),'81'); -$x = $C->_new("81"); $n = $C->_new("14"); +$x = $C->_new("81"); $n = $C->_new("14"); is ($C->_str($C->_pow($x,$n)),'523347633027360537213511521'); is ($C->_str($C->_root($x,$n)),'81'); @@ -274,7 +274,7 @@ for my $i (2 .. 9) my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1'; print "# _pow( ", '9' x $i, ", 2) \n" unless is ($C->_str($C->_pow($x,$n)),$rc); - + if ($i <= 7) { $x = '9' x $i; $x = $C->_new($x); @@ -333,11 +333,7 @@ foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/) $x = $C->_new("1000"); $C->_inc($x); is ($C->_str($x),'1001'); $C->_dec($x); is ($C->_str($x),'1000'); -my $BL; -{ - no strict 'refs'; - $BL = &{"$C"."::_base_len"}(); -} +my $BL = $C -> _base_len(); $x = '1' . '0' x $BL; $z = '1' . '0' x ($BL-1); $z .= '1'; @@ -427,4 +423,3 @@ is ($C->_check(123),'123 is not a reference'); # done 1; - diff --git a/cpan/Math-BigInt/t/biglog.t b/cpan/Math-BigInt-FastCalc/t/biglog.t similarity index 99% copy from cpan/Math-BigInt/t/biglog.t copy to cpan/Math-BigInt-FastCalc/t/biglog.t index b8af161f76..6c227e8e8a 100644 --- a/cpan/Math-BigInt/t/biglog.t +++ b/cpan/Math-BigInt-FastCalc/t/biglog.t @@ -16,7 +16,7 @@ use warnings; use Test::More tests => 73; -use Math::BigFloat; +use Math::BigFloat only => 'FastCalc'; use Math::BigInt; my $class = "Math::BigInt"; diff --git a/cpan/Math-BigInt/t/bigroot.t b/cpan/Math-BigInt-FastCalc/t/bigroot.t similarity index 97% copy from cpan/Math-BigInt/t/bigroot.t copy to cpan/Math-BigInt-FastCalc/t/bigroot.t index 9a6ab8a03d..c14bca1e2a 100644 --- a/cpan/Math-BigInt/t/bigroot.t +++ b/cpan/Math-BigInt-FastCalc/t/bigroot.t @@ -13,7 +13,7 @@ use warnings; # enable optional warnings use Test::More tests => 4 * 2; -use Math::BigFloat; +use Math::BigFloat only => 'FastCalc'; use Math::BigInt; my $mbf = "Math::BigFloat"; diff --git a/cpan/Math-BigInt-FastCalc/t/bootstrap.t b/cpan/Math-BigInt-FastCalc/t/bootstrap.t index d73afcb47c..6f94bebc88 100644 --- a/cpan/Math-BigInt-FastCalc/t/bootstrap.t +++ b/cpan/Math-BigInt-FastCalc/t/bootstrap.t @@ -5,4 +5,3 @@ use Test::More tests => 1; BEGIN { use_ok('Math::BigInt::FastCalc'); } - diff --git a/cpan/Math-BigInt-FastCalc/t/leak.t b/cpan/Math-BigInt-FastCalc/t/leak.t index 5db38e1dbd..6d0f7464a5 100644 --- a/cpan/Math-BigInt-FastCalc/t/leak.t +++ b/cpan/Math-BigInt-FastCalc/t/leak.t @@ -12,7 +12,9 @@ use Math::BigInt::FastCalc; ############################################################################# package Math::BigInt::FastCalc::LeakCheck; -use parent qw(Math::BigInt::FastCalc); + +use Math::BigInt::FastCalc; +our @ISA = qw< Math::BigInt::FastCalc >; my $destroyed = 0; sub DESTROY { $destroyed++; } @@ -76,4 +78,3 @@ sub _test_acmp my $n_2 = Math::BigInt::FastCalc->_str($n2); is ($destroyed, 1, "_acmp($n_1,$n_2) does not leak memory"); } - diff --git a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t index 4ad473d882..1186e2e144 100644 --- a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t +++ b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t @@ -1,55 +1,100 @@ -#!/usr/bin/perl -w +#!perl use strict; +use warnings; + use Test::More; my $count = 128; -plan(($^O eq 'os390') - ? (skip_all => 'takes too long on os390') : (tests => $count*2)); +plan(($^O eq 'os390') ? (skip_all => 'takes too long on os390') + : (tests => $count*4)); -use Math::BigInt lib => 'FastCalc'; -my $c = 'Math::BigInt'; +use Math::BigInt only => 'FastCalc'; my $length = 128; # If you get a failure here, please re-run the test with the printed seed -# value as input: perl t/mbi_rand.t seed +# value as input "perl t/mbi_rand.t seed" and send me the output + +my $seed = @ARGV == 1 ? $ARGV[0] : int(rand(1165537)); +#diag(" seed: $seed\n"); +srand($seed); + +my $_base_len; +my @_base_len; -my $seed = ($#ARGV == 0) ? $ARGV[0] : int(rand(65537)); -print "# seed: $seed\n"; srand($seed); +#diag(" lib: ", Math::BigInt->config('lib')); +if (Math::BigInt->config('lib') =~ /::Calc/) { + $_base_len = Math::BigInt::Calc->_base_len(); + @_base_len = Math::BigInt::Calc->_base_len(); + #diag("base len: $_base_len (scalar context)"); + #diag("base len: @_base_len (list contex)"); +} -my ($A,$B,$As,$Bs,$ADB,$AMB,$la,$lb); +my ($A, $B, $A_str, $B_str, $AdivB, $AmodB, $A_len, $B_len); my $two = Math::BigInt->new(2); -for (my $i = 0; $i < $count; $i++) - { - # length of A and B - $la = int(rand($length)+1); $lb = int(rand($length)+1); - $As = ''; $Bs = ''; - # we create the numbers from "patterns", e.g. get a random number and a - # random count and string them together. This means things like - # "100000999999999999911122222222" are much more likely. If we just strung - # together digits, we would end up with "1272398823211223" etc. - while (length($As) < $la) { $As .= int(rand(100)) x int(rand(16)); } - while (length($Bs) < $lb) { $Bs .= int(rand(100)) x int(rand(16)); } - $As =~ s/^0+//; $Bs =~ s/^0+//; - $As = $As || '0'; $Bs = $Bs || '0'; - # print "# As $As\n# Bs $Bs\n"; - $A = $c->new($As); $B = $c->new($Bs); - # print "# A $A\n# B $B\n"; - if ($A->is_zero() || $B->is_zero()) - { - is (1,1); is (1,1); next; +for (my $i = 0; $i < $count; $i++) { + #diag(""); + + # length of A and B + $A_len = int(rand($length) + 1); + $B_len = int(rand($length) + 1); + $A_str = ''; + $B_str = ''; + + # We create the numbers from "patterns", e.g. get a random number and a + # random count and string them together. This means things like + # "100000999999999999911122222222" are much more likely. If we just strung + # together digits, we would end up with "1272398823211223" etc. It also + # means that we get more frequently equal numbers or other special cases. + + while (length($A_str) < $A_len) { + $A_str .= int(rand(100)) x int(rand(16)); + } + while (length($B_str) < $B_len) { + $B_str .= int(rand(100)) x int(rand(16)); } - # check that int(A/B)*B + A % B == A holds for all inputs - # $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B); - ($ADB,$AMB) = $A->copy()->bdiv($B); - print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n" - unless is ($ADB*$B+$two*$AMB-$AMB,$As); - # swap 'em and try this, too - # $X = ($B/$A)*$A + $B % $A; - ($ADB,$AMB) = $B->copy()->bdiv($A); - print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n" - unless is ($ADB*$A+$two*$AMB-$AMB,$Bs); - } + $A_str =~ s/^0+(?=\d)//; + $B_str =~ s/^0+(?=\d)//; + #diag(" As: $A_str"); + #diag(" Bs: $B_str"); + $A = Math::BigInt->new($A_str); + $B = Math::BigInt->new($B_str); + #diag(" A: $A"); + #diag(" B: $B"); + + SKIP: { + skip '$A and/or $B are zero.', 4 if $A->is_zero() || $B->is_zero(); + + # check that int(A / B) * B + A % B == A holds for all inputs + + # $X = ($A / $B) * $B + 2 * ($A % $B) - ($A % $B); + + ($AdivB, $AmodB) = $A->copy()->bdiv($B); + + #diag(" A / B: $AdivB"); + #diag(" A % B: $AmodB"); + + is($AdivB * $B + $two * $AmodB - $AmodB, $A_str, + "AdivB * B + 2 * AmodB - AmodB == A"); + + if (is($AdivB * $B / $B, $AdivB, "AdivB * B / B == AdivB")) { + if (Math::BigInt->config('lib') =~ /::Calc/) { + #diag("AdivB->[-1]: ", $AdivB->{value}->[-1]); + #diag(" B->[-1]: ", $B->{value}->[-1]); + } + } + + # swap 'em and try this, too + # $X = ($B/$A)*$A + $B % $A; + ($AdivB, $AmodB) = $B->copy()->bdiv($A); + # print "check: $AdivB $AmodB"; + + is($AdivB * $A + $two * $AmodB - $AmodB, $B_str, + "AdivB * A + 2 * AmodB - AmodB == B"); + + is($AdivB * $A / $A, $AdivB, "AdivB * A / A == AdivB"); + } +} diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 190e2ee85a..415e0827fb 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.999727'; +our $VERSION = '1.999802'; $VERSION = eval $VERSION; require Exporter; @@ -218,7 +218,7 @@ $div_scale = 40; $upgrade = undef; $downgrade = undef; # the package we are using for our private parts, defaults to: -# Math::BigInt->config()->{lib} +# Math::BigInt->config('lib') my $MBI = 'Math::BigInt::Calc'; # are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config() @@ -481,7 +481,7 @@ sub new { if ($zeros != 0) { my $z = $MBI->_new($zeros); # turn '120e2' into '12e3' - $MBI->_rsft($self->{_m}, $z, 10); + $self->{_m} = $MBI->_rsft($self->{_m}, $z, 10); ($self->{_e}, $self->{_es}) = _e_add($self->{_e}, $z, $self->{_es}, '+'); } @@ -776,7 +776,7 @@ sub bzero { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bzero'); + return if $selfref && $self->modify('bzero'); $self = bless {}, $class unless $selfref; @@ -815,7 +815,7 @@ sub bone { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bone'); + return if $selfref && $self->modify('bone'); my $sign = shift; $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; @@ -866,7 +866,7 @@ sub binf { } $self->import() if $IMPORT == 0; # make require work - return if $self->modify('binf'); + return if $selfref && $self->modify('binf'); my $sign = shift; $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; @@ -902,7 +902,7 @@ sub bnan { } $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bnan'); + return if $selfref && $self->modify('bnan'); $self = bless {}, $class unless $selfref; @@ -1127,9 +1127,9 @@ sub as_number { my $z = $MBI->_copy($x->{_m}); if ($x->{_es} eq '-') { # < 0 - $MBI->_rsft($z, $x->{_e}, 10); + $z = $MBI->_rsft($z, $x->{_e}, 10); } elsif (! $MBI->_is_zero($x->{_e})) { # > 0 - $MBI->_lsft($z, $x->{_e}, 10); + $z = $MBI->_lsft($z, $x->{_e}, 10); } $z = Math::BigInt->new($x->{sign} . $MBI->_str($z)); $z; @@ -1317,8 +1317,8 @@ sub bcmp { # Now we can normalize the exponents by adding lengths of the mantissas. - $MBI->_add($ex, $MBI->_new($mxl)); - $MBI->_add($ey, $MBI->_new($myl)); + $ex = $MBI->_add($ex, $MBI->_new($mxl)); + $ey = $MBI->_add($ey, $MBI->_new($myl)); # We're done if the exponents are different. @@ -1469,10 +1469,10 @@ sub binc { } # now $x->{_e} == 0 if ($x->{sign} eq '+') { - $MBI->_inc($x->{_m}); + $x->{_m} = $MBI->_inc($x->{_m}); return $x->bnorm()->bround(@r); } elsif ($x->{sign} eq '-') { - $MBI->_dec($x->{_m}); + $x->{_m} = $MBI->_dec($x->{_m}); $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->bround(@r); } @@ -1499,14 +1499,14 @@ sub bdec { my $zero = $x->is_zero(); # <= 0 if (($x->{sign} eq '-') || $zero) { - $MBI->_inc($x->{_m}); + $x->{_m} = $MBI->_inc($x->{_m}); $x->{sign} = '-' if $zero; # 0 => 1 => -1 $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->round(@r); } # > 0 elsif ($x->{sign} eq '+') { - $MBI->_dec($x->{_m}); + $x->{_m} = $MBI->_dec($x->{_m}); return $x->bnorm()->round(@r); } # inf, nan handling etc @@ -1571,11 +1571,11 @@ sub badd { if ($es eq '-') # < 0 { - $MBI->_lsft($x->{_m}, $e, 10); + $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); } elsif (!$MBI->_is_zero($e)) # > 0 { - $MBI->_lsft($add, $e, 10); + $add = $MBI->_lsft($add, $e, 10); } # else: both e are the same, so just leave them @@ -1655,7 +1655,7 @@ sub bmul { ((!$x->isa($class)) || (!$y->isa($class))); # aEb * cEd = (a*c)E(b+d) - $MBI->_mul($x->{_m}, $y->{_m}); + $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! @@ -1692,7 +1692,7 @@ sub bmuladd { ((!$x->isa($class)) || (!$y->isa($class))); # aEb * cEd = (a*c)E(b+d) - $MBI->_mul($x->{_m}, $y->{_m}); + $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! @@ -1716,11 +1716,11 @@ sub bmuladd { if ($es eq '-') # < 0 { - $MBI->_lsft($x->{_m}, $e, 10); + $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); } elsif (!$MBI->_is_zero($e)) # > 0 { - $MBI->_lsft($add, $e, 10); + $add = $MBI->_lsft($add, $e, 10); } # else: both e are the same, so just leave them @@ -1889,8 +1889,8 @@ sub bdiv { # calculate the result to $scale digits and then round it # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) - $MBI->_lsft($x->{_m}, $MBI->_new($scale), 10); - $MBI->_div($x->{_m}, $y->{_m}); # a/c + $x->{_m} = $MBI->_lsft($x->{_m}, $MBI->_new($scale), 10); + $x->{_m} = $MBI->_div($x->{_m}, $y->{_m}); # a/c # correct exponent of $x ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); @@ -1991,7 +1991,7 @@ sub bmod { my $ym = $MBI->_copy($y->{_m}); # 2e1 => 20 - $MBI->_lsft($ym, $y->{_e}, 10) + $ym = $MBI->_lsft($ym, $y->{_e}, 10) if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e}); # if $y has digits after dot @@ -2000,7 +2000,7 @@ sub bmod { { # 123 % 2.5 => 1230 % 25 => 5 => 0.5 $shifty = $MBI->_num($y->{_e}); # no more digits after dot - $MBI->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25 + $x->{_m} = $MBI->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25 } # $ym is now mantissa of $y based on exponent 0 @@ -2009,17 +2009,17 @@ sub bmod { { # 123.4 % 20 => 1234 % 200 $shiftx = $MBI->_num($x->{_e}); # no more digits after dot - $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 + $ym = $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 } # 123e1 % 20 => 1230 % 20 if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) { - $MBI->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here + $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here } $x->{_e} = $MBI->_new($shiftx); $x->{_es} = '+'; $x->{_es} = '-' if $shiftx != 0 || $shifty != 0; - $MBI->_add($x->{_e}, $MBI->_new($shifty)) if $shifty != 0; + $x->{_e} = $MBI->_add($x->{_e}, $MBI->_new($shifty)) if $shifty != 0; # now mantissas are equalized, exponent of $x is adjusted, so calc result @@ -2126,7 +2126,7 @@ sub bpow { } sub blog { - my ($class, $x, $base, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + my ($class, $x, $base, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(2, @_); # If called as $x -> blog() or $x -> blog(undef), don't objectify the # undefined base, since undef signals that the base is Euler's number. @@ -2243,7 +2243,7 @@ sub blog { # stop right here. if (defined $base && $base->is_int() && $x->is_int()) { my $i = $MBI->_copy($x->{_m}); - $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); + $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); my $int = Math::BigInt->bzero(); $int->{value} = $i; $int->blog($base->as_number()); @@ -2705,7 +2705,7 @@ sub batan { $self->{_es} = $pi->{_es}; # -y => -PI/2, +y => PI/2 $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+" - $MBI->_div($self->{_m}, $MBI->_new(2)); + $self -> {_m} = $MBI->_div($self->{_m}, $MBI->_new(2)); return $self; } @@ -2734,7 +2734,7 @@ sub batan { $self->{_e} = $pi->{_e}; $self->{_es} = $pi->{_es}; # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4) - $MBI->_div($self->{_m}, $MBI->_new(4)); + $self->{_m} = $MBI->_div($self->{_m}, $MBI->_new(4)); return $self; } @@ -2745,7 +2745,7 @@ sub batan { if ($self->bacmp($self->copy()->bone) >= 0) { # calculate PI/2 $pi = $class->bpi($scale - 3); - $MBI->_div($pi->{_m}, $MBI->_new(2)); + $pi->{_m} = $MBI->_div($pi->{_m}, $MBI->_new(2)); # calculate 1/$self: my $self_copy = $self->copy(); # modify $self in place @@ -2968,7 +2968,7 @@ sub bsqrt { local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI my $i = $MBI->_copy($x->{_m}); - $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); + $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); my $xas = Math::BigInt->bzero(); $xas->{value} = $i; @@ -3030,7 +3030,7 @@ sub bsqrt { # after the dot (the result is still odd or even digits long). $s2++ if $MBI->_is_odd($x->{_e}); - $MBI->_lsft($y1, $MBI->_new($s2), 10); + $y1 = $MBI->_lsft($y1, $MBI->_new($s2), 10); # now take the square root and truncate to integer $y1 = $MBI->_sqrt($y1); @@ -3160,7 +3160,7 @@ sub broot { my $done = 0; # not yet if ($y->is_int() && $x->is_int()) { my $i = $MBI->_copy($x->{_m}); - $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); + $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); my $int = Math::BigInt->bzero(); $int->{value} = $i; $int->broot($y->as_number()); @@ -3217,11 +3217,11 @@ sub bfac { # use BigInt's bfac() for faster calc if (! $MBI->_is_zero($x->{_e})) { - $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 + $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 $x->{_e} = $MBI->_zero(); # normalize $x->{_es} = '+'; } - $MBI->_fac($x->{_m}); # calculate factorial + $x->{_m} = $MBI->_fac($x->{_m}); # calculate factorial $x->bnorm()->round(@r); # norm again and round result } @@ -3531,7 +3531,6 @@ sub bfloor { my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bfloor'); - return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after dot @@ -3539,7 +3538,7 @@ sub bfloor { $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot $x->{_e} = $MBI->_zero(); # trunc/norm $x->{_es} = '+'; # abs e - $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative + $x->{_m} = $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative } $x->round($a, $p, $r); } @@ -3557,7 +3556,7 @@ sub bceil { $x->{_e} = $MBI->_zero(); # trunc/norm $x->{_es} = '+'; # abs e if ($x->{sign} eq '+') { - $MBI->_inc($x->{_m}); # increment if positive + $x->{_m} = $MBI->_inc($x->{_m}); # increment if positive } else { $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0 } @@ -3590,43 +3589,53 @@ sub bgcd { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object - my $y = shift; - $y = __PACKAGE__->new($y) if !ref($y); - my $class = ref($y); - my $x = $y->copy()->babs(); # keep arguments + unshift @_, __PACKAGE__ + unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i; - return $x->bnan() if $x->{sign} !~ /^[+-]$/ # x NaN? - || !$x->is_int(); # only for integers now + my ($class, @args) = objectify(0, @_); - while (@_) { - my $t = shift; - $t = $class->new($t) if !ref($t); - $y = $t->copy()->babs(); + my $x = shift @args; + $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); + return $class->bnan() unless $x -> is_int(); - return $x->bnan() if $y->{sign} !~ /^[+-]$/ # y NaN? - || !$y->is_int(); # only for integers now + while (@args) { + my $y = shift @args; + $y = $class->new($y) unless ref($y) && $y -> isa($class); + return $class->bnan() unless $y -> is_int(); # greatest common divisor while (! $y->is_zero()) { ($x, $y) = ($y->copy(), $x->copy()->bmod($y)); } - last if $x->is_one(); + last if $x -> is_one(); } - $x; + return $x -> babs(); } sub blcm { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT # does not modify arguments, but returns new object - # Lowest Common Multiplicator + # Least Common Multiple + + unshift @_, __PACKAGE__ + unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i; - my ($class, @arg) = objectify(0, @_); - my $x = $class->new(shift @arg); - while (@arg) { - $x = Math::BigInt::__lcm($x, shift @arg); + my ($class, @args) = objectify(0, @_); + + my $x = shift @args; + $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); + return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? + + while (@args) { + my $y = shift @args; + $y = $class -> new($y) unless ref($y) && $y -> isa($class); + return $x->bnan() unless $y -> is_int(); + my $gcd = $x -> bgcd($y); + $x -> bdiv($gcd) -> bmul($y); } - $x; + + return $x -> babs(); } ############################################################################### @@ -3871,10 +3880,10 @@ my $dot = '.'; if ($e <= -$len) { my $r = abs($e) - $len; $es = '0.'. ('0' x $r) . $es; -$cad = -($len+$r); + $cad = -($len+$r); } else { substr($es, $e, 0) = '.'; -$cad = $MBI->_num($x->{_e}); + $cad = $MBI->_num($x->{_e}); $cad = -$cad if $x->{_es} eq '-'; } } elsif ($e > 0) { @@ -3990,7 +3999,7 @@ sub as_hex { my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) { # > 0 - $MBI->_lsft($z, $x->{_e}, 10); + $z = $MBI->_lsft($z, $x->{_e}, 10); } $z = Math::BigInt->new($x->{sign} . $MBI->_num($z)); $z->as_hex(); @@ -4007,7 +4016,7 @@ sub as_oct { my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) { # > 0 - $MBI->_lsft($z, $x->{_e}, 10); + $z = $MBI->_lsft($z, $x->{_e}, 10); } $z = Math::BigInt->new($x->{sign} . $MBI->_num($z)); $z->as_oct(); @@ -4024,7 +4033,7 @@ sub as_bin { my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) { # > 0 - $MBI->_lsft($z, $x->{_e}, 10); + $z = $MBI->_lsft($z, $x->{_e}, 10); } $z = Math::BigInt->new($x->{sign} . $MBI->_num($z)); $z->as_bin(); @@ -4091,7 +4100,7 @@ my @a; $lib =~ tr/a-zA-Z0-9,://cd; # restrict to sane characters # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work - my $mbilib = eval { Math::BigInt->config()->{lib} }; + my $mbilib = eval { Math::BigInt->config('lib') }; if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc')) { # MBI already loaded Math::BigInt->import($lib_kind, "$lib, $mbilib", 'objectify'); @@ -4111,7 +4120,7 @@ my @a; Carp::croak("Couldn't load $lib: $! $@"); } # find out which one was actually loaded - $MBI = Math::BigInt->config()->{lib}; + $MBI = Math::BigInt->config('lib'); # register us with MBI to get notified of future lib changes Math::BigInt::_register_callback($class, sub { $MBI = $_[0]; }); @@ -4794,7 +4803,7 @@ If the string can not be interpreted, NaN is returned. Octal numbers are typically prefixed by "0", but since leading zeros are stripped, these methods can not automatically recognize octal numbers, so use -the constructor from_oct() to intepret octal strings. +the constructor from_oct() to interpret octal strings. Some examples of valid string input diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 24b14c4061..39001e9f44 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.999727'; +our $VERSION = '1.999802'; $VERSION = eval $VERSION; our @ISA = qw(Exporter); @@ -54,7 +54,6 @@ use overload '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) : $_[0] -> copy -> bdiv($_[1]); }, - '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) : $_[0] -> copy -> bmod($_[1]); }, @@ -414,7 +413,7 @@ sub precision { sub config { # return (or set) configuration data as hash ref - my $class = shift || 'Math::BigInt'; + my $class = shift || __PACKAGE__; no strict 'refs'; if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH'))) { @@ -880,7 +879,7 @@ sub bzero { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bzero'); + return if $selfref && $self->modify('bzero'); $self = bless {}, $class unless $selfref; @@ -917,7 +916,7 @@ sub bone { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bzero'); + return if $selfref && $self->modify('bone'); my $sign = shift; $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; @@ -966,7 +965,7 @@ sub binf { } $self->import() if $IMPORT == 0; # make require work - return if $self->modify('binf'); + return if $selfref && $self->modify('binf'); my $sign = shift; $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; @@ -1000,7 +999,7 @@ sub bnan { } $self->import() if $IMPORT == 0; # make require work - return if $self->modify('bnan'); + return if $selfref && $self->modify('bnan'); $self = bless {}, $class unless $selfref; @@ -2343,13 +2342,13 @@ sub blog { my ($class, $x, $base, @r) = (undef, @_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $base, @r) = objectify(1, @_); + ($class, $x, $base, @r) = objectify(2, @_); } return $x if $x->modify('blog'); - # Handle all exception cases and all trivial cases. I have used Wolfram Alpha - # (http://www.wolframalpha.com) as the reference for these cases. + # Handle all exception cases and all trivial cases. I have used Wolfram + # Alpha (http://www.wolframalpha.com) as the reference for these cases. return $x -> bnan() if $x -> is_nan(); @@ -3094,41 +3093,43 @@ sub bgcd { # does not modify arguments, but returns new object # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff) - my $y = shift; - $y = $class->new($y) if !ref($y); - my $class = ref($y); - my $x = $y->copy()->babs(); # keep arguments - return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? + my ($class, @args) = objectify(0, @_); + + my $x = shift @args; + $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); + + return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? - while (@_) { - $y = shift; - $y = $class->new($y) if !ref($y); - return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? + while (@args) { + my $y = shift @args; + $y = $class->new($y) unless ref($y) && $y -> isa($class); + return $class->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? $x->{value} = $CALC->_gcd($x->{value}, $y->{value}); last if $CALC->_is_one($x->{value}); } - $x; + + return $x -> babs(); } sub blcm { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object - # Lowest Common Multiple + # Least Common Multiple - my $y = shift; - my ($x); - if (ref($y)) { - $x = $y->copy(); - } else { - $x = $class->new($y); - } - my $class = ref($x); - while (@_) { - my $y = shift; - $y = $class->new($y) if !ref ($y); - $x = __lcm($x, $y); + my ($class, @args) = objectify(0, @_); + + my $x = shift @args; + $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); + return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? + + while (@args) { + my $y = shift @args; + $y = $class -> new($y) unless ref($y) && $y -> isa($class); + return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y not integer + $x -> {value} = $CALC->_lcm($x -> {value}, $y -> {value}); } - $x; + + return $x -> babs(); } ############################################################################### @@ -3576,6 +3577,13 @@ sub objectify { } for my $i (1 .. $count) { + + # Don't do anything with undefs. This special treatment is necessary + # because blog() might have a second operand which is undef, to signify + # that the default Euler base should be used. + + next unless defined $a[$i]; + my $ref = ref $a[$i]; # Perl scalars are fed to the appropriate constructor. @@ -4021,21 +4029,6 @@ sub _find_round_parameters { ($self, $a, $p, $r); } -############################################################################## -# internal calculation routines (others are in Math::BigInt::Calc etc) - -sub __lcm { - # (BINT or num_str, BINT or num_str) return BINT - # does modify first argument - # LCM - - my ($x, $ty) = @_; - return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan); - my $method = ref($x) . '::bgcd'; - no strict 'refs'; - $x * $ty / &$method($x, $ty); -} - ############################################################################### # this method returns 0 if the object can be modified, or 1 if not. # We use a fast constant sub() here, to avoid costly calls. Subclasses @@ -4434,6 +4427,7 @@ This is used for instance by L<Math::BigInt::Constant>. print Dumper ( Math::BigInt->config() ); print Math::BigInt->config()->{lib},"\n"; + print Math::BigInt->config('lib')},"\n"; Returns a hash containing the configuration, e.g. the version number, lib loaded etc. The following hash keys are currently filled in with the diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 81146dfa6f..aca84b5361 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -4,9 +4,14 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999727'; +use Carp; +use Math::BigInt::Lib; + +our $VERSION = '1.999802'; $VERSION = eval $VERSION; +our @ISA = ('Math::BigInt::Lib'); + # Package to store unsigned big integers in decimal and do math with them # Internally the numbers are stored in an array with at least 1 element, no @@ -43,9 +48,8 @@ sub _base_len { # Set/get the BASE_LEN and assorted other, related values. # Used only by the testsuite, the set variant is used only by the BEGIN # block below: - shift; - my ($b, $int) = @_; + my ($class, $b, $int) = @_; if (defined $b) { # avoid redefinitions undef &_mul; @@ -99,7 +103,7 @@ sub _new { # of integers, where each integer represents a chunk of the original input # integer. - my ($proto, $str) = @_; + my ($class, $str) = @_; #unless ($str =~ /^([1-9]\d*|0)\z/) { # require Carp; # Carp::croak("Invalid input string '$str'"); @@ -108,13 +112,14 @@ sub _new { my $input_len = length($str) - 1; # Shortcut for small numbers. - return [ $str ] if $input_len < $BASE_LEN; + return bless [ $str ], $class 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)*"; - [ reverse(map { 0 + $_ } unpack($format, $str)) ]; + my $self = [ reverse(map { 0 + $_ } unpack($format, $str)) ]; + return bless $self, $class; } BEGIN { @@ -131,7 +136,7 @@ BEGIN { # the test should be able to find the proper $e automatically $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work - # there, but we play safe) + # there, but we play safe) my $int = 0; if ($e > 7) { @@ -149,7 +154,7 @@ BEGIN { } } - __PACKAGE__ -> _base_len($e, $int); # set and store + __PACKAGE__ -> _base_len($e, $int); # set and store use integer; # find out how many bits _and, _or and _xor can take (old default = 16) @@ -207,36 +212,43 @@ BEGIN { sub _zero { # create a zero - [ 0 ]; + my $class = shift; + return bless [ 0 ], $class; } sub _one { # create a one - [ 1 ]; + my $class = shift; + return bless [ 1 ], $class; } sub _two { - # create a two (used internally for shifting) - [ 2 ]; + # create a two + my $class = shift; + return bless [ 2 ], $class; } sub _ten { - # create a 10 (used internally for shifting) - [ 10 ]; + # create a 10 + my $class = shift; + bless [ 10 ], $class; } sub _1ex { # create a 1Ex - my $rem = $_[1] % $BASE_LEN; # remainder - my $parts = $_[1] / $BASE_LEN; # parts + my $class = shift; + + my $rem = $_[0] % $BASE_LEN; # remainder + my $parts = $_[0] / $BASE_LEN; # parts # 000000, 000000, 100 - [ (0) x $parts, '1' . ('0' x $rem) ]; + bless [ (0) x $parts, '1' . ('0' x $rem) ], $class; } sub _copy { # make a true copy - [ @{$_[1]} ]; + my $class = shift; + return bless [ @{ $_[0] } ], $class; } # catch and throw away @@ -260,13 +272,11 @@ sub _str { # Handle first one differently, since it should not have any leading zeros. my $ret = int($ary->[$idx]); if ($idx > 0) { - $idx--; # Interestingly, the pre-padd method uses more time. # The old grep variant takes longer (14 vs. 10 sec). my $z = '0' x ($BASE_LEN - 1); - while ($idx >= 0) { + while (--$idx >= 0) { $ret .= substr($z . $ary->[$idx], -$BASE_LEN); - $idx--; } } $ret; @@ -502,7 +512,7 @@ sub _mul_use_div_64 { 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); @@ -562,7 +572,7 @@ sub _mul_use_div { 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); @@ -602,9 +612,10 @@ sub _div_use_mul { if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { - my $r = [ $x->[0] % $yorg->[0] ]; + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $r); + return ($x, $rem); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; @@ -614,7 +625,7 @@ sub _div_use_mul { # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; - $rem = _mod($c, [ @$x ], $yorg) if wantarray; + $rem = $c->_mod($c->_copy($x), $yorg) if wantarray; # shortcut, $y is < $BASE my $j = @$x; @@ -636,7 +647,7 @@ 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 + $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 @@ -644,11 +655,11 @@ sub _div_use_mul { # 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 = [ @$x ] if wantarray; # make copy + my $rem = $c->_copy($x) if wantarray; # make copy @$x = 0; # set to 0 return ($x, $rem) if wantarray; # including remainder? return $x; @@ -667,8 +678,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 = [ @$x ] if $a != 0; # a < 0 => x < y => rem = x + # 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; @@ -680,7 +692,7 @@ sub _div_use_mul { # all other cases: - my $y = [ @$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, @d, $tmp, $q, $u2, $u1, $u0); @@ -729,19 +741,18 @@ sub _div_use_mul { unshift(@q, $q); } if (wantarray) { - @d = (); + my $d = bless [], $c; if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL - unshift(@d, $tmp); + unshift(@$d, $tmp); } } else { - @d = @$x; + @$d = @$x; } @$x = @q; - my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x, $d); @@ -768,9 +779,10 @@ sub _div_use_div_64 { if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { - my $r = [ $x->[0] % $yorg->[0] ]; + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $r); + return ($x, $rem); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; @@ -779,7 +791,7 @@ sub _div_use_div_64 { # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; - $rem = _mod($c, [ @$x ], $yorg) if wantarray; + $rem = $c->_mod($c->_copy($x), $yorg) if wantarray; # shortcut, $y is < $BASE my $j = @$x; @@ -800,7 +812,7 @@ 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 + $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 @@ -812,7 +824,7 @@ sub _div_use_div_64 { # 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 + $rem = $c->_copy($x) if wantarray; # make copy @$x = 0; # set to 0 return ($x, $rem) if wantarray; # including remainder? return $x; @@ -832,21 +844,20 @@ sub _div_use_div_64 { # $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 + $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; } # $x >= $y, so proceed normally - } } # all other cases: - my $y = [ @$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, @d, $tmp, $q, $u2, $u1, $u0); @@ -899,19 +910,18 @@ sub _div_use_div_64 { unshift(@q, $q); } if (wantarray) { - @d = (); + my $d = bless [], $c; if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@d, $tmp); + unshift(@$d, $tmp); } } else { - @d = @$x; + @$d = @$x; } @$x = @q; - my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x, $d); @@ -936,9 +946,10 @@ sub _div_use_div { if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { - my $r = [ $x->[0] % $yorg->[0] ]; + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $r); + return ($x, $rem); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; @@ -947,7 +958,7 @@ sub _div_use_div { # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; - $rem = _mod($c, [ @$x ], $yorg) if wantarray; + $rem = $c->_mod($c->_copy($x), $yorg) if wantarray; # shortcut, $y is < $BASE my $j = @$x; @@ -968,7 +979,7 @@ 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 + $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 @@ -980,7 +991,7 @@ 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 + $rem = $c->_copy($x) if wantarray; # make copy @$x = 0; # set to 0 return ($x, $rem) if wantarray; # including remainder? return $x; @@ -1000,8 +1011,8 @@ 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 + $rem = $c->_zero(); # a = 0 => x == y => rem 0 + $rem = $c->_copy($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 @@ -1015,7 +1026,7 @@ sub _div_use_div { # all other cases: - my $y = [ @$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, @d, $tmp, $q, $u2, $u1, $u0); @@ -1068,19 +1079,18 @@ sub _div_use_div { unshift(@q, $q); } if (wantarray) { - @d = (); + my $d = bless [], $c; if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@d, $tmp); + unshift(@$d, $tmp); } } else { - @d = @$x; + @$d = @$x; } @$x = @q; - my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x, $d); @@ -1237,11 +1247,21 @@ sub __strip_zeros { sub _check { # used by the test suite - my $x = $_[1]; + my ($class, $x) = @_; + + my $msg = $class -> SUPER::_check($x); + return $msg if $msg; - return "Undefined" unless defined $x; - return "$x is not a reference" unless ref($x); - return "Not an ARRAY reference" unless ref($x) eq 'ARRAY'; + my $n; + eval { $n = @$x }; + return "Not an array reference" unless $@ eq ''; + + return "Reference to an empty array" unless $n > 0; + + # The following fails with Math::BigInt::FastCalc because a + # Math::BigInt::FastCalc "object" is an unblessed array ref. + # + #return 0 unless ref($x) eq $class; for (my $i = 0 ; $i <= $#$x ; ++ $i) { my $e = $x -> [$i]; @@ -1253,17 +1273,14 @@ sub _check { "', which is not a scalar" unless ref($e) eq ""; + # It would be better to use the regex /^([1-9]\d*|0)\z/, but that fails + # in Math::BigInt::FastCalc, because it sometimes creates array + # elements like "000000". 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; + " normal integer" unless $e =~ /^\d+\z/; return "Element at index $i is '$e', which is not smaller than" . - " the base '$BASE'" - if $e >= $BASE; + " the base '$BASE'" if $e >= $BASE; return "Element at index $i (last element) is zero" if $#$x > 0 && $i == $#$x && $e == 0; @@ -1280,7 +1297,7 @@ sub _mod { # slow way since $y too big if (@$yo > 1) { - my ($xo, $rem) = _div($c, $x, $yo); + my ($xo, $rem) = $c->_div($x, $yo); @$x = @$rem; return $x; } @@ -1337,14 +1354,14 @@ sub _rsft { my ($c, $x, $y, $n) = @_; if ($n != 10) { - $n = _new($c, $n); - return scalar _div($c, $x, _pow($c, $n, $y)); + $n = $c->_new($n); + return scalar $c->_div($x, $c->_pow($n, $y)); } # shortcut (faster) for shifting by 10) # multiples of $BASE_LEN my $dst = 0; # destination - my $src = _num($c, $y); # as normal int + my $src = $c->_num($y); # as normal int my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1])); if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) { # 12345 67890 shifted right by more than 10 digits => 0 @@ -1379,7 +1396,7 @@ sub _rsft { sub _lsft { my ($c, $x, $n, $b) = @_; - return $x if _is_zero($c, $x); + 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 @@ -1388,12 +1405,12 @@ sub _lsft { my $log10 = sprintf "%.0f", log($b) / log(10); if ($b == 10 ** $log10) { $b = 10; - $n = _mul($c, $n, _new($c, $log10)); + $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 = _num($c, $n); # shift-len as normal int + 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 @@ -1418,9 +1435,9 @@ sub _lsft { splice @$x, -1 if $x->[-1] == 0; return $x; } else { - $b = _new($c, $b); + $b = $c->_new($b); #print $c->_str($b); - return _mul($c, $x, _pow($c, $b, $n)); + return $c->_mul($x, $c->_pow($b, $n)); } } @@ -1447,17 +1464,17 @@ sub _pow { return $cx; } - my $pow2 = _one(); + my $pow2 = $c->_one(); - my $y_bin = _as_bin($c, $cy); + my $y_bin = $c->_as_bin($cy); $y_bin =~ s/^0b//; my $len = length($y_bin); while (--$len > 0) { - _mul($c, $pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd? - _mul($c, $cx, $cx); + $c->_mul($pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd? + $c->_mul($cx, $cx); } - _mul($c, $cx, $pow2); + $c->_mul($cx, $pow2); $cx; } @@ -1472,9 +1489,9 @@ sub _nok { # nok(n, n-k), to minimize the number if iterations in the loop. { - my $twok = _mul($c, _two($c), _copy($c, $k)); # 2 * k - if (_acmp($c, $twok, $n) > 0) { # if 2*k > n - $k = _sub($c, _copy($c, $n), $k); # k = n - k + my $twok = $c->_mul($c->_two(), $c->_copy($k)); # 2 * k + if ($c->_acmp($twok, $n) > 0) { # if 2*k > n + $k = $c->_sub($c->_copy($n), $k); # k = n - k } } @@ -1484,37 +1501,37 @@ sub _nok { # | | = --------- = --------------- = --------- = 5 * - * - # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 - if (_is_zero($c, $k)) { + if ($c->_is_zero($k)) { @$n = 1; } else { # Make a copy of the original n, since we'll be modifying n in-place. - my $n_orig = _copy($c, $n); + my $n_orig = $c->_copy($n); # n = 5, f = 6, d = 2 (cf. example above) - _sub($c, $n, $k); - _inc($c, $n); + $c->_sub($n, $k); + $c->_inc($n); - my $f = _copy($c, $n); - _inc($c, $f); + my $f = $c->_copy($n); + $c->_inc($f); - my $d = _two($c); + my $d = $c->_two(); # while f <= n (the original n, that is) ... - while (_acmp($c, $f, $n_orig) <= 0) { + while ($c->_acmp($f, $n_orig) <= 0) { # n = (n * f / d) == 5 * 6 / 2 (cf. example above) - _mul($c, $n, $f); - _div($c, $n, $d); + $c->_mul($n, $f); + $c->_div($n, $d); # f = 7, d = 3 (cf. example above) - _inc($c, $f); - _inc($c, $d); + $c->_inc($f); + $c->_inc($d); } } @@ -1561,7 +1578,7 @@ sub _fac { my $zero_elements = 0; # If n is even, set n = n -1 - my $k = _num($c, $cx); + my $k = $c->_num($cx); my $even = 1; if (($k & 1) == 0) { $even = $k; @@ -1576,13 +1593,13 @@ sub _fac { my $sum = 1; my $i = $k - 1; # keep reference to x - my $new_x = _new($c, $k * $even); + my $new_x = $c->_new($k * $even); @$cx = @$new_x; if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } - # print STDERR "x = ", _str($c, $cx), "\n"; + # print STDERR "x = ", $c->_str($cx), "\n"; my $BASE2 = int(sqrt($BASE))-1; my $j = 1; while ($j <= $i) { @@ -1598,15 +1615,15 @@ sub _fac { # print STDERR "\n k2 $k2 m $m sum $sum odd $odd\n"; sleep(1); } if ($m < $BASE) { - _mul($c, $cx, [$m]); + $c->_mul($cx, [$m]); } else { - _mul($c, $cx, $c->_new($m)); + $c->_mul($cx, $c->_new($m)); } if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } - # print STDERR "Calculate $k2 - $sum = $m (x = ", _str($c, $cx), ")\n"; + # print STDERR "Calculate $k2 - $sum = $m (x = ", $c->_str($cx), ")\n"; } # multiply in the zeros again unshift @$cx, (0) x $zero_elements; @@ -1637,7 +1654,7 @@ sub _fac { if (@$cx == 1) { $n = $cx->[0]; } else { - $n = _copy($c, $cx); + $n = $c->_copy($cx); } # Set $cx to the last result below $BASE (but keep ref to $x) @@ -1661,16 +1678,16 @@ sub _fac { } my $b = $step * ($step + 1); $step += 2; - _mul($c, $cx, [$b]); + $c->_mul($cx, [$b]); } $step = [$step]; - while (_acmp($c, $step, $n) <= 0) { + while ($c->_acmp($step, $n) <= 0) { if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } - _mul($c, $cx, $step); - _inc($c, $step); + $c->_mul($cx, $step); + $c->_inc($step); } } else { # Yes, so we can speed it up slightly @@ -1689,7 +1706,7 @@ sub _fac { $step += 2; $b *= $step * ($step + 1); $step += 2; - _mul($c, $cx, [$b]); + $c->_mul($cx, [$b]); } my $base_2 = int(sqrt($BASE)) - 1; my $n2 = $n - 2; @@ -1701,11 +1718,11 @@ sub _fac { } my $b = $step * ($step + 1); $step += 2; - _mul($c, $cx, [$b]); + $c->_mul($cx, [$b]); } # do what's left over while ($step <= $n) { - _mul($c, $cx, [$step]); + $c->_mul($cx, [$step]); $step++; if ($cx->[0] == 0) { $zero_elements ++; @@ -1735,7 +1752,7 @@ sub _log_int { return $x, 1; } - my $cmp = _acmp($c, $x, $base); + my $cmp = $c->_acmp($x, $base); # X == BASE => 1 (is exact) if ($cmp == 0) { @@ -1749,11 +1766,11 @@ sub _log_int { return $x, 0; } - my $x_org = _copy($c, $x); # preserve x + my $x_org = $c->_copy($x); # preserve x # Compute a guess for the result based on: # $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) ) - my $len = _len($c, $x_org); + my $len = $c->_len($x_org); my $log = log($base->[-1]) / log(10); # for each additional element in $base, we add $BASE_LEN to the result, @@ -1765,8 +1782,8 @@ sub _log_int { my $res = int($len / $log); @$x = $res; - my $trial = _pow($c, _copy($c, $base), $x); - my $acmp = _acmp($c, $trial, $x_org); + my $trial = $c->_pow($c->_copy($base), $x); + my $acmp = $c->_acmp($trial, $x_org); # Did we get the exact result? @@ -1775,17 +1792,17 @@ sub _log_int { # Too small? while ($acmp < 0) { - _mul($c, $trial, $base); - _inc($c, $x); - $acmp = _acmp($c, $trial, $x_org); + $c->_mul($trial, $base); + $c->_inc($x); + $acmp = $c->_acmp($trial, $x_org); } # Too big? while ($acmp > 0) { - _div($c, $trial, $base); - _dec($c, $x); - $acmp = _acmp($c, $trial, $x_org); + $c->_div($trial, $base); + $c->_dec($x); + $acmp = $c->_acmp($trial, $x_org); } return $x, 1 if $acmp == 0; # result is exact @@ -1808,10 +1825,10 @@ sub _sqrt { $x->[0] = int(sqrt($x->[0])); return $x; } - my $y = _copy($c, $x); + my $y = $c->_copy($x); # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess # since our guess will "grow" - my $l = int((_len($c, $x)-1) / 2); + my $l = int(($c->_len($x)-1) / 2); my $lastelem = $x->[-1]; # for guess my $elems = @$x - 1; @@ -1826,7 +1843,7 @@ sub _sqrt { print "$lastelem\n" if DEBUG; } **** PATCH TRUNCATED AT 2000 LINES -- 5683 NOT SHOWN **** -- Perl5 Master Repository
