diff options
| author | Richard Leach <richardleach@users.noreply.github.com> | 2021-11-19 21:37:48 +0000 |
|---|---|---|
| committer | Richard Leach <richardleach@users.noreply.github.com> | 2021-11-19 21:37:48 +0000 |
| commit | 6853e8af3bcdae27c05a50e71c8ede1ab2b42822 (patch) | |
| tree | 77213230b2a506aeab7d2f43f56eb5856933f5a3 | |
| parent | 4c4a89ed9c56cf3cb024f4ed67e9be031b5960cf (diff) | |
| download | perl-6853e8af3bcdae27c05a50e71c8ede1ab2b42822.tar.gz | |
Update bignum, Math::BigInt, Math::BigInt::FastCalc, and Math::BigRat
bignum
======
0.63 2021-10-08
* This version instroduces no changes to the Perl modules, only the
tests.
* Remove tests that don't work on old Perls and that were actually
testing
Math::Big(Int|Float|Rat) more than big(int|num|rat).
* Skip tests that don't work on older versions of Perl.
* Remove Perl v5.10.0 as dependency. This distribution is compatible
with
Perls back to at least v5.6.1, although some functionality
(e.g., nesting the pragmas) requires more recent versions of Perl.
0.62 2021-10-03
* Add support for multiple options in import(), so that one can use,
e.g.,
use bignum accuracy => 20, lib => "GMP";
* Make sure the bigrat pragma always returns Math::BigRat objects.
* Make the "trace" option work as indended, or at least according to
what I
believe is the intention.
* Improve documentation. Fix typos, improve wording, add more examples
etc.
0.61 2021-10-01
* Improve documentation related to floating point literals.
* Skip tests that fail due to Perl's broken handling of floating point
literals before v5.32.0.
0.60 2021-09-28
* Separate the bigint, bignum, and bigrat pragmas.
- The bigint pragma now converts every numeric constant that
represents an
integer to a Math::BigInt object. Non-integers are converted to
Math::BigInt NaNs. With the previous behaviour, only some numeric
constant integers were converted to a Math::BigInt.
- The bignum pragma now converts every numeric constant to a
Math::BigFloat
object.
- The bigrat pragma now converts every numeric constant to a
Math::BigRat
pragma.
The pragmas no longer activate upgrading and downgrading. The
upgrading and
downgrading must now be activated explicitly. The rationale behind
deactivating it by default is that can cause infinite looping where
objects
bounce back and forth between different classes. Explicitly
requesting a
specific class doesn't always work either, because the object might
be
automatically upgraded or downgraded to a different class.
Only one pragma can be used at a time in a given scope. Enabling one
pragma
disables the others in the same scope.
* Implementat working version of "no bigint", "no bignum", and "no
bigrat".
Previously, the upgrading and downgrading activated by, e.g., "use
bigint"
was not deactivated by "no bigint".
* Sync behaviour with the Math-BigInt distribution.
Math::BigInt
============
1.999827 2021-10-03
* Improve error message for missing library argument.
* Skip tests that don't work on older Perls. Also skip tests that
compare
floating point numbers.
1.999826 2021-10-01
* Improve documentation related to floating point literals.
* Skip tests that fail due to Perl's broken handling of floating point
literals before v5.32.0.
1.999825 2021-09-28
* Make Math::BigInt accept integers regardless of whether they are
written as
decimal, binary, octal, or hexadecimal integers or decimal, binary,
octal,
or hexadecimal floating point number.
* When numeric constants are overloaded (with the ":constant" option)
in
Math::BigInt, every numeric constant that represent an integer is
converted
to an object regardless of how it is written. All finite non-integers
are
converted to a NaN.
* When numeric constants are overloaded (with the ":constant" option)
in
Math::BigFloat, every numeric constant is converted to an object
regardless
of how it is written.
* Add method from_dec() (cf. from_bin(), from_oct(), and from_hex()).
It is
like new() except that it does not accept anything but a string
representing a finite decimal number.
1.999824 2021-09-20
* Don't allow mixing math libraries. Use the first backend math library
that
is successfully loaded, and ignore any further attempts at loading a
different backend library. This is a solution to the re-occurring
problem
of using objects using different math libraries.
* Add missing documentation.
* Miscellaneous minor improvements.
Math::BigInt::FastCalc
======================
0.5012 2021-09-28
* Sync test files with Math-BigInt.
0.5011 2021-09-20
* Sync test files with Math-BigInt.
* Add missing documentation.
* Make the test files only print to the standard error when there is an
actual error.
* Miscellaneous changes and updates to author and release test files.
Math::BigRat
============
0.2620 2021-10-03
* Skip tests that don't work on older Perls. Also skip tests that
compare
floating point numbers.
0.2619 2021-10-01
* Correct the handling of Inf and NaN in numify().
* Improve constant overloading. When numeric constants are overloaded
(with the ":constant" option) in Math::BigRat, every numeric constant
is converted to an object regardless of how it is written.
0.2618 2021-09-28
* Add new method binv() for the inverse.
* Add new method dparts(), which returns the integer part and fraction
part
of a number. For example, 9/4 is split into 2 and 1/4. This method is
equivalent to the Math::BigInt and Math::BigFloat methods with the
same
name.
* Improve blog(). Handle cases $x->blog($b) where the numerator of $x
and/or $b is 1 as special.
* Sync tests with Math-BigInt.
191 files changed, 8645 insertions, 3102 deletions
@@ -144,33 +144,41 @@ cpan/AutoLoader/lib/AutoLoader.pm Autoloader base class cpan/AutoLoader/lib/AutoSplit.pm Split up autoload functions cpan/AutoLoader/t/01AutoLoader.t See if AutoLoader works cpan/AutoLoader/t/02AutoSplit.t See if AutoSplit works +cpan/bignum/gentest/scope-nested-const.sh +cpan/bignum/gentest/scope-nested-hex-oct.sh cpan/bignum/lib/bigint.pm bigint cpan/bignum/lib/bignum.pm bignum cpan/bignum/lib/bigrat.pm bigrat cpan/bignum/lib/Math/BigFloat/Trace.pm bignum tracing cpan/bignum/lib/Math/BigInt/Trace.pm bignum tracing -cpan/bignum/t/big_e_pi.t See if bignum exports e() and PI() +cpan/bignum/lib/Math/BigRat/Trace.pm cpan/bignum/t/bigexp.t See if bignum works cpan/bignum/t/bigint.t See if bigint works cpan/bignum/t/bignum.t See if bignum works cpan/bignum/t/bigrat.t See if bigrat works -cpan/bignum/t/bii_e_pi.t See if bigint exports e() and PI() -cpan/bignum/t/biinfnan.t See if bignum works -cpan/bignum/t/bir_e_pi.t See if bigrat exports e() and PI() -cpan/bignum/t/bn_lite.t See if bignum with Math::BigInt::Lite works -cpan/bignum/t/bninfnan.t See if bignum works -cpan/bignum/t/br_lite.t See if bigrat with Math::BigInt::Lite works -cpan/bignum/t/brinfnan.t See if bignum works +cpan/bignum/t/const-bigint.t +cpan/bignum/t/const-bignum.t +cpan/bignum/t/const-bigrat.t +cpan/bignum/t/e_pi-bigint.t +cpan/bignum/t/e_pi-bignum.t +cpan/bignum/t/e_pi-bigrat.t +cpan/bignum/t/import-bigint.t +cpan/bignum/t/import-bignum.t +cpan/bignum/t/import-bigrat.t cpan/bignum/t/in_effect.t See if in_effect() works -cpan/bignum/t/infnan.inc See if bignum with inf/NaN works +cpan/bignum/t/infnan-bigint.t +cpan/bignum/t/infnan-bignum.t +cpan/bignum/t/infnan-bigrat.t cpan/bignum/t/option_a.t See if bignum a => X works cpan/bignum/t/option_l.t See if bignum l => X works cpan/bignum/t/option_p.t See if bignum p => X works cpan/bignum/t/overrides.t See if global overrides behave cpan/bignum/t/ratopt_a.t See if bigrat a => X works -cpan/bignum/t/scope_f.t See if no bignum works -cpan/bignum/t/scope_i.t See if no bigint works -cpan/bignum/t/scope_r.t See if no bigrat works +cpan/bignum/t/scope-bigint.t +cpan/bignum/t/scope-bignum.t +cpan/bignum/t/scope-bigrat.t +cpan/bignum/t/scope-nested-const.t +cpan/bignum/t/scope-nested-hex-oct.t cpan/Compress-Raw-Bzip2/Bzip2.xs cpan/Compress-Raw-Bzip2/bzip2-src/blocksort.c cpan/Compress-Raw-Bzip2/bzip2-src/bzip2.patch @@ -1313,7 +1321,13 @@ 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/Lib.pm +cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t +cpan/Math-BigInt/t/_bin_str_to_str_parts.t +cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t +cpan/Math-BigInt/t/_dec_str_to_str_parts.t cpan/Math-BigInt/t/_e_math.t Helper routine in BigFloat for _e math +cpan/Math-BigInt/t/_hex_str_to_str_parts.t +cpan/Math-BigInt/t/_oct_str_to_str_parts.t cpan/Math-BigInt/t/alias.inc Support for BigInt tests cpan/Math-BigInt/t/backermann-mbi.t Test Math::BigInt cpan/Math-BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc @@ -1340,15 +1354,19 @@ cpan/Math-BigInt/t/bnok-mbf.t cpan/Math-BigInt/t/bnok-mbi.t cpan/Math-BigInt/t/bnstr-mbf.t Test Math::BigInt cpan/Math-BigInt/t/bnstr-mbi.t Test Math::BigInt +cpan/Math-BigInt/t/bpi-mbf.t +cpan/Math-BigInt/t/bpi-mbi.t cpan/Math-BigInt/t/bsstr-mbf.t Test Math::BigInt cpan/Math-BigInt/t/bsstr-mbi.t Test Math::BigInt cpan/Math-BigInt/t/buparrow-mbi.t Test Math::BigInt -cpan/Math-BigInt/t/calling.t Test calling conventions cpan/Math-BigInt/t/calling-class-methods.t Test Math::BigInt +cpan/Math-BigInt/t/calling-constant.t cpan/Math-BigInt/t/calling-instance-methods.t Test Math::BigInt +cpan/Math-BigInt/t/calling-lib1.t +cpan/Math-BigInt/t/calling-lib2.t cpan/Math-BigInt/t/config.t Test Math::BigInt->config() -cpan/Math-BigInt/t/const_mbf.t Test Math::BigInt -cpan/Math-BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant +cpan/Math-BigInt/t/const-mbf.t +cpan/Math-BigInt/t/const-mbi.t cpan/Math-BigInt/t/downgrade.t Test if use Math::BigInt(); under downgrade works cpan/Math-BigInt/t/dparts-mbf.t Test Math::BigInt cpan/Math-BigInt/t/dparts-mbi.t Test Math::BigInt @@ -1365,7 +1383,8 @@ cpan/Math-BigInt/t/from_oct-mbf.t Test Math::BigInt cpan/Math-BigInt/t/from_oct-mbi.t cpan/Math-BigInt/t/inf_nan.t Special tests for inf and *NaN* handling 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/lib_load-mbf-mbi.t +cpan/Math-BigInt/t/lib_load-mbi-mbf.t 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 @@ -1379,6 +1398,7 @@ cpan/Math-BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fa cpan/Math-BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precision and fallback, round_mode cpan/Math-BigInt/t/nan_cmp.t overloaded comparison involving *NaN* cpan/Math-BigInt/t/new-mbf.t Test Math::BigInt +cpan/Math-BigInt/t/new-mbi.t cpan/Math-BigInt/t/new_overloaded.t test overloaded numbers in BigFloat's new() cpan/Math-BigInt/t/nparts-mbf.t Test Math::BigInt cpan/Math-BigInt/t/nparts-mbi.t Test Math::BigInt @@ -1425,6 +1445,7 @@ 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 cpan/Math-BigRat/lib/Math/BigRat.pm Math::BigRat +cpan/Math-BigRat/t/badd-mbr.t cpan/Math-BigRat/t/big_ap.t Math::BigRat test cpan/Math-BigRat/t/bigfltpm.inc Math::BigRat test cpan/Math-BigRat/t/bigfltrt.t Math::BigRat test @@ -1432,8 +1453,11 @@ cpan/Math-BigRat/t/bigrat.t Math::BigRat test cpan/Math-BigRat/t/bigratpm.inc Math::BigRat test cpan/Math-BigRat/t/bigratpm.t Math::BigRat test cpan/Math-BigRat/t/bigratup.t test under $Math::BigInt::upgrade +cpan/Math-BigRat/t/binv-mbr.t cpan/Math-BigRat/t/bitwise.t Math::BigRat test cpan/Math-BigRat/t/bnok-mbr.t +cpan/Math-BigRat/t/const-mbr.t +cpan/Math-BigRat/t/dparts-mbr.t cpan/Math-BigRat/t/hang.t Math::BigRat test for bug #34584 - hang in exp() cpan/Math-BigRat/t/Math/BigRat/Test.pm Math::BigRat test helper cpan/Math-BigRat/t/new-mbr.t diff --git a/Makefile.SH b/Makefile.SH index 32f6449b73..cc915f2929 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -1421,17 +1421,18 @@ _cleaner2: -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple -rmdir lib/Pod/Perldoc lib/Pod/Html lib/PerlIO/via lib/PerlIO lib/Perl -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load - -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt - -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext - -rmdir lib/Locale lib/List/Util lib/List lib/JSON/PP lib/JSON lib/IPC - -rmdir lib/IO/Uncompress/Adapter lib/IO/Uncompress lib/IO/Socket - -rmdir lib/IO/Compress/Zlib lib/IO/Compress/Zip lib/IO/Compress/Gzip - -rmdir lib/IO/Compress/Base lib/IO/Compress/Adapter lib/IO/Compress - -rmdir lib/IO lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash - -rmdir lib/HTTP lib/Filter/Util lib/Filter lib/File/Spec - -rmdir lib/ExtUtils/Typemaps lib/ExtUtils/ParseXS - -rmdir lib/ExtUtils/MakeMaker/version lib/ExtUtils/MakeMaker - -rmdir lib/ExtUtils/Liblist lib/ExtUtils/Constant lib/ExtUtils/Command + -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigRat + -rmdir lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME + -rmdir lib/Locale/Maketext lib/Locale lib/List/Util lib/List + -rmdir lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter + -rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib + -rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base + -rmdir lib/IO/Compress/Adapter lib/IO/Compress lib/IO + -rmdir lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash lib/HTTP + -rmdir lib/Filter/Util lib/Filter lib/File/Spec lib/ExtUtils/Typemaps + -rmdir lib/ExtUtils/ParseXS lib/ExtUtils/MakeMaker/version + -rmdir lib/ExtUtils/MakeMaker lib/ExtUtils/Liblist + -rmdir lib/ExtUtils/Constant lib/ExtUtils/Command -rmdir lib/ExtUtils/CBuilder/Platform/Windows -rmdir lib/ExtUtils/CBuilder/Platform lib/ExtUtils/CBuilder -rmdir lib/Exporter lib/Encode/Unicode lib/Encode/MIME/Header diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 0b519a05cd..08ff74bfab 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -728,7 +728,7 @@ use File::Glob qw(:case); }, 'Math::BigInt' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999823.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999827.tar.gz', 'FILES' => q[cpan/Math-BigInt], 'EXCLUDED' => [ qr{^xt/}, @@ -742,7 +742,7 @@ use File::Glob qw(:case); }, 'Math::BigInt::FastCalc' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.5010.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.5012.tar.gz', 'FILES' => q[cpan/Math-BigInt-FastCalc], 'EXCLUDED' => [ qr{^inc/}, @@ -767,7 +767,7 @@ use File::Glob qw(:case); }, 'Math::BigRat' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.2617.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.2620.tar.gz', 'FILES' => q[cpan/Math-BigRat], 'EXCLUDED' => [ qr{^xt/}, diff --git a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm index 62dab0465d..f20c8eb1d8 100644 --- a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm +++ b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm @@ -12,7 +12,7 @@ BEGIN { our @ISA = qw< Math::BigInt::Calc >; } -our $VERSION = '0.5010'; +our $VERSION = '0.5012'; my $MAX_EXP_F; # the maximum possible base 10 exponent with "no integer" my $MAX_EXP_I; # the maximum possible base 10 exponent with "use integer" @@ -200,7 +200,7 @@ the same terms as Perl itself. Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/> in late 2000. -Separated from BigInt and shaped API with the help of John Peacock. +Separated from Math::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. diff --git a/cpan/Math-BigInt-FastCalc/t/bigintfc.t b/cpan/Math-BigInt-FastCalc/t/bigintfc.t index f8a39fc7ba..a7f27729be 100644 --- a/cpan/Math-BigInt-FastCalc/t/bigintfc.t +++ b/cpan/Math-BigInt-FastCalc/t/bigintfc.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test Math::BigInt::FastCalc @@ -14,7 +14,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc -> _base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt-FastCalc/t/biglog.t b/cpan/Math-BigInt-FastCalc/t/biglog.t index 7befc87c3d..18f959b39c 100644 --- a/cpan/Math-BigInt-FastCalc/t/biglog.t +++ b/cpan/Math-BigInt-FastCalc/t/biglog.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test blog function (and bpow, since it uses blog), as well as bexp(). diff --git a/cpan/Math-BigInt-FastCalc/t/bigroot.t b/cpan/Math-BigInt-FastCalc/t/bigroot.t index 076f02e7cb..2d8c8446e1 100644 --- a/cpan/Math-BigInt-FastCalc/t/bigroot.t +++ b/cpan/Math-BigInt-FastCalc/t/bigroot.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test broot function (and bsqrt() function, since it is used by broot()). diff --git a/cpan/Math-BigInt-FastCalc/t/bootstrap.t b/cpan/Math-BigInt-FastCalc/t/bootstrap.t index 6f94bebc88..153dc92b91 100644 --- a/cpan/Math-BigInt-FastCalc/t/bootstrap.t +++ b/cpan/Math-BigInt-FastCalc/t/bootstrap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +# -*- mode: perl; -*- use Test::More tests => 1; diff --git a/cpan/Math-BigInt-FastCalc/t/leak.t b/cpan/Math-BigInt-FastCalc/t/leak.t index 6d0f7464a5..58935ba759 100644 --- a/cpan/Math-BigInt-FastCalc/t/leak.t +++ b/cpan/Math-BigInt-FastCalc/t/leak.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +# -*- mode: perl; -*- # Test for memory leaks. diff --git a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t index 1186e2e144..1b4599e45b 100644 --- a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t +++ b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 5dcc919e1a..b6d0bcbaf0 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -16,10 +16,11 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; -use Math::BigInt (); +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; +use Math::BigInt qw< >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw/Math::BigInt/; @@ -58,21 +59,21 @@ use overload # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -194,7 +195,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -360,52 +361,80 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; + # Make "require" work. + + $class -> import() if $IMPORT == 0; + + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. + + return $class -> bzero() unless @_; + my ($wanted, @r) = @_; - # avoid numify-calls by not using || on $wanted! + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); + } - unless (defined $wanted) { - #carp("Use of uninitialized value in new"); - return $self->bzero(@r); + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on + # Initialize a new object. + + $self = bless {}, $class unless $selfref; + + # The first following ought to work. However, it causes a 'Deep recursion on # subroutine "Math::BigFloat::as_number"' in some tests. Fixme! - if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) { - my $copy = $wanted -> copy(); - if ($selfref) { # if new() called as instance method - %$self = %$copy; - } else { # if new() called as class method - $self = $copy; - } - return $copy; + if (defined(blessed($wanted)) && $wanted -> isa('Math::BigFloat')) { + #if (defined(blessed($wanted)) && UNIVERSAL::isa($wanted, 'Math::BigFloat')) { + $self -> {sign} = $wanted -> {sign}; + $self -> {_m} = $LIB -> _copy($wanted -> {_m}); + $self -> {_es} = $wanted -> {_es}; + $self -> {_e} = $LIB -> _copy($wanted -> {_e}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $class->import() if $IMPORT == 0; # make require work - - # If called as a class method, initialize a new object. + # Shortcut for Math::BigInt and its subclasses. This should be improved. - $self = bless {}, $class unless $selfref; + if (defined(blessed($wanted))) { + if ($wanted -> isa('Math::BigInt')) { + $self->{sign} = $wanted -> {sign}; + $self->{_m} = $LIB -> _copy($wanted -> {value}); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } - # shortcut for bigints and its subclasses - if ((ref($wanted)) && $wanted -> can("as_number")) { - $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{sign} = $wanted->sign(); - return $self->bnorm(); + if ($wanted -> can("as_number")) { + $self->{sign} = $wanted -> sign(); + $self->{_m} = $wanted -> as_number() -> {value}; + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } } - # else: got a string or something masquerading as number (with overload) # Handle Infs. if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { return $downgrade->new($wanted) if $downgrade; my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $self->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). @@ -417,142 +446,119 @@ sub new { return $self; } - # Handle hexadecimal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0x", "0X", "x", or "X". + # Shortcut for simple forms like '123' that have no trailing zeros. - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); + if ($wanted =~ / ^ + \s* # optional leading whitespace + ( [+-]? ) # optional sign + 0* # optional leading zeros + ( [1-9] (?: [0-9]* [1-9] )? ) # significand + \s* # optional trailing whitespace + $ + /x) + { + return $downgrade->new($1 . $2) if $downgrade; + $self->{sign} = $1 || '+'; + $self->{_m} = $LIB -> _new($2); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; return $self; } - # Handle octal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0o", "0O", "o", or "O". If the prefix is just "0", the number must - # have a binary exponent, or else the number is interpreted as decimal. - - if ($wanted =~ / - ^ - \s* - - # sign - [+-]? - - (?: - # prefix - 0? [Oo] - | - - # prefix - 0 - - # significand using the octal digits 0..7 - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - - # exponent (power of 2) using decimal digits - [Pp] - [+-]? - \d+ (?: _ \d+ )* - \s* - $ - ) - /x) + my @parts; + + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) + + or + + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) + + or + + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) { - $self = $class -> from_oct($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } + # The value is an integer iff the exponent is non-negative. - # Handle binary numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0b", "0B", "b", or "B". + if ($parts[2] eq '+' && $downgrade) { + #return $downgrade->new($str, @r); + return $downgrade->new($wanted, @r); + } - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Shortcut for simple forms like '12' that have no trailing zeros. - if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) { - $self->{_e} = $LIB -> _zero(); - $self->{_es} = '+'; - $self->{sign} = $1 || '+'; - $self->{_m} = $LIB -> _new($2); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not an explicit Inf or a NaN either. - my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number initialized to $class"); - } + return $class -> bnan(); +} - return $downgrade->bnan() if $downgrade; +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{_m} = $LIB->_zero(); - $self->{sign} = $nan; - } else { - # make integer from mantissa by adjusting exp, then convert to int - $self->{_e} = $LIB->_new($$ev); # exponent - $self->{_es} = $$es || '+'; - my $mantissa = "$$miv$$mfv"; # create mant. - $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros - $self->{_m} = $LIB->_new($mantissa); # create mant. - - # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 - if (CORE::length($$mfv) != 0) { - my $len = $LIB->_new(CORE::length($$mfv)); - ($self->{_e}, $self->{_es}) = - _e_sub($self->{_e}, $len, $self->{_es}, '+'); - } - # we can only have trailing zeros on the mantissa if $$mfv eq '' - else { - # Use a regexp to count the trailing zeros in $$miv instead of - # _zeros() because that is faster, especially when _m is not stored - # in base 10. - my $zeros = 0; - $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; - if ($zeros != 0) { - my $z = $LIB->_new($zeros); - # turn '120e2' into '12e3' - $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10); - ($self->{_e}, $self->{_es}) = - _e_add($self->{_e}, $z, $self->{_es}, '+'); - } - } - $self->{sign} = $$mis; + # Don't modify constant (read-only) objects. - # for something like 0Ey, set y to 0, and -0 => +0 - # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not - # have become 0. That's faster than to call $LIB->_is_zero(). - $self->{sign} = '+', $self->{_e} = $LIB->_zero() - if $$miv eq '0' and $$mfv eq ''; + return if $selfref && $self->modify('from_dec'); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. - # if downgrade, inf, NaN or integers go down + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. - if ($downgrade && $self->{_es} eq '+') { - if ($LIB->_is_zero($self->{_e})) { - return $downgrade->new($$mis . $LIB->_str($self->{_m})); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade->new($str, @r); } - return $downgrade->new($self->bsstr()); + + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $self->bnorm(); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; + + return $self -> bnan(@r); } sub from_hex { @@ -565,85 +571,27 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional hexadecimal prefix - (?: 0? [Xx] )? - - # significand using the hex digits 0..9 and a..f - ( - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - (?: - \. - (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )? - )? - | - \. - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 16, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(16) / log(2) = 4. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("4"); - } + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_hex('0x' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_hex($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_oct { @@ -656,85 +604,27 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional octal prefix - (?: 0? [Oo] )? - - # significand using the octal digits 0..7 - ( - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - | - \. - [0-7]+ (?: _ [0-7]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 8, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(8) / log(2) = 3. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("3"); - } + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_oct($s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_oct($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_bin { @@ -747,82 +637,27 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional binary prefix - (?: 0? [Bb] )? - - # significand using the binary digits 0 and 1 - ( - [01]+ (?: _ [01]+ )* - (?: - \. - (?: [01]+ (?: _ [01]+ )* )? - )? - | - \. - [01]+ (?: _ [01]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx); - } + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_bin('0b' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_bin($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_ieee754 { @@ -839,6 +674,7 @@ sub from_ieee754 { my $enc; # significand encoding (applies only to decimal) my $k; # storage width in bits my $b; # base + my @r = @_; if ($format =~ /^binary(\d+)\z/) { $k = $1; @@ -907,7 +743,7 @@ sub from_ieee754 { unless (defined $in) { carp("Input is undefined"); - return $self -> bzero(); + return $self -> bzero(@r); } # Make sure input string is a string of zeros and ones. @@ -978,7 +814,7 @@ sub from_ieee754 { } else { $self = $x; } - return $self; + return $self -> round(@r); } croak("The format '$format' is not yet supported."); @@ -1208,7 +1044,7 @@ sub bpi { # we assume bpi() is called as a function. if (@_ == 0 && - (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i) + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) || !defined($self)) { @@ -1462,7 +1298,7 @@ sub bcmp { # Handle all 'nan' cases. - return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); + return if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); # Handle all '+inf' and '-inf' cases. @@ -1620,9 +1456,9 @@ sub bacmp { # handle +-inf and NaN's if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if ($x->is_inf() && $y->is_inf()); - return 1 if ($x->is_inf() && !$y->is_inf()); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if ($x->is_inf() && $y->is_inf()); + return 1 if ($x->is_inf() && !$y->is_inf()); return -1; } @@ -1825,6 +1661,7 @@ sub badd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($y->{_m}); @@ -1832,6 +1669,9 @@ sub badd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); + } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1844,6 +1684,8 @@ sub badd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign}); } # delete trailing zeros, then round @@ -1916,6 +1758,7 @@ sub bmul { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1953,6 +1796,7 @@ sub bmuladd { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1970,6 +1814,7 @@ sub bmuladd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($z->{_m}); @@ -1977,6 +1822,8 @@ sub bmuladd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1989,6 +1836,8 @@ sub bmuladd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $z->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign}); } # delete trailing zeros, then round @@ -2153,8 +2002,12 @@ sub bdiv { # correct exponent of $x ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); # correct for 10**scale ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+'); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+'); $x->bnorm(); # remove trailing 0's } } # end else $x != $y @@ -4685,58 +4538,96 @@ sub numify { sub import { my $class = shift; $IMPORT++; # remember we did import() + + my @import = ('objectify'); my @a; # unrecognized arguments - my $lib = ''; - my $lib_kind = 'try'; - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; + + # Enable overloading of constants. + + if ($param eq ':constant') { + overload::constant - if ($_[$i] eq ':constant') { - # This causes overlord er load to step in. 'binary' and 'integer' - # are handled by BigInt. - overload::constant float => sub { $class->new(shift); }; + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; + } + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; } - elsif ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i+1]; # or undef to disable - $i++; + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; } - elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] =~ /^(lib|try|only)\z/) { - # alternative library - $lib = $_[$i+1] || ''; - $lib_kind = $1; # "lib", "try", or "only" - $i++; + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { + push @import, $param; + push @import, shift() if @_; + next; } - elsif ($_[$i] eq 'with') { + if ($param eq 'with') { # alternative class for our private parts() # XXX: no longer supported - # $LIB = $_[$i+1] || 'Calc'; + # $LIB = shift() || 'Calc'; # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; - $i++; + shift; + next; } - else { - push @a, $_[$i]; - } + # Unrecognized parameter. + + push @a, $param; } - my @import = ('objectify'); - push @import, $lib_kind, $lib if $lib ne ''; Math::BigInt -> import(@import); # find out which one was actually loaded - $LIB = Math::BigInt->config('lib'); + $LIB = Math::BigInt -> config('lib'); $class->export_to_level(1, $class, @a); # export wanted functions } @@ -4998,7 +4889,8 @@ sub _log_10 { } ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 - + #($x->{_e}, $x->{_es}) = + # $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign); } # Now: 0.1 <= $x < 10 (and possible correction in l_10) @@ -5088,6 +4980,7 @@ sub _e_sub { # flip sign $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job } sub _pow { @@ -5386,7 +5279,8 @@ exactly what you expect. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents a floating point number. +like a number. Anything that is accepted by Perl as a literal numeric constant +should be accepted by this module. =over @@ -5403,19 +5297,22 @@ gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * @@ -5423,26 +5320,44 @@ If the string can not be interpreted, NaN is returned. =item * -For hexadecimal, octal, and binary numbers, the exponent must be separated from -the significand (mantissa) by the letter "p" or "P", not "e" or "E" as with -decimal numbers. +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + 0x1.921fb5p+1 3.14159262180328369140625e+0 0o1.2677025p1 2.71828174591064453125 01.2677025p1 2.71828174591064453125 @@ -5816,76 +5731,103 @@ C<as_number()>: $x = Math::BigFloat->new(2.5); $y = $x->as_number('odd'); # $y = 3 -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigFloat ':constant'> all the floating point constants -in the given scope are converted to C<Math::BigFloat>. This conversion -happens at compile time. +After C<use Math::BigFloat ':constant'> all numeric literals in the given scope +are converted to C<Math::BigFloat> objects. This conversion happens at compile +time. -In particular +For example, - perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' + perl -MMath::BigFloat=:constant -le 'print 2e-150' -prints the value of C<2E-100>. Note that without conversion of -constants the expression 2E-100 will be calculated as normal floating point -number. +prints the exact value of C<2e-150>. Note that without conversion of constants +the expression C<2e-150> is calculated using Perl scalars, which leads to an +inaccuracte result. -Please note that ':constant' does not affect integer constants, nor binary -nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to -work. +Note that strings are not affected, so that -=head2 Math library + use Math::BigFloat qw/:constant/; -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: + $y = "1234567890123456789012345678901234567890" + + "123456789123456789"; - use Math::BigFloat lib => 'Calc'; +does not give you what you expect. You need an explicit Math::BigFloat->new() +around at least one of the operands. You should also quote large constants to +prevent loss of precision: -You can change this by using: + use Math::BigFloat; - use Math::BigFloat lib => 'GMP'; + $x = Math::BigFloat->new("1234567889123456789123456789123456789"); -B<Note>: General purpose packages should not be explicit about the library -to use; let the script author decide which is best. +Without the quotes Perl converts the large number to a floating point constant +at compile time, and then converts the result to a Math::BigFloat object at +runtime, which results in an inaccurate result. -Note: The keyword 'lib' will warn when the requested library could not be -loaded. To suppress the warning use 'try' instead: +=head2 Hexadecimal, octal, and binary floating point literals - use Math::BigFloat try => 'GMP'; +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. -If your script works with huge numbers and Calc is too slow for them, -you can also for the loading of one of these libraries and if none -of them can be used, the code will die: +Hexadecimal floating point literals: - use Math::BigFloat only => 'GMP,Pari'; + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: +Octal floating point literals (with "0" prefix): - use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -See the respective low-level library documentation for further details. +Octal floating point literals (with "0o" prefix) (requires v5.34.0): -Please note that Math::BigFloat does B<not> use the denoted library itself, -but it merely passes the lib argument to Math::BigInt. So, instead of the need -to do: + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - use Math::BigInt lib => 'GMP'; - use Math::BigFloat; +Binary floating point literals: -you can roll it all into one line: + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 - use Math::BigFloat lib => 'GMP'; +=head2 Math library -It is also possible to just require Math::BigFloat: +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: - require Math::BigFloat; + use Math::BigFloat lib => "Calc"; + +You can change this by using: + + use Math::BigFloat lib => "GMP"; + +B<Note>: General purpose packages should not be explicit about the library to +use; let the script author decide which is best. -This will load the necessary things (like BigInt) when they are needed, and -automatically. +Note: The keyword 'lib' will warn when the requested library could not be +loaded. To suppress the warning use 'try' instead: + + use Math::BigFloat try => "GMP"; + +If your script works with huge numbers and Calc is too slow for them, you can +also for the loading of one of these libraries and if none of them can be used, +the code will die: + + use Math::BigFloat only => "GMP,Pari"; + +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigFloat lib => "Foo,Math::BigInt::Bar"; + +See the respective low-level library documentation for further details. -See L<Math::BigInt> for more details than you ever wanted to know about using -a different low-level library. +See L<Math::BigInt> for more details about using a different low-level library. =head2 Using Math::BigInt::Lite @@ -6072,8 +6014,7 @@ the same terms as Perl itself. L<Math::BigInt> and L<Math::BigInt> as well as the backends L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. -The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest -because they solve the autoupgrading/downgrading issue, at least partly. +The pragmas L<bignum>, L<bigint> and L<bigrat>. =head1 AUTHORS diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 82d289752e..84c4bcdcf4 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -20,9 +20,10 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw(Exporter); @@ -45,44 +46,44 @@ use overload '+' => sub { $_[0] -> copy() -> badd($_[1]); }, - '-' => sub { my $c = $_[0] -> copy; + '-' => sub { my $c = $_[0] -> copy(); $_[2] ? $c -> bneg() -> badd($_[1]) : $c -> bsub($_[1]); }, '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) - : $_[0] -> copy -> bdiv($_[1]); }, + : $_[0] -> copy() -> bdiv($_[1]); }, '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) - : $_[0] -> copy -> bmod($_[1]); }, + : $_[0] -> copy() -> bmod($_[1]); }, '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) - : $_[0] -> copy -> bpow($_[1]); }, + : $_[0] -> copy() -> bpow($_[1]); }, '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0]) - : $_[0] -> copy -> blsft($_[1]); }, + : $_[0] -> copy() -> blsft($_[1]); }, '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0]) - : $_[0] -> copy -> brsft($_[1]); }, + : $_[0] -> copy() -> brsft($_[1]); }, # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -116,13 +117,13 @@ use overload # overload key: str_comparison -# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) +# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) # : $_[0] -> bstrlt($_[1]); }, # # 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) # : $_[0] -> bstrle($_[1]); }, # -# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) +# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) # : $_[0] -> bstrgt($_[1]); }, # # 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) @@ -135,17 +136,17 @@ use overload # overload key: binary '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) - : $_[0] -> copy -> band($_[1]); }, + : $_[0] -> copy() -> band($_[1]); }, '&=' => sub { $_[0] -> band($_[1]); }, '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) - : $_[0] -> copy -> bior($_[1]); }, + : $_[0] -> copy() -> bior($_[1]); }, '|=' => sub { $_[0] -> bior($_[1]); }, '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) - : $_[0] -> copy -> bxor($_[1]); }, + : $_[0] -> copy() -> bxor($_[1]); }, '^=' => sub { $_[0] -> bxor($_[1]); }, @@ -182,9 +183,9 @@ use overload 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) : $_[0] -> copy() -> batan2($_[1]); }, - 'cos' => sub { $_[0] -> copy -> bcos(); }, + 'cos' => sub { $_[0] -> copy() -> bcos(); }, - 'sin' => sub { $_[0] -> copy -> bsin(); }, + 'sin' => sub { $_[0] -> copy() -> bsin(); }, 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, @@ -204,7 +205,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -228,11 +229,14 @@ our $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life +# Module to do the low level math. + my $DEFAULT_LIB = 'Math::BigInt::Calc'; -my $LIB; # module to do the low level math - # default is Calc.pm -my $IMPORT = 0; # was import() called yet? - # used to make require work +my $LIB; + +# Has import() been called yet? Needed to make "require" work. + +my $IMPORT = 0; ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -530,49 +534,54 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; - # The POD says: - # - # "Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') - # results in 'NaN'. This might change in the future, so use always the - # following explicit forms to get a zero or NaN: - # $zero = Math::BigInt->bzero(); - # $nan = Math::BigInt->bnan(); - # - # But although this use has been discouraged for more than 10 years, people - # apparently still use it, so we still support it. + # Make "require" work. - return $self->bzero() unless @_; + $class -> import() if $IMPORT == 0; - my ($wanted, $a, $p, $r) = @_; + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. - # Always return a new object, so if called as an instance method, copy the - # invocand, and if called as a class method, initialize a new object. + return $class -> bzero() unless @_; - $self = $selfref ? $self -> copy() - : bless {}, $class; + my ($wanted, @r) = @_; - unless (defined $wanted) { - #carp("Use of uninitialized value in new()"); - return $self->bzero($a, $p, $r); + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); } - if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass - # Using "$copy = $wanted -> copy()" here fails some tests. Fixme! - my $copy = $class -> copy($wanted); - if ($selfref) { - %$self = %$copy; - } else { - $self = $copy; - } - return $self; + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - $class->import() if $IMPORT == 0; # make require work + # Initialize a new object. + + $self = bless {}, $class; + + # Math::BigInt or subclass + + if (defined(blessed($wanted)) && $wanted -> isa($class)) { + + # We don't copy the accuracy and precision, because a new object should + # get them from the global configuration. + + $self -> {sign} = $wanted -> {sign}; + $self -> {value} = $LIB -> _copy($wanted -> {value}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; + } # Shortcut for non-zero scalar integers with no non-zero exponent. - if (!ref($wanted) && - $wanted =~ / ^ + if ($wanted =~ / ^ ([+-]?) # optional sign ([1-9][0-9]*) # non-zero significand (\.0*)? # ... with optional zero fraction @@ -584,16 +593,7 @@ sub new { my $abs = $2; $self->{sign} = $sgn || '+'; $self->{value} = $LIB->_new($abs); - - no strict 'refs'; - if (defined($a) || defined($p) - || defined(${"${class}::precision"}) - || defined(${"${class}::accuracy"})) - { - $self->round($a, $p, $r) - unless @_ >= 3 && !defined $a && !defined $p; - } - + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } @@ -601,123 +601,118 @@ sub new { if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $class->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { $self = $class -> bnan(); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they - # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + my @parts; - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). - # Handle octal numbers. We auto-detect octal numbers if they have a "0o", - # "0O", "o", "O" prefix, cf. CORE::oct(). + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) - if ($wanted =~ /^\s*[+-]?0?[Oo]/) { - $self = $class -> from_oct($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + or - # Handle binary numbers. We auto-detect binary numbers if they have a "0b", - # "B", "b", or "B" prefix, cf. CORE::oct(). + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) - # Split string into mantissa, exponent, integer, fraction, value, and sign. - my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number in $class"); - } - $self->{value} = $LIB->_zero(); - $self->{sign} = $nan; - return $self; - } + or - if (!ref $miv) { - # _from_hex or _from_bin - $self->{value} = $mis->{value}; - $self->{sign} = $mis->{sign}; - return $self; # throw away $mis - } + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). - # Make integer from mantissa by adjusting exponent, then convert to a - # Math::BigInt. - $self->{sign} = $$mis; # store sign - $self->{value} = $LIB->_zero(); # for all the NaN cases - my $e = int("$$es$$ev"); # exponent (avoid recursion) - if ($e > 0) { - my $diff = $e - CORE::length($$mfv); - if ($diff < 0) { # Not integer - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 1\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } else { # diff >= 0 - # adjust fraction and add it to value - #print "diff > 0 $$miv\n"; - $$miv = $$miv . ($$mfv . '0' x $diff); + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) + { + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } + + # If we get here, the value is a valid number, but it is not an integer. + + return $upgrade -> new($wanted, @r) if defined $upgrade; + return $class -> bnan(); } - else { - if ($$mfv ne '') { # e <= 0 - # fraction and negative/zero E => NOI - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 2 \$\$mfv '$$mfv'\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } elsif ($e < 0) { - # xE-y, and empty mfv - # Split the mantissa at the decimal point. E.g., if - # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123. - - my $frac = substr($$miv, $e); # $frac is fraction part - substr($$miv, $e) = ""; # $$miv is now integer part - - if ($frac =~ /[^0]/) { - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 3\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not explicit an Inf or a NaN either. + + return $class -> bnan(); +} + +# Create a Math::BigInt from a decimal string. This is an equivalent to +# from_hex(), from_oct(), and from_bin(). It is like new() except that it does +# not accept anything but a string representing a finite decimal number. + +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + # Don't modify constant (read-only) objects. + + return if $selfref && $self->modify('from_dec'); + + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. + + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); } - } - unless ($self->{sign} eq $nan) { - $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 - $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/; + return $upgrade -> new($str, @r) if defined $upgrade; } - # If any of the globals are set, use them to round, and store them inside - # $self. Do not round for new($x, undef, undef) since that is used by MBF - # to signal no rounding. - - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - $self; + return $self -> bnan(@r); } # Create a Math::BigInt from a hexadecimal string. @@ -732,48 +727,26 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Xx] )? - ( - [0-9a-fA-F]* - ( _ [0-9a-fA-F]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_hex('0x' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::hex() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from an octal string. @@ -788,48 +761,26 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Oo] )? - ( - [0-7]* - ( _ [0-7]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_oct('0' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::oct() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from a binary string. @@ -844,49 +795,26 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Bb] )? - ( - [01]* - ( _ [01]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_bin('0b' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # For consistency with from_hex() and from_oct(), we return NaN when the - # input is invalid. - - return $self->bnan(); - + return $self -> bnan(@r); } # Create a Math::BigInt from a byte string. @@ -904,13 +832,14 @@ sub from_bytes { unless $LIB->can('_from_bytes'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; $self -> {sign} = '+'; $self -> {value} = $LIB -> _from_bytes($str); - return $self; + return $self -> round(@r); } sub from_base { @@ -954,7 +883,7 @@ sub from_base { $self -> {sign} = '+'; $self -> {value} = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ()); - return $self + return $self; } sub from_base_num { @@ -983,6 +912,8 @@ sub from_base_num { my $base = shift; $base = $class -> new($base) unless ref($base) && $base -> isa($class); + my @r = @_; + # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; @@ -994,7 +925,7 @@ sub from_base_num { $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ], $base -> {value}); - return $self; + return $self -> round(@r); } sub bzero { @@ -1175,24 +1106,86 @@ sub bnan { $self -> {sign} = $nan; $self -> {value} = $LIB -> _zero(); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } + return $self; } sub bpi { - # Calculate PI to N digits. Unless upgrading is in effect, returns the - # result truncated to an integer, that is, always returns '3'. - my ($self, $n) = @_; - if (@_ == 1) { - # called like Math::BigInt::bpi(10); - $n = $self; - $self = __PACKAGE__; + + # Called as Argument list + # --------- ------------- + # Math::BigInt->bpi() ("Math::BigInt") + # Math::BigInt->bpi(10) ("Math::BigInt", 10) + # $x->bpi() ($x) + # $x->bpi(10) ($x, 10) + # Math::BigInt::bpi() () + # Math::BigInt::bpi(10) (10) + # + # In ambiguous cases, we favour the OO-style, so the following case + # + # $n = Math::BigInt->new("10"); + # $x = Math::BigInt->bpi($n); + # + # which gives an argument list with the single element $n, is resolved as + # + # $n->bpi(); + + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + my @r; # rounding paramters + + # If bpi() is called as a function ... + # + # This cludge is necessary because we still support bpi() as a function. If + # bpi() is called with either no argument or one argument, and that one + # argument is either undefined or a scalar that looks like a number, then + # we assume bpi() is called as a function. + + if (@_ == 0 && + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) + || + !defined($self)) + { + $r[0] = $self; + $class = __PACKAGE__; + $self = bless {}, $class; + } + + # ... or if bpi() is called as a method ... + + else { + @r = @_; + if ($selfref) { # bpi() called as instance method + return $self if $self -> modify('bpi'); + } else { # bpi() called as class method + $self = bless {}, $class; + } } - $self = ref($self) if ref($self); - return $upgrade->new($n) if defined $upgrade; + return $upgrade -> bpi(@r) if defined $upgrade; # hard-wired to "3" - $self->new(3); + $self -> {sign} = '+'; + $self -> {value} = $LIB -> _new("3"); + $self -> round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } sub copy { @@ -1344,8 +1337,8 @@ sub bcmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; @@ -1384,7 +1377,7 @@ sub bacmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; @@ -4137,9 +4130,13 @@ sub objectify { no strict 'refs'; - # What we upgrade to, if anything. + # What we upgrade to, if anything. Note that we need the whole chain of + # upgrading, because we accept objects that go through multiple upgrades, + # e.g., when Math::BigInt upgrades to Math::BigFloat which upgrades to + # Math::BigRat. We delay getting the chain until we actually need it. - my $up = ${"$a[0]::upgrade"}; + my @upg = (); + my $have_upgrade_chain = 0; # Disable downgrading, because Math::BigFloat -> foo('1.0', '2.0') needs # floats. @@ -4150,7 +4147,7 @@ sub objectify { ${"$a[0]::downgrade"} = undef; } - for my $i (1 .. $count) { + ARG: for my $i (1 .. $count) { my $ref = ref $a[$i]; @@ -4167,8 +4164,19 @@ sub objectify { # Upgrading is OK, so skip further tests if the argument is upgraded. - if (defined $up && $ref -> isa($up)) { - next; + unless ($have_upgrade_chain) { + my $cls = $class; + my $upg = $cls -> upgrade(); + while (defined $upg) { + push @upg, $upg; + $cls = $upg; + $upg = $cls -> upgrade(); + } + $have_upgrade_chain = 1; + } + + for my $upg (@upg) { + next ARG if $ref -> isa($upg); } # See if we can call one of the as_xxx() methods. We don't know whether @@ -4227,129 +4235,174 @@ sub import { my $class = shift; $IMPORT++; # remember we did import() my @a; # unrecognized arguments - my @libs; # backend libriaries - my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; # Enable overloading of constants. - if ($_[$i] eq ':constant') { + if ($param eq ':constant') { overload::constant - integer => sub { $class->new(shift) }, - binary => sub { $class->new(shift) }; + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; } - # Enable/disable upgrading. + # Upgrading. - elsif ($_[$i] eq 'upgrade') { - $upgrade = $_[$i+1]; # undef to disable - $i++; + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - # Use a user-specified backend libray. + # Downgrading. - elsif ($_[$i] =~ /^(lib|try|only)\z/) { + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; + } + + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { # try => 0 (no warn if unavailable module) # lib => 1 (warn on fallback) # only => 2 (die on fallback) - $warn_or_die = 1 if $_[$i] eq 'lib'; - $warn_or_die = 2 if $_[$i] eq 'only'; - - # Get and check the list of libraries. - - my $userlibs = $_[$i+1]; - croak "Library argument for import parameter '$_[$i]' is undefined" - unless defined($userlibs); - $userlibs =~ s/^\s+//; - $userlibs =~ s/\s+$//; - my @userlibs = split /\s*,\s*/, $userlibs; - carp "Argument for import parameter '$_[$i]' contains no libraries" - unless @userlibs; - - for my $lib (@userlibs) { - # Limit to sane characters. Should we warn about invalid - # characters, i.e., invalid module names? - $lib =~ tr/a-zA-Z0-9_://cd; - if (CORE::length $lib) { - $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; - push @libs, $lib; - next; - } - carp "Specified library name is empty or invalid"; - } - $i++; - } + # Get the list of user-specified libraries. - else { - push @a, $_[$i]; - } - } + croak "Library argument for import parameter '$param' is missing" + unless @_; + my $libs = shift; + croak "Library argument for import parameter '$param' is undefined" + unless defined($libs); - # Any non ':constant' stuff is handled by our parent, Exporter + # Check and clean up the list of user-specified libraries. - if (@a > 0) { - $class->SUPER::import(@a); # need it for subclasses - $class->export_to_level(1, $class, @a); # need it for MBF - } + my @libs; + for my $lib (split /,/, $libs) { + $lib =~ s/^\s+//; + $lib =~ s/\s+$//; - if (@libs) { + if ($lib =~ /[^a-zA-Z0-9_:]/) { + carp "Library name '$lib' contains invalid characters"; + next; + } - # Try to load the specified libraries, if any. + if (! CORE::length $lib) { + carp "Library name is empty"; + next; + } - my $numfail = 0; # increment for each lib that fails to load - for (my $i = 0 ; $i <= $#libs ; $i++) { - my $lib = $libs[$i]; - eval "require $lib"; - unless ($@) { - $LIB = $lib; - last; + $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; + + # If a library has already been loaded, that is OK only if the + # requested library is identical to the loaded one. + + if (defined($LIB)) { + if ($lib ne $LIB) { + #carp "Library '$LIB' has already been loaded, so", + # " ignoring requested library '$lib'"; + } + next; + } + + push @libs, $lib; } - $numfail++; - } - # All attempts to load a library failed. + next if defined $LIB; - if ($numfail == @libs) { + croak "Library list contains no valid libraries" unless @libs; - # The fallback library is either the most recently loaded library, - # or the default library, if no library has been successfully yet. + # Try to load the specified libraries, if any. - my $FALLBACK_LIB = defined($LIB) ? $LIB : $DEFAULT_LIB; + for (my $i = 0 ; $i <= $#libs ; $i++) { + my $lib = $libs[$i]; + eval "require $lib"; + unless ($@) { + $LIB = $lib; + last; + } + } + + next if defined $LIB; - # If the user requested a specific list of modules and didn't allow - # a fallback. + # No library has been loaded, and none of the requested libraries + # could be loaded, and fallback and the user doesn't allow fallback. - if ($warn_or_die == 2) { + if ($param eq 'only') { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", and fallback to '$FALLBACK_LIB' is disallowed"; + ", and fallback to '$DEFAULT_LIB' is not allowed"; } - # The user accepts the use of a fallback library, so try to load it. - # Note that it might already have been loaded successfully, but we - # don't know that, and there is minimal overhead in trying to load - # it again. + # No library has been loaded, and none of the requested libraries + # could be loaded, but the user accepts the use of a fallback + # library, so try to load it. - eval "require $FALLBACK_LIB"; + eval "require $DEFAULT_LIB"; if ($@) { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", not even the fallback lib '$FALLBACK_LIB'"; + ", not even the fallback lib '$DEFAULT_LIB'"; } - # The fallback library was successfully loaded, but the user might - # want to know that we are using the fallback. + # The fallback library was successfully loaded, but the user + # might want to know that we are using the fallback. - if ($warn_or_die == 1) { + if ($param eq 'lib') { carp "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", so using fallback lib '$FALLBACK_LIB'"; + ", so using fallback lib '$DEFAULT_LIB'"; } + + next; } + + # Unrecognized parameter. + + push @a, $param; + } + + # Any non-':constant' stuff is handled by our parent, Exporter + + if (@a) { + $class->SUPER::import(@a); # need it for subclasses + $class->export_to_level(1, $class, @a); # need it for Math::BigFlaot } # We might not have loaded any backend library yet, either because the user @@ -4368,79 +4421,6 @@ sub import { # import done } -sub _split_dec_string { - my $str = shift; - - if ($str =~ s/ - ^ - - # leading whitespace - ( \s* ) - - # optional sign - ( [+-]? ) - - # significand - ( - \d+ (?: _ \d+ )* - (?: - \. - (?: \d+ (?: _ \d+ )* )? - )? - | - \. - \d+ (?: _ \d+ )* - ) - - # optional exponent - (?: - [Ee] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - # trailing stuff - ( \D .*? )? - - \z - //x) { - my $leading = $1; - my $significand_sgn = $2 || '+'; - my $significand_abs = $3; - my $exponent_sgn = $4 || '+'; - my $exponent_abs = $5 || '0'; - my $trailing = $6; - - # Remove underscores and leading zeros. - - $significand_abs =~ tr/_//d; - $exponent_abs =~ tr/_//d; - - $significand_abs =~ s/^0+(.)/$1/; - $exponent_abs =~ s/^0+(.)/$1/; - - # If the significand contains a dot, remove it and adjust the exponent - # accordingly. E.g., "1234.56789e+3" -> "123456789e-2" - - my $idx = index $significand_abs, '.'; - if ($idx > -1) { - $significand_abs =~ s/0+\z//; - substr($significand_abs, $idx, 1) = ''; - my $exponent = $exponent_sgn . $exponent_abs; - $exponent .= $idx - CORE::length($significand_abs); - $exponent_abs = abs $exponent; - $exponent_sgn = $exponent < 0 ? '-' : '+'; - } - - return($leading, - $significand_sgn, $significand_abs, - $exponent_sgn, $exponent_abs, - $trailing); - } - - return undef; -} - sub _split { # input: num_str; output: undef for invalid or # (\$mantissa_sign, \$mantissa_value, \$mantissa_fraction, @@ -4508,6 +4488,49 @@ sub _split { return; # NaN, not a number } +sub _e_add { + # Internal helper sub to take two positive integers and their signs and + # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output + # ($LIB, ('+'|'-')). + + my ($x, $y, $xs, $ys) = @_; + + # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + if ($xs eq $ys) { + $x = $LIB->_add($x, $y); # +a + +b or -a + -b + } else { + my $a = $LIB->_acmp($x, $y); + if ($a == 0) { + # This does NOT modify $x in-place. TODO: Fix this? + $x = $LIB->_zero(); # result is 0 + $xs = '+'; + return ($x, $xs); + } + if ($a > 0) { + $x = $LIB->_sub($x, $y); # abs sub + } else { # a < 0 + $x = $LIB->_sub ($y, $x, 1); # abs sub + $xs = $ys; + } + } + + $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0" + + return ($x, $xs); +} + +sub _e_sub { + # Internal helper sub to take two positive integers and their signs and + # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), + # output ($LIB, ('+'|'-')) + my ($x, $y, $xs, $ys) = @_; + + # flip sign + $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... + _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job +} + sub _trailing_zeros { # return the amount of trailing zeros in $x (as scalar) my $x = shift; @@ -4596,6 +4619,635 @@ sub _find_round_parameters { ($self, $a, $p, $r); } +# Trims the sign of the significand, the (absolute value of the) significand, +# the sign of the exponent, and the (absolute value of the) exponent. The +# returned values have no underscores ("_") or unnecessary leading or trailing +# zeros. + +sub _trim_split_parts { + shift; + + my $sig_sgn = shift() || '+'; + my $sig_str = shift() || '0'; + my $exp_sgn = shift() || '+'; + my $exp_str = shift() || '0'; + + $sig_str =~ tr/_//d; # "1.0_0_0" -> "1.000" + $sig_str =~ s/^0+//; # "01.000" -> "1.000" + $sig_str =~ s/\.0*$// # "1.000" -> "1" + || $sig_str =~ s/(\..*[^0])0+$/$1/; # "1.010" -> "1.01" + $sig_str = '0' unless CORE::length($sig_str); + + return '+', '0', '+', '0' if $sig_str eq '0'; + + $exp_str =~ tr/_//d; # "01_234" -> "01234" + $exp_str =~ s/^0+//; # "01234" -> "1234" + $exp_str = '0' unless CORE::length($exp_str); + + return $sig_sgn, $sig_str, $exp_sgn, $exp_str; +} + +# Takes any string representing a valid decimal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. Both the +# significand and the exponent are in base 10. +# +# Perl accepts literals like the following. The value is 100.1. +# +# 1__0__.__0__1__e+0__1__ (prints "Misplaced _ in number") +# 1_0.0_1e+0_1 +# +# Strings representing decimal numbers do not allow underscores, so only the +# following is valid +# +# "10.01e+01" + +sub _dec_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # significand + ( + # integer part and optional fraction part ... + \d+ (?: _+ \d+ )* _* + (?: + \. + (?: _* \d+ (?: _+ \d+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + \d+ (?: _+ \d+ )* _* + ) + + # optional exponent + (?: + [Ee] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four strings: the sign of the significand, the absolute value of the +# significand, the sign of the exponent, and the absolute value of the exponent. +# The significand is in base 16, and the exponent is in base 2. +# +# Perl accepts literals like the following. The "x" might be a capital "X". The +# value is 32.0078125. +# +# 0x__1__0__.0__1__p+0__1__ (prints "Misplaced _ in number") +# 0x1_0.0_1p+0_1 +# +# The CORE::hex() function does not accept floating point accepts +# +# "0x_1_0" +# "x_1_0" +# "_1_0" + +sub _hex_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional hex prefix + (?: 0? [Xx] _* )? + + # significand using the hex digits 0..9 and a..f + ( + # integer part and optional fraction part ... + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + (?: + \. + (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid octal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 8, and the exponent is in base 2. + +sub _oct_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional octal prefix + (?: 0? [Oo] _* )? + + # significand using the octal digits 0..7 + ( + # integer part and optional fraction part ... + [0-7]+ (?: _+ [0-7]+ )* _* + (?: + \. + (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-7]+ (?: _+ [0-7]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid binary number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 2, and the exponent is in base 2. + +sub _bin_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional binary prefix + (?: 0? [Bb] _* )? + + # significand using the binary digits 0 and 1 + ( + # integer part and optional fraction part ... + [01]+ (?: _+ [01]+ )* _* + (?: + \. + (?: _* [01]+ (?: _+ [01]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [01]+ (?: _+ [01]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid decimal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _dec_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_; + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., + # + # 12.345e-2 -> 12345e-5 + # 12.345e+2 -> 12345e-1 + # 0.0123e+5 -> 00123e+1 -> 123e+1 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = length - index + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent. E.g., + # + # 12340e-5 -> 1234e-4 + # 12340e-1 -> 1234e0 + # 12340e+3 -> 1234e4 + + if ($sig_str =~ s/(0+)\z//) { + my $len = CORE::length($1); + ($exp_lib, $exp_sgn) = + $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+'); + } + + # At this point, the significand is empty or an integer with no trailing + # zeros. The exponent is in base 10. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $LIB -> _new($sig_str); + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_; + my $bpc_lib = $LIB -> _new($bpc); + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., with + # hexadecimal numbers + # + # 12.345p-2 -> 12345p-14 + # 12.345p+2 -> 12345p-10 + # 0.0123p+5 -> 00123p-11 -> 123p-11 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = (length - index) * bpc + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent accordingly. E.g., with hexadecimal numbers + # + # 12340p-5 -> 1234p-1 + # 12340p-1 -> 1234p+3 + # 12340p+3 -> 1234p+7 + + if ($sig_str =~ s/(0+)\z//) { + + # delta = length * bpc + my $delta = $LIB -> _new(CORE::length($1)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent + delta + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+'); + } + + # At this point, the significand is empty or an integer with no leading + # or trailing zeros. The exponent is in base 2. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str) + : $bpc == 3 ? $LIB -> _from_oct('0' . $sig_str) + : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str) + : die "internal error: invalid exponent multiplier"; + + # If the exponent (in base 2) is positive or zero ... + + if ($exp_sgn eq '+') { + + if (!$LIB -> _is_zero($exp_lib)) { + + # Multiply significand by 2 raised to the exponent. + + my $p = $LIB -> _pow($LIB -> _two(), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + $exp_lib = $LIB -> _zero(); + } + } + + # ... else if the exponent is negative ... + + else { + + # Rather than dividing the significand by 2 raised to the absolute + # value of the exponent, multiply the significand by 5 raised to the + # absolute value of the exponent and let the exponent be in base 10: + # + # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b + + my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + } + + # Adjust for the case when the conversion to decimal introduced trailing + # zeros in the significand. + + my $n = $LIB -> _zeros($sig_lib); + if ($n) { + $n = $LIB -> _new($n); + $sig_lib = $LIB -> _rsft($sig_lib, $n, 10); + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+'); + } + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four parts: the sign of the significand, the absolute value of the significand +# as a libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _hex_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 4); # 4 bits pr. chr + } + return; +} + +# Takes any string representing a valid octal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _oct_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 3); # 3 bits pr. chr + } + return; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 1); # 1 bit pr. chr + } + return; +} + +# Decimal string is split into the sign of the signficant, the absolute value of +# the significand as library thingy, the sign of the exponent, and the absolute +# value of the exponent as a a library thingy. + +sub _dec_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_str_parts($str)) { + return $class -> _dec_parts_to_lib_parts(@parts); + } + return; +} + +# Hexdecimal string to a string using decimal floating point notation. + +sub hex_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Octal string to a string using decimal floating point notation. + +sub oct_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Binary string to a string decimal floating point notation. + +sub bin_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Decimal string to a string using decimal floating point notation. + +sub dec_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Hexdecimal string to decimal notation (no exponent). + +sub hex_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Octal string to decimal notation (no exponent). + +sub oct_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Binary string to decimal notation (no exponent). + +sub bin_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Decimal string to decimal notation (no exponent). + +sub dec_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +sub _lib_parts_to_flt_str { + my $class = shift; + my @parts = @_; + return $parts[0] . $LIB -> _str($parts[1]) + . 'e' . $parts[2] . $LIB -> _str($parts[3]); +} + +sub _lib_parts_to_dec_str { + my $class = shift; + my @parts = @_; + + # The number is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + my $str = $parts[0] + . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10)); + return $str; + } + + # If it is not an integer, add a decimal point. + + else { + my $mant = $LIB -> _str($parts[1]); + my $mant_len = CORE::length($mant); + my $expo = $LIB -> _num($parts[3]); + my $len_cmp = $mant_len <=> $expo; + if ($len_cmp <= 0) { + return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant; + } else { + substr $mant, $mant_len - $expo, 0, '.'; + return $parts[0] . $mant; + } + } +} + ############################################################################### # 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 @@ -4815,7 +5467,9 @@ also provided for Perl operators. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents an integer. +like a number and represents an integer. Anything that is accepted by Perl as a +literal numeric constant should be accepted by this module, except that finite +non-integers return NaN. =over @@ -4825,57 +5479,86 @@ Leading and trailing whitespace is ignored. =item * -Leading zeros are ignored. +Leading zeros are ignored, except for floating point numbers with a binary +exponent, in which case the number is interpreted as an octal floating point +number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0" +gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * -If the string can not be interpreted, NaN is returned. +If the string can not be interpreted, or does not represent a finite integer, +NaN is returned. + +=item * + +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + Input given as scalar numbers might lose precision. Quote your input to ensure that no digits are lost: $x = Math::BigInt->new( 56789012345678901234 ); # bad $x = Math::BigInt->new('56789012345678901234'); # good -Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') -results in 'NaN'. This might change in the future, so use always the following -explicit forms to get a zero or NaN: +Currently, C<Math::BigInt->new()> (no input argument) and +C<Math::BigInt->new("")> return 0. This might change in the future, so always +use the following explicit forms to get a zero: $zero = Math::BigInt->bzero(); - $nan = Math::BigInt->bnan(); =head2 Output @@ -5059,6 +5742,13 @@ The input is accepted as decimal, hexadecimal (with leading '0x') or binary See L</Input> for more info on accepted input formats. +=item from_dec() + + $x = Math::BigInt->from_dec("314159"); # input is decimal + +Interpret input as a decimal. It is equivalent to new(), but does not accept +anything but strings representing finite, decimal numbers. + =item from_hex() $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal @@ -6213,6 +6903,94 @@ needed, for instance in array index operations. =back +=head2 Utility methods + +These utility methods are made public + +=over + +=item dec_str_to_dec_flt_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal floating point +notation. The output consists of five parts joined together: the sign of the +significand, the absolute value of the significand as the smallest possible +integer, the letter "e", the sign of the exponent, and the absolute value of the +exponent. If the input is invalid, nothing is returned. + + $str2 = $class -> dec_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 31400.00e-4 +314e-2 + -0.00012300e8 -123e+2 + 0 +0e+0 + +=item hex_str_to_dec_flt_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal floating +point notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> hex_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 0xff +255e+0 + +Some examples + +=item oct_str_to_dec_flt_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> oct_str_to_dec_flt_str($str1); + +=item bin_str_to_dec_flt_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> bin_str_to_dec_flt_str($str1); + +=item dec_str_to_dec_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal notation. If the +number represents an integer, the output consists of a sign and the absolute +value. If the number represents a non-integer, the output consists of a sign, +the integer part of the number, the decimal point ".", and the fraction part of +the number without any trailing zeros. If the input is invalid, nothing is +returned. + +=item hex_str_to_dec_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item oct_str_to_dec_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item bin_str_to_dec_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal notation. The output +has the same format as that of L</dec_str_to_dec_str()>. + +=back + =head1 ACCURACY and PRECISION Math::BigInt and Math::BigFloat have full support for accuracy and precision @@ -6613,8 +7391,8 @@ are much faster than the default library. =head3 The default library -The default library is L<Math::BigInt::Calc>, which is implemented in -pure Perl and hence does not require a compiler. +The default library is L<Math::BigInt::Calc>, which is implemented in pure Perl +and hence does not require a compiler. =head3 Specifying a library @@ -6637,8 +7415,8 @@ Multiple libraries can be specified by separating them by a comma, e.g., use Math::BigInt try => 'GMP,Pari'; -If you request a specific set of libraries and do not allow fallback, specify -them using "only", +If you request a specific set of libraries and do not allow fallback to the +default library, specify them using "only", use Math::BigInt only => 'GMP,Pari'; @@ -6652,34 +7430,16 @@ if this also fails, reverts to Math::BigInt::Calc: use Math::BigInt try => 'Foo,Math::BigInt::Bar'; -=head3 The fallback library - -The library that is used is the first library that was successfully loaded. The -fallback library is the most recent library that was successfully loaded, or the -default library, if no library has been successfully loaded. - -In the following example, assume "Pari" can be loaded, but "Foo" can't. Since -"Pari" can be loaded, it is used. Since "Foo" can't be loaded, "Pari" is used as -the fallback library, since it is the most recently successfully loaded library. - - use Math::BigInt; # "Calc" (default) is used - use Math::BigInt try => "Pari"; # "Pari" is used - use Math::BigFloat try => "Foo"; # fallback to "Pari" - -As shown, multiple libraries can be loaded, and the library in used can be -changed. However, all library loading should be done before any objects are -created. Mixing objects that use different backend libraries won't work. - -=head3 What library to use? +=head3 Which library to use? B<Note>: General purpose packages should not be explicit about the library to use; let the script author decide which is best. -L<Math::BigInt::GMP> and L<Math::BigInt::Pari> are in cases involving big -numbers much faster than L<Math::BigInt::Calc>. However it is slower when -dealing with very small numbers (less than about 20 digits) and when converting -very large numbers to decimal (for instance for printing, rounding, calculating -their length in decimal etc.). +L<Math::BigInt::GMP>, L<Math::BigInt::Pari>, and L<Math::BigInt::GMPz> are in +cases involving big numbers much faster than L<Math::BigInt::Calc>. However +these libraries are slower when dealing with very small numbers (less than about +20 digits) and when converting very large numbers to decimal (for instance for +printing, rounding, calculating their length in decimal etc.). So please select carefully what library you want to use. @@ -6689,6 +7449,16 @@ internal format. See the respective math library module documentation for further details. +=head3 Loading multiple libraries + +The first library that is successfully loaded is the one that will be used. Any +further attempts at loading a different module will be ignored. This is to avoid +the situation where module A requires math library X, and module B requires math +library Y, causing modules A and B to be incompatible. For example, + + use Math::BigInt; # loads default "Calc" + use Math::BigFloat only => "GMP"; # ignores "GMP" + =head2 SIGN The sign is either '+', '-', 'NaN', '+inf' or '-inf'. @@ -6749,49 +7519,69 @@ Examples for converting: my $x = Math::BigInt->new('0b1'.'01' x 123); print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal -and binary constants in the given scope are converted to C<Math::BigInt>. This -conversion happens at compile time. +After C<use Math::BigInt ':constant'> all numeric literals in the given scope +are converted to C<Math::BigInt> objects. This conversion happens at compile +time. Every non-integer is convert to a NaN. -In particular, +For example, - perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' + perl -MMath::BigInt=:constant -le 'print 2**150' -prints the integer value of C<2**100>. Note that without conversion of -constants the expression 2**100 is calculated using Perl scalars. +prints the exact value of C<2**150>. Note that without conversion of constants +to objects the expression C<2**150> is calculated using Perl scalars, which +leads to an inaccurate result. -Please note that strings and floating point constants are not affected, so that +Please note that strings are not affected, so that use Math::BigInt qw/:constant/; - $x = 1234567890123456789012345678901234567890 - + 123456789123456789; - $y = '1234567890123456789012345678901234567890' - + '123456789123456789'; + $x = "1234567890123456789012345678901234567890" + + "123456789123456789"; -does not give you what you expect. You need an explicit Math::BigInt->new() -around one of the operands. You should also quote large constants to protect +does give you what you expect. You need an explicit Math::BigInt->new() around +at least one of the operands. You should also quote large constants to prevent loss of precision: use Math::BigInt; - $x = Math::BigInt->new('1234567889123456789123456789123456789'); + $x = Math::BigInt->new("1234567889123456789123456789123456789"); + +Without the quotes Perl first converts the large number to a floating point +constant at compile time, and then converts the result to a Math::BigInt object +at run time, which results in an inaccurate result. + +=head2 Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. + +Hexadecimal floating point literals: + + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 + +Octal floating point literals (with "0" prefix): -Without the quotes Perl would convert the large number to a floating point -constant at compile time and then hand the result to Math::BigInt, which -results in an truncated result or a NaN. + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -This also applies to integers that look like floating point constants: +Octal floating point literals (with "0o" prefix) (requires v5.34.0): - use Math::BigInt ':constant'; + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - print ref(123e2),"\n"; - print ref(123.2e2),"\n"; +Binary floating point literals: -prints nothing but newlines. Use either L<bignum> or L<Math::BigFloat> to get -this to work. + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 =head1 PERFORMANCE diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 61a5f63acd..1269f644bf 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -7,7 +7,7 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; our @ISA = ('Math::BigInt::Lib'); @@ -87,7 +87,8 @@ sub config { } sub _base_len { - my $class = shift; + #my $class = shift; # $class is not used + shift; if (@_) { # if called as setter ... my ($base_len, $use_int) = @_; @@ -402,10 +403,10 @@ sub _add { # For each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry. Trades one # "$j++" for having to shift arrays. - my $i; + my $car = 0; my $j = 0; - for $i (@$y) { + for my $i (@$y) { $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0; $j++; } @@ -451,10 +452,9 @@ sub _sub { my ($c, $sx, $sy, $s) = @_; my $car = 0; - my $i; my $j = 0; if (!$s) { - for $i (@$sx) { + for my $i (@$sx) { last unless defined $sy->[$j] || $car; $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++; @@ -462,7 +462,7 @@ sub _sub { # might leave leading zeros, so fix that return __strip_zeros($sx); } - for $i (@$sx) { + for my $i (@$sx) { # We can't do an early out if $x < $y, since we need to copy the high # chunks from $y. Found by Bob Mathews. #last unless defined $sy->[$j] || $car; @@ -517,13 +517,13 @@ sub _mul_use_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } @@ -578,13 +578,13 @@ sub _mul_no_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $rem, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $rem, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $rem = $prod % $BASE; $car = ($prod - $rem) / $BASE; @@ -2127,7 +2127,7 @@ sub _as_oct { my $x1 = $c->_copy($x); - my $x1000 = [ 0100000 ]; + my $x1000 = [ 1 << 15 ]; # 15 bits = 32768 = 0100000 my $es = ''; my $xr; @@ -2143,7 +2143,7 @@ sub _from_oct { # convert a octal number to decimal (string, return ref to array) my ($c, $os) = @_; - my $m = $c->_new(010000000000); # 30 bits at a time (<32 bits!) + my $m = $c->_new(1 << 30); # 30 bits at a time (<32 bits!) my $d = 10; # 10 octal digits at a time my $mul = $c->_one(); @@ -2219,7 +2219,7 @@ sub _modinv { # modulo zero if ($c->_is_zero($y)) { - return undef, undef; + return; } # modulo one @@ -2250,7 +2250,7 @@ sub _modinv { } # if the gcd is not 1, then return NaN - return (undef, undef) unless $c->_is_one($a); + return unless $c->_is_one($a); ($v, $sign == 1 ? '+' : '-'); } @@ -2393,6 +2393,27 @@ together with 'use_int', the current value for the base length is used. =back +=head1 METHODS + +This overview constains only the methods that are specific to +C<Math::BigInt::Calc>. For the other methods, see L<Math::BigInt::Lib>. + +=over 4 + +=item _base_len() + +Specify the desired base length and whether to enable "use integer" in the +computations. + + Math::BigInt::Calc -> _base_len($base_len, $use_int); + +Note that it is better to specify the base length and whether to use integers as +options when the module is loaded, for example like this + + use Math::BigInt::Calc base_len => 6, use_int => 1; + +=back + =head1 SEE ALSO L<Math::BigInt::Lib> for a description of the API. diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm index ee5577c6dd..ac570af3f1 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; use Carp; @@ -352,6 +352,56 @@ sub _dec { $class -> _sub($x, $class -> _one()); } +# Signed addition. If the flag is false, $xa might be modified, but not $ya. If +# the false is true, $ya might be modified, but not $xa. + +sub _sadd { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + my ($za, $zs); + + # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + + if ($xs eq $ys) { + if ($flag) { + $za = $class -> _add($ya, $xa); + } else { + $za = $class -> _add($xa, $ya); + } + $zs = $class -> _is_zero($za) ? '+' : $xs; + return $za, $zs; + } + + my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y) + + if ($acmp == 0) { # x = -y or -x = y + $za = $class -> _zero(); + $zs = '+'; + return $za, $zs; + } + + if ($acmp > 0) { # abs(x) > abs(y) + $za = $class -> _sub($xa, $ya, $flag); + $zs = $xs; + } else { # abs(x) < abs(y) + $za = $class -> _sub($ya, $xa, !$flag); + $zs = $ys; + } + return $za, $zs; +} + +# Signed subtraction. If the flag is false, $xa might be modified, but not $ya. +# If the false is true, $ya might be modified, but not $xa. + +sub _ssub { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + + # Swap sign of second operand and let _sadd() do the job. + $ys = $ys eq '+' ? '-' : '+'; + $class -> _sadd($xa, $xs, $ya, $ys, $flag); +} + ############################################################################## # testing @@ -2140,24 +2190,38 @@ arbitrarily large. =item CLASS-E<gt>_add(OBJ1, OBJ2) -Returns the result of adding OBJ2 to OBJ1. +Addition. Returns the result of adding OBJ2 to OBJ1. =item CLASS-E<gt>_mul(OBJ1, OBJ2) -Returns the result of multiplying OBJ2 and OBJ1. +Multiplication. Returns the result of multiplying OBJ2 and OBJ1. =item CLASS-E<gt>_div(OBJ1, OBJ2) -In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and -truncating the result to an integer. In list context, return the quotient and -the remainder. +Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2 +and truncating the result to an integer. In list context, return the quotient +and the remainder. =item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG) =item CLASS-E<gt>_sub(OBJ1, OBJ2) -Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted, -OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. +Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false +or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. + +=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with +sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); + +=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to +OBJ1 with sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); =item CLASS-E<gt>_dec(OBJ) diff --git a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm index c9ec01e129..9955f205dc 100644 --- a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm +++ b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # for testing subclassing Math::BigFloat diff --git a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm index c6ef25d2f1..30e1a14fdf 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::BareCalc; @@ -12,6 +12,7 @@ our $VERSION = '1.999803'; use Math::BigInt::Calc 1.9998; our @ISA = qw(Math::BigInt::Calc); -print "# BareCalc using Calc v", Math::BigInt::Calc -> VERSION, "\n"; +print "# Math::BigInt::BareCalc v", $VERSION, " using", + " Math::BigInt::Calc v", Math::BigInt::Calc -> VERSION, "\n"; 1; diff --git a/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm index cb24e25ac5..5ff98bf19a 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Lib::TestUtil; diff --git a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm index 5acdf1c24d..56b5e509dd 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Subclass; diff --git a/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t b/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t new file mode 100644 index 0000000000..67edea9bf3 --- /dev/null +++ b/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t @@ -0,0 +1,88 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 36; + +use Math::BigInt; + +my $LIB = Math::BigInt -> config('lib'); + +sub try { + my ($in0, $in1, $in2, $in3, $in4, $out0, $out1, $out2, $out3) = @_; + + my @out; + my $test = q|@out = Math::BigInt -> _bin_parts_to_lib_parts| + . qq|("$in0", "$in1", "$in2", "$in3", $in4)|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 5; + + is(scalar(@out), 4, 'number of output arguments'); + is($out[0], $out0, 'sign of the significand'); + is($LIB -> _str($out[1]), $out1, 'absolute value of the significand'); + is($out[2], $out2, 'sign of the exponent'); + is($LIB -> _str($out[3]), $out3, 'absolute value of the exponent'); + }; +} + +note("binary"); + +try qw< + 0 + 0 >, 1, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 1, qw< + 0 + 0 >; + +try qw< + 1010 + 0 >, 1, qw< + 1 + 1 >; +try qw< + 1111 + 0 >, 1, qw< + 15 + 0 >; +try qw< + 0.1 + 0 >, 1, qw< + 5 - 1 >; + +try qw< + 10 - 8 >, 1, qw< + 78125 - 7 >; +try qw< + 10 + 8 >, 1, qw< + 512 + 0 >; + +try qw< + 11000000001100 - 0 >, 1, qw< + 123 + 2 >; +try qw< + 1100000000110000 - 2 >, 1, qw< + 123 + 2 >; + +try qw< + .00110011 + 5 >, 1, qw< + 6375 - 3 >; + +try qw< - 1100.0011 + 2 >, 1, qw< - 4875 - 2 >; + +note("octal"); + +try qw< + 0 + 0 >, 3, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 3, qw< + 0 + 0 >; +try qw< + 12 + 0 >, 3, qw< + 1 + 1 >; +try qw< + 17 + 0 >, 3, qw< + 15 + 0 >; +try qw< + 0.4 + 0 >, 3, qw< + 5 - 1 >; +try qw< + 2 - 8 >, 3, qw< + 78125 - 7 >; +try qw< + 2 + 8 >, 3, qw< + 512 + 0 >; +try qw< + 30014 - 0 >, 3, qw< + 123 + 2 >; +try qw< + 14006 + 1 >, 3, qw< + 123 + 2 >; +try qw< + 12300 + 0 >, 3, qw< + 5312 + 0 >; + +note("hexadecimal"); + +try qw< + 0 + 0 >, 4, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 4, qw< + 0 + 0 >; + +try qw< + a + 0 >, 4, qw< + 1 + 1 >; +try qw< + f + 0 >, 4, qw< + 15 + 0 >; +try qw< + 0.8 + 0 >, 4, qw< + 5 - 1 >; + +try qw< + 2 - 8 >, 4, qw< + 78125 - 7 >; +try qw< + 2 + 8 >, 4, qw< + 512 + 0 >; + +try qw< + 300c - 0 >, 4, qw< + 123 + 2 >; +try qw< + 1.806 + 13 >, 4, qw< + 123 + 2 >; +try qw< + c030 - 2 >, 4, qw< + 123 + 2 >; + +try qw< + 0.0625 + 16 >, 4, qw< + 1573 + 0 >; + +try qw< + .0123 + 0 >, 4, qw< + 44403076171875 - 16 >; +try qw< + 12300 + 0 >, 4, qw< + 74496 + 0 >; + +try qw< + .00120034 + 5 >, 4, qw< + 87894499301910400390625 - 25 >; + +try qw< - 1200.0034 + 2 >, 4, qw< - 18432003173828125 - 12 >; diff --git a/cpan/Math-BigInt/t/_bin_str_to_str_parts.t b/cpan/Math-BigInt/t/_bin_str_to_str_parts.t new file mode 100644 index 0000000000..f8faa76fc9 --- /dev/null +++ b/cpan/Math-BigInt/t/_bin_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _bin_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0110:+:.011:+:0 +0110.0:+:110:+:0 +0110.0110:+:110.011:+:0 + +0b1.p0:+:1:+:0 + +00.0011001100P0056007800:+:.00110011:+:56007800 + ++1__1__.__1__1__p+5__6__:+:11.11:+:56 ++1__1__.__1__1__p-5__6__:+:11.11:-:56 +-1__1__.__1__1__p+5__6__:-:11.11:+:56 +-1__1__.__1__1__p-5__6__:-:11.11:-:56 + +1__1__.__1__1__p5__6__:+:11.11:+:56 +1__1__.__1__1__p-5__6__:+:11.11:-:56 +-1__1__.__1__1__p5__6__:-:11.11:+:56 + +-0b__1__1__.__1__1__p-1__1__:-:11.11:-:11 +-0B__1__1__.__1__1__P-1__1__:-:11.11:-:11 diff --git a/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t b/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t new file mode 100644 index 0000000000..dd4f4a4137 --- /dev/null +++ b/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t @@ -0,0 +1,69 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 30; + +use Math::BigInt; + +my $LIB = Math::BigInt -> config('lib'); + +sub try { + my ($in0, $in1, $in2, $in3, $out0, $out1, $out2, $out3) = @_; + + my @out; + my $test = q|@out = Math::BigInt -> _dec_parts_to_lib_parts| + . qq|("$in0", "$in1", "$in2", "$in3")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 5; + + is(scalar(@out), 4, 'number of output arguments'); + is($out[0], $out0, 'sign of the significand'); + is($LIB -> _str($out[1]), $out1, 'absolute value of the significand'); + is($out[2], $out2, 'sign of the exponent'); + is($LIB -> _str($out[3]), $out3, 'absolute value of the exponent'); + }; +} + +try qw< + 0 + 0 >, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, qw< + 0 + 0 >; + +try qw< + 0.01230 + 5 >, qw< + 123 + 1 >; +try qw< + 0.1230 + 5 >, qw< + 123 + 2 >; +try qw< + 1.230 + 5 >, qw< + 123 + 3 >; +try qw< + 12.30 + 5 >, qw< + 123 + 4 >; +try qw< + 123.0 + 5 >, qw< + 123 + 5 >; +try qw< + 1230.0 + 5 >, qw< + 123 + 6 >; + +try qw< + 0.01230 + 2 >, qw< + 123 - 2 >; +try qw< + 0.1230 + 2 >, qw< + 123 - 1 >; +try qw< + 1.230 + 2 >, qw< + 123 + 0 >; +try qw< + 12.30 + 2 >, qw< + 123 + 1 >; +try qw< + 123.0 + 2 >, qw< + 123 + 2 >; +try qw< + 1230.0 + 2 >, qw< + 123 + 3 >; + +try qw< + 0.01230 - 2 >, qw< + 123 - 6 >; +try qw< + 0.1230 - 2 >, qw< + 123 - 5 >; +try qw< + 1.230 - 2 >, qw< + 123 - 4 >; +try qw< + 12.30 - 2 >, qw< + 123 - 3 >; +try qw< + 123.0 - 2 >, qw< + 123 - 2 >; +try qw< + 1230.0 - 2 >, qw< + 123 - 1 >; + +try qw< + 0.01230 - 4 >, qw< + 123 - 8 >; +try qw< + 0.1230 - 4 >, qw< + 123 - 7 >; +try qw< + 1.230 - 4 >, qw< + 123 - 6 >; +try qw< + 12.30 - 4 >, qw< + 123 - 5 >; +try qw< + 123.0 - 4 >, qw< + 123 - 4 >; +try qw< + 1230.0 - 4 >, qw< + 123 - 3 >; + +try qw< + .0123 + 0 >, qw< + 123 - 4 >; +try qw< + 12300 + 0 >, qw< + 123 + 2 >; + +try qw< + .00120034 + 5 >, qw< + 120034 - 3 >; + +try qw< - 1200.0034 + 2 >, qw< - 12000034 - 2 >; diff --git a/cpan/Math-BigInt/t/_dec_str_to_str_parts.t b/cpan/Math-BigInt/t/_dec_str_to_str_parts.t new file mode 100644 index 0000000000..d94d8cd464 --- /dev/null +++ b/cpan/Math-BigInt/t/_dec_str_to_str_parts.t @@ -0,0 +1,57 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 16; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _dec_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0e-0:+:0:+:0 +0e-7:+:0:+:0 +0e+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +1.e0:+:1:+:0 + +00.0012003400E0056007800:+:.00120034:+:56007800 + ++1__2__.__3__4__e+5__6__:+:12.34:+:56 ++1__2__.__3__4__e-5__6__:+:12.34:-:56 +-1__2__.__3__4__e+5__6__:-:12.34:+:56 +-1__2__.__3__4__e-5__6__:-:12.34:-:56 + +1__2__.__3__4__e5__6__:+:12.34:+:56 +1__2__.__3__4__e-5__6__:+:12.34:-:56 +-1__2__.__3__4__e5__6__:-:12.34:+:56 diff --git a/cpan/Math-BigInt/t/_e_math.t b/cpan/Math-BigInt/t/_e_math.t index 1c136a565e..3cf917bb01 100644 --- a/cpan/Math-BigInt/t/_e_math.t +++ b/cpan/Math-BigInt/t/_e_math.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test the helper math routines in Math::BigFloat diff --git a/cpan/Math-BigInt/t/_hex_str_to_str_parts.t b/cpan/Math-BigInt/t/_hex_str_to_str_parts.t new file mode 100644 index 0000000000..02bdd1345a --- /dev/null +++ b/cpan/Math-BigInt/t/_hex_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _hex_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +0x1.p0:+:1:+:0 + +00.0012003400P0056007800:+:.00120034:+:56007800 + ++1__2__.__3__4__p+5__6__:+:12.34:+:56 ++1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p+5__6__:-:12.34:+:56 +-1__2__.__3__4__p-5__6__:-:12.34:-:56 + +1__2__.__3__4__p5__6__:+:12.34:+:56 +1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p5__6__:-:12.34:+:56 + +-0x__a__b__.__c__d__p-1__2__:-:ab.cd:-:12 +-0X__A__B__.__C__D__P-1__2__:-:AB.CD:-:12 diff --git a/cpan/Math-BigInt/t/_oct_str_to_str_parts.t b/cpan/Math-BigInt/t/_oct_str_to_str_parts.t new file mode 100644 index 0000000000..c6431f261c --- /dev/null +++ b/cpan/Math-BigInt/t/_oct_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _oct_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +01.p0:+:1:+:0 + +00.0012003400P0056007800:+:.00120034:+:56007800 + ++0__1__2__.__3__4__p+5__6__:+:12.34:+:56 ++0__1__2__.__3__4__p-5__6__:+:12.34:-:56 +-0__1__2__.__3__4__p+5__6__:-:12.34:+:56 +-0__1__2__.__3__4__p-5__6__:-:12.34:-:56 + +01__2__.__3__4__p5__6__:+:12.34:+:56 +1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p5__6__:-:12.34:+:56 + +-0o__1__2__.__3__4__p-5__6__:-:12.34:-:56 +-0O__1__2__.__3__4__P-5__6__:-:12.34:-:56 diff --git a/cpan/Math-BigInt/t/alias.inc b/cpan/Math-BigInt/t/alias.inc index 3b381e18e2..a3f3857fc9 100644 --- a/cpan/Math-BigInt/t/alias.inc +++ b/cpan/Math-BigInt/t/alias.inc @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/backermann-mbi.t b/cpan/Math-BigInt/t/backermann-mbi.t index 45fcac6dbd..cc32dd1df0 100644 --- a/cpan/Math-BigInt/t/backermann-mbi.t +++ b/cpan/Math-BigInt/t/backermann-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bare_mbf.t b/cpan/Math-BigInt/t/bare_mbf.t index 7c1a121454..3d94a6cb07 100644 --- a/cpan/Math-BigInt/t/bare_mbf.t +++ b/cpan/Math-BigInt/t/bare_mbf.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076; +use Test::More tests => 3070; use lib 't'; diff --git a/cpan/Math-BigInt/t/bare_mbi.t b/cpan/Math-BigInt/t/bare_mbi.t index 3ab9f991bb..f3509cfa45 100644 --- a/cpan/Math-BigInt/t/bare_mbi.t +++ b/cpan/Math-BigInt/t/bare_mbi.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292; # tests in require'd file +use Test::More tests => 4280; # tests in require'd file use lib 't'; diff --git a/cpan/Math-BigInt/t/bare_mif.t b/cpan/Math-BigInt/t/bare_mif.t index 3946d1524a..ed2c27cf36 100644 --- a/cpan/Math-BigInt/t/bare_mif.t +++ b/cpan/Math-BigInt/t/bare_mif.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes under Math::BigInt::BareCalc diff --git a/cpan/Math-BigInt/t/bdigitsum-mbi.t b/cpan/Math-BigInt/t/bdigitsum-mbi.t index 45c9bd7256..0991191317 100644 --- a/cpan/Math-BigInt/t/bdigitsum-mbi.t +++ b/cpan/Math-BigInt/t/bdigitsum-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bdstr-mbf.t b/cpan/Math-BigInt/t/bdstr-mbf.t index 8b13bd4403..950ae6f279 100644 --- a/cpan/Math-BigInt/t/bdstr-mbf.t +++ b/cpan/Math-BigInt/t/bdstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bdstr-mbi.t b/cpan/Math-BigInt/t/bdstr-mbi.t index d369ec9f8f..68671619cf 100644 --- a/cpan/Math-BigInt/t/bdstr-mbi.t +++ b/cpan/Math-BigInt/t/bdstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bestr-mbf.t b/cpan/Math-BigInt/t/bestr-mbf.t index fcb11078b3..12277a5272 100644 --- a/cpan/Math-BigInt/t/bestr-mbf.t +++ b/cpan/Math-BigInt/t/bestr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bestr-mbi.t b/cpan/Math-BigInt/t/bestr-mbi.t index 1d391d4e35..8c4c0bd518 100644 --- a/cpan/Math-BigInt/t/bestr-mbi.t +++ b/cpan/Math-BigInt/t/bestr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bfib-mbi.t b/cpan/Math-BigInt/t/bfib-mbi.t index 3b24eca823..91e7aafad5 100644 --- a/cpan/Math-BigInt/t/bfib-mbi.t +++ b/cpan/Math-BigInt/t/bfib-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/big_pi_e.t b/cpan/Math-BigInt/t/big_pi_e.t index 66705da1ae..8e2aa11281 100644 --- a/cpan/Math-BigInt/t/big_pi_e.t +++ b/cpan/Math-BigInt/t/big_pi_e.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test bpi() and bexp() diff --git a/cpan/Math-BigInt/t/bigfltpm.inc b/cpan/Math-BigInt/t/bigfltpm.inc index 0f5e9e4e83..0b25505849 100644 --- a/cpan/Math-BigInt/t/bigfltpm.inc +++ b/cpan/Math-BigInt/t/bigfltpm.inc @@ -183,9 +183,9 @@ while (<DATA>) { $x = Math::BigInt->new(1200); $y = $CLASS->new($x); is($y, 1200, - q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $y|); + qq|\$x = Math::BigInt->new(1200); \$y = $CLASS->new(\$x); # check \$y|); is($x, 1200, - q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $x|); + qq|\$x = Math::BigInt->new(1200); \$y = $CLASS->new(\$x); # check \$x|); ############################################################################### # Really huge, big, ultra-mega-biggy-monster exponents. Technically, the @@ -698,9 +698,6 @@ invalid:NaN 123:123 -123.4567:-123.4567 # invalid inputs -1__2:NaN -1E1__2:NaN -11__2E2:NaN .2E-3.:NaN 1e3e4:NaN # strange, but valid diff --git a/cpan/Math-BigInt/t/bigfltpm.t b/cpan/Math-BigInt/t/bigfltpm.t index fb68c05530..d2c7300b05 100644 --- a/cpan/Math-BigInt/t/bigfltpm.t +++ b/cpan/Math-BigInt/t/bigfltpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 19; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/bigintc-import.t b/cpan/Math-BigInt/t/bigintc-import.t index 161328e595..a2b75be17c 100644 --- a/cpan/Math-BigInt/t/bigintc-import.t +++ b/cpan/Math-BigInt/t/bigintc-import.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; @@ -12,7 +12,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc->_base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt/t/bigintc.t b/cpan/Math-BigInt/t/bigintc.t index 87384f7968..cf589ad14f 100644 --- a/cpan/Math-BigInt/t/bigintc.t +++ b/cpan/Math-BigInt/t/bigintc.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test Math::BigInt::Calc @@ -14,7 +14,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc -> _base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt/t/bigintpm.inc b/cpan/Math-BigInt/t/bigintpm.inc index d59a3f1c68..61d3ab2f40 100644 --- a/cpan/Math-BigInt/t/bigintpm.inc +++ b/cpan/Math-BigInt/t/bigintpm.inc @@ -1232,7 +1232,6 @@ NaN:-inf: 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 -0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input @@ -1245,7 +1244,6 @@ NaN:-inf: 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 -0x__123:NaN 0x9:9 0x11:17 0x21:33 @@ -1298,10 +1296,6 @@ abc:NaN # only one underscore between two digits _123:NaN _123_:NaN -123_:NaN -1__23:NaN -1E1__2:NaN -1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN diff --git a/cpan/Math-BigInt/t/bigintpm.t b/cpan/Math-BigInt/t/bigintpm.t index 7c97920cc5..3b78f2e1af 100644 --- a/cpan/Math-BigInt/t/bigintpm.t +++ b/cpan/Math-BigInt/t/bigintpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292 # tests in require'd file +use Test::More tests => 4280 # tests in require'd file + 20; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/bigints.t b/cpan/Math-BigInt/t/bigints.t index 1a08f255c5..b02a44bce7 100644 --- a/cpan/Math-BigInt/t/bigints.t +++ b/cpan/Math-BigInt/t/bigints.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/biglog.t b/cpan/Math-BigInt/t/biglog.t index d6d695ccb9..6045a6f8c3 100644 --- a/cpan/Math-BigInt/t/biglog.t +++ b/cpan/Math-BigInt/t/biglog.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test blog function (and bpow, since it uses blog), as well as bexp(). diff --git a/cpan/Math-BigInt/t/bigroot.t b/cpan/Math-BigInt/t/bigroot.t index 3280c7068c..4a62bdc5f6 100644 --- a/cpan/Math-BigInt/t/bigroot.t +++ b/cpan/Math-BigInt/t/bigroot.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test broot function (and bsqrt() function, since it is used by broot()). diff --git a/cpan/Math-BigInt/t/blucas-mbi.t b/cpan/Math-BigInt/t/blucas-mbi.t index 17b9017fbf..9a9215929f 100644 --- a/cpan/Math-BigInt/t/blucas-mbi.t +++ b/cpan/Math-BigInt/t/blucas-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnok-mbf.t b/cpan/Math-BigInt/t/bnok-mbf.t index edeaad86ac..d8b915121b 100644 --- a/cpan/Math-BigInt/t/bnok-mbf.t +++ b/cpan/Math-BigInt/t/bnok-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnok-mbi.t b/cpan/Math-BigInt/t/bnok-mbi.t index 9fd3ab2e72..26fe2ffa67 100644 --- a/cpan/Math-BigInt/t/bnok-mbi.t +++ b/cpan/Math-BigInt/t/bnok-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnstr-mbf.t b/cpan/Math-BigInt/t/bnstr-mbf.t index d21051a915..9e03a5bf48 100644 --- a/cpan/Math-BigInt/t/bnstr-mbf.t +++ b/cpan/Math-BigInt/t/bnstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnstr-mbi.t b/cpan/Math-BigInt/t/bnstr-mbi.t index 361166c6db..ee4eec385e 100644 --- a/cpan/Math-BigInt/t/bnstr-mbi.t +++ b/cpan/Math-BigInt/t/bnstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bpi-mbf.t b/cpan/Math-BigInt/t/bpi-mbf.t new file mode 100644 index 0000000000..38b9350b2d --- /dev/null +++ b/cpan/Math-BigInt/t/bpi-mbf.t @@ -0,0 +1,53 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use Math::BigFloat; +use Scalar::Util qw< refaddr >; + +my $x; + +################################################################################ + +note('class method'); + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigFloat -> bpi(); +is($x, '3.141592653589793238462643383279502884197', + '$x = Math::BigFloat -> bpi();'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigFloat -> bpi(10); +is($x, '3.141592654', + '$x = Math::BigFloat -> bpi(10);'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); + +################################################################################ + +note('instance method'); + +my $y; + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigFloat -> new(100); +$y = $x -> bpi(); +is($x, '3.141592653589793238462643383279502884197', + '$x = Math::BigFloat -> new(100); $y = $x -> bpi();'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigFloat -> new(100); +$y = $x -> bpi(10); +is($x, '3.141592654', + '$x = Math::BigFloat -> new(100); $y = $x -> bpi(10);'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); diff --git a/cpan/Math-BigInt/t/bpi-mbi.t b/cpan/Math-BigInt/t/bpi-mbi.t new file mode 100644 index 0000000000..6fa66687de --- /dev/null +++ b/cpan/Math-BigInt/t/bpi-mbi.t @@ -0,0 +1,103 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 24; + +use Math::BigInt; +use Scalar::Util qw< refaddr >; + +my $x; + +################################################################################ + +note('class method, without upgrading'); + +$x = Math::BigInt -> bpi(); +is($x, '3', '$x = Math::BigInt -> bpi()'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); + +$x = Math::BigInt -> bpi(10); +is($x, '3', '$x = Math::BigInt -> bpi(10)'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); + +note('class method, with upgrading'); + +require Math::BigFloat; +Math::BigInt -> upgrade('Math::BigFloat'); + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigInt -> bpi(); +is($x, '3.141592653589793238462643383279502884197', '$x = Math::BigInt -> bpi()'); +is(ref($x), "Math::BigFloat", + '$x is a Math::BigFloat'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigInt -> bpi(10); +is($x, '3.141592654', '$x = Math::BigInt -> bpi(10)'); +is(ref($x), "Math::BigFloat", + '$x is a Math::BigFloat'); + +################################################################################ + +Math::BigInt -> upgrade(undef); + +note('instance method, without upgrading'); + +my $y; + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(); +is($x, '3', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(10); +is($x, '3', + '$x = Math::BigInt -> new(100); $y = $x -> bpi(10);'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +note('instance method, with upgrading'); + +require Math::BigFloat; +Math::BigInt -> upgrade('Math::BigFloat'); + +# When no accuracy is specified, default accuracy shall be used. + +# When upgrading is in effect, a new object is returned. + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(); +is($x, '100', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($x), "Math::BigInt", + '$x is a Math::BigInt'); +is($y, '3.141592653589793238462643383279502884197', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($y), "Math::BigFloat", + '$y is a Math::BigFloat'); +isnt(refaddr($x), refaddr($y), '$x and $y are not the same object'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(10); +is($x, '100', + '$x = Math::BigInt -> new(100); $y = $x -> bpi(10);'); +is(ref($x), "Math::BigInt", + '$x is a Math::BigInt'); +is($y, '3.141592654', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($y), "Math::BigFloat", + '$y is a Math::BigFloat'); +isnt(refaddr($x), refaddr($y), '$x and $y are not the same object'); diff --git a/cpan/Math-BigInt/t/bsstr-mbf.t b/cpan/Math-BigInt/t/bsstr-mbf.t index 89faab1784..3c18e6c64f 100644 --- a/cpan/Math-BigInt/t/bsstr-mbf.t +++ b/cpan/Math-BigInt/t/bsstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bsstr-mbi.t b/cpan/Math-BigInt/t/bsstr-mbi.t index 1422522d06..1093aa2821 100644 --- a/cpan/Math-BigInt/t/bsstr-mbi.t +++ b/cpan/Math-BigInt/t/bsstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/buparrow-mbi.t b/cpan/Math-BigInt/t/buparrow-mbi.t index c2eb2eec61..f2583418f9 100644 --- a/cpan/Math-BigInt/t/buparrow-mbi.t +++ b/cpan/Math-BigInt/t/buparrow-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/calling-class-methods.t b/cpan/Math-BigInt/t/calling-class-methods.t index 27ada2eb0c..c623d6fb0d 100644 --- a/cpan/Math-BigInt/t/calling-class-methods.t +++ b/cpan/Math-BigInt/t/calling-class-methods.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test calling conventions, and :constant overloading @@ -51,7 +51,7 @@ while (<DATA>) { my @args = split /:/, $_, 99; $expected = pop @args; foreach my $class (qw/ - Math::BigInt Math::BigFloat + Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test /) { diff --git a/cpan/Math-BigInt/t/calling-constant.t b/cpan/Math-BigInt/t/calling-constant.t new file mode 100644 index 0000000000..13d6b52ae8 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-constant.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether :constant works or not + +$try = qq|use $class 0, "bgcd", ":constant";| + . q| $x = 2**150; bgcd($x); $x = "$x";|; +$expected = eval $try; +is($expected, "1427247692705959881058285969449495136382746624", $try); diff --git a/cpan/Math-BigInt/t/calling-instance-methods.t b/cpan/Math-BigInt/t/calling-instance-methods.t index 30421da67b..4ccdf96d00 100644 --- a/cpan/Math-BigInt/t/calling-instance-methods.t +++ b/cpan/Math-BigInt/t/calling-instance-methods.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test calling conventions, and :constant overloading @@ -51,7 +51,7 @@ while (<DATA>) { my @args = split /:/, $_, 99; $expected = pop @args; foreach my $class (qw/ - Math::BigInt Math::BigFloat + Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test /) { diff --git a/cpan/Math-BigInt/t/calling-lib1.t b/cpan/Math-BigInt/t/calling-lib1.t new file mode 100644 index 0000000000..9cdc3ce663 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-lib1.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) + +$try = qq|use $class 0, "lib" => "Scalar";| + . q| $x = 2**10; $x = "$x";|; +$expected = eval $try; +is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/calling-lib2.t b/cpan/Math-BigInt/t/calling-lib2.t new file mode 100644 index 0000000000..1d8a5dde31 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-lib2.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) + +$try = qq|use $class 0, "lib" => "$class\::Scalar";| + . q| $x = 2**10; $x = "$x";|; +$expected = eval $try; +is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/calling.t b/cpan/Math-BigInt/t/calling.t deleted file mode 100644 index ae584205d0..0000000000 --- a/cpan/Math-BigInt/t/calling.t +++ /dev/null @@ -1,70 +0,0 @@ -#!perl - -# test calling conventions, and :constant overloading - -use strict; -use warnings; -use lib 't'; - -my $VERSION = '1.999823'; # adjust manually to match latest release - -use Test::More tests => 5; - -############################################################################## - -package Math::BigInt::Test; - -use Math::BigInt; -our @ISA = qw/Math::BigInt/; # subclass of MBI -use overload; - -############################################################################## - -package Math::BigFloat::Test; - -use Math::BigFloat; -our @ISA = qw/Math::BigFloat/; # subclass of MBF -use overload; - -############################################################################## - -package main; - -use Math::BigInt try => 'Calc'; -use Math::BigFloat; - -my ($x, $expected, $try); - -my $class = 'Math::BigInt'; - -# test whether use Math::BigInt qw/VERSION/ works -$try = "use $class " . ($VERSION . '1') . ";"; -$try .= ' $x = $class->new(123); $x = "$x";'; -eval $try; -like($@, qr/ ^ Math::BigInt \s+ ( version \s+ )? \S+ \s+ required--this \s+ - is \s+ only \s+ version \s+ \S+ /x, - $try); - -# test whether fallback to calc works -$try = qq|use $class $VERSION, "try", "foo, bar, ";| - . qq| $class\->config("lib");|; -$expected = eval $try; -like($expected, qr/^Math::BigInt::(Fast)?Calc\z/, $try); - -# test whether constant works or not, also test for qw($VERSION) -# bgcd() is present in subclass, too -$try = qq|use $class $VERSION, "bgcd", ":constant";| - . q| $x = 2**150; bgcd($x); $x = "$x";|; -$expected = eval $try; -is($expected, "1427247692705959881058285969449495136382746624", $try); - -# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) -$try = qq|use $class $VERSION, "lib", "Scalar";| - . q| $x = 2**10; $x = "$x";|; -$expected = eval $try; -is($expected, "1024", $try); - -$try = qq|use $class $VERSION, "lib", "$class\::Scalar";| - . q| $x = 2**10; $x = "$x";|; -$expected = eval $try; -is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/config.t b/cpan/Math-BigInt/t/config.t index e472404a1b..25fd92a154 100644 --- a/cpan/Math-BigInt/t/config.t +++ b/cpan/Math-BigInt/t/config.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/const-mbf.t b/cpan/Math-BigInt/t/const-mbf.t new file mode 100644 index 0000000000..d6231ae2ff --- /dev/null +++ b/cpan/Math-BigInt/t/const-mbf.t @@ -0,0 +1,314 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "170"; + +use Math::BigFloat ":constant"; + +my $class = "Math::BigFloat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "0.999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999.9", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "3.140625", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "3.140625", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} diff --git a/cpan/Math-BigInt/t/const-mbi.t b/cpan/Math-BigInt/t/const-mbi.t new file mode 100644 index 0000000000..17c30c217d --- /dev/null +++ b/cpan/Math-BigInt/t/const-mbi.t @@ -0,0 +1,235 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "118"; + +use Math::BigInt ":constant"; + +my $class = "Math::BigInt"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} diff --git a/cpan/Math-BigInt/t/const_mbf.t b/cpan/Math-BigInt/t/const_mbf.t deleted file mode 100644 index 37524a357b..0000000000 --- a/cpan/Math-BigInt/t/const_mbf.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl - -# test Math::BigFloat constants alone (w/o Math::BigInt loading) - -use strict; -use warnings; - -use Test::More tests => 2; - -use Math::BigFloat ':constant'; - -is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', - "1.0 / 3.0 = 0.3333333333333333333333333333333333333333"); - -# Math::BigInt was not loaded with ':constant', so only floats are handled -is(ref(2 ** 2), '', "2 ** 2 is a scalar"); diff --git a/cpan/Math-BigInt/t/constant.t b/cpan/Math-BigInt/t/constant.t deleted file mode 100644 index 1f760d6280..0000000000 --- a/cpan/Math-BigInt/t/constant.t +++ /dev/null @@ -1,46 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 7; - -use Math::BigInt ':constant'; - -is(2 ** 255, - '578960446186580977117854925043439539266' - . '34992332820282019728792003956564819968', - '2 ** 255'); - -{ - no warnings 'portable'; # protect against "non-portable" warnings - - # hexadecimal constants - is(0x123456789012345678901234567890, - Math::BigInt->new('0x123456789012345678901234567890'), - 'hexadecimal constant 0x123456789012345678901234567890'); - - # binary constants - is(0b01010100011001010110110001110011010010010110000101101101, - Math::BigInt->new('0b0101010001100101011011000111' - . '0011010010010110000101101101'), - 'binary constant 0b0101010001100101011011000111' - . '0011010010010110000101101101'); -} - -use Math::BigFloat ':constant'; -is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', - '1.0 / 3.0 = 0.3333333333333333333333333333333333333333'); - -# stress-test Math::BigFloat->import() - -Math::BigFloat->import(qw/:constant/); -pass('Math::BigFloat->import(qw/:constant/);'); - -Math::BigFloat->import(qw/:constant upgrade Math::BigRat/); -pass('Math::BigFloat->import(qw/:constant upgrade Math::BigRat/);'); - -Math::BigFloat->import(qw/upgrade Math::BigRat :constant/); -pass('Math::BigFloat->import(qw/upgrade Math::BigRat :constant/);'); - -# all tests done diff --git a/cpan/Math-BigInt/t/downgrade.t b/cpan/Math-BigInt/t/downgrade.t index ce8a24ff56..ea7c4b584e 100644 --- a/cpan/Math-BigInt/t/downgrade.t +++ b/cpan/Math-BigInt/t/downgrade.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/dparts-mbf.t b/cpan/Math-BigInt/t/dparts-mbf.t index 90a29dd753..43bdd22b76 100644 --- a/cpan/Math-BigInt/t/dparts-mbf.t +++ b/cpan/Math-BigInt/t/dparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/dparts-mbi.t b/cpan/Math-BigInt/t/dparts-mbi.t index 4488b2e597..0b4ba38267 100644 --- a/cpan/Math-BigInt/t/dparts-mbi.t +++ b/cpan/Math-BigInt/t/dparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/eparts-mbf.t b/cpan/Math-BigInt/t/eparts-mbf.t index 0c84ac6662..a612461fa9 100644 --- a/cpan/Math-BigInt/t/eparts-mbf.t +++ b/cpan/Math-BigInt/t/eparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/eparts-mbi.t b/cpan/Math-BigInt/t/eparts-mbi.t index 5c84e28c2d..783f716e5c 100644 --- a/cpan/Math-BigInt/t/eparts-mbi.t +++ b/cpan/Math-BigInt/t/eparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_base-mbi.t b/cpan/Math-BigInt/t/from_base-mbi.t index 88912cba71..1f664e1652 100644 --- a/cpan/Math-BigInt/t/from_base-mbi.t +++ b/cpan/Math-BigInt/t/from_base-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_base_num-mbi.t b/cpan/Math-BigInt/t/from_base_num-mbi.t index b407787274..aad7c6d18b 100644 --- a/cpan/Math-BigInt/t/from_base_num-mbi.t +++ b/cpan/Math-BigInt/t/from_base_num-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_bin-mbf.t b/cpan/Math-BigInt/t/from_bin-mbf.t index 577f8c1a80..a24f1bfd4d 100644 --- a/cpan/Math-BigInt/t/from_bin-mbf.t +++ b/cpan/Math-BigInt/t/from_bin-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_bin-mbi.t b/cpan/Math-BigInt/t/from_bin-mbi.t index 96aa8b3b35..da8300726b 100644 --- a/cpan/Math-BigInt/t/from_bin-mbi.t +++ b/cpan/Math-BigInt/t/from_bin-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_hex-mbf.t b/cpan/Math-BigInt/t/from_hex-mbf.t index cff00bfdf3..8a9f3cf012 100644 --- a/cpan/Math-BigInt/t/from_hex-mbf.t +++ b/cpan/Math-BigInt/t/from_hex-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_hex-mbi.t b/cpan/Math-BigInt/t/from_hex-mbi.t index 280cf3c74a..200253134f 100644 --- a/cpan/Math-BigInt/t/from_hex-mbi.t +++ b/cpan/Math-BigInt/t/from_hex-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_ieee754-mbf.t b/cpan/Math-BigInt/t/from_ieee754-mbf.t index 99dd6e1e07..8edb904ba4 100644 --- a/cpan/Math-BigInt/t/from_ieee754-mbf.t +++ b/cpan/Math-BigInt/t/from_ieee754-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_oct-mbf.t b/cpan/Math-BigInt/t/from_oct-mbf.t index 921ca6878a..2fff2a0ba3 100644 --- a/cpan/Math-BigInt/t/from_oct-mbf.t +++ b/cpan/Math-BigInt/t/from_oct-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_oct-mbi.t b/cpan/Math-BigInt/t/from_oct-mbi.t index 5107fd1fb0..3ec700ee88 100644 --- a/cpan/Math-BigInt/t/from_oct-mbi.t +++ b/cpan/Math-BigInt/t/from_oct-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/inf_nan.t b/cpan/Math-BigInt/t/inf_nan.t index f297c1d9d9..9634396b71 100644 --- a/cpan/Math-BigInt/t/inf_nan.t +++ b/cpan/Math-BigInt/t/inf_nan.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test inf/NaN handling all in one place # Thanx to Jarkko for the excellent explanations and the tables diff --git a/cpan/Math-BigInt/t/isa.t b/cpan/Math-BigInt/t/isa.t index b99babc783..984d048b98 100644 --- a/cpan/Math-BigInt/t/isa.t +++ b/cpan/Math-BigInt/t/isa.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/lib_load-mbf-mbi.t b/cpan/Math-BigInt/t/lib_load-mbf-mbi.t new file mode 100644 index 0000000000..e18476ed49 --- /dev/null +++ b/cpan/Math-BigInt/t/lib_load-mbf-mbi.t @@ -0,0 +1,72 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use lib "t"; + +# First load Math::BigFloat with Math::BigInt::Calc. + +use Math::BigFloat lib => "Calc"; + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + 'ref Math::BigFloat -> bzero() -> {_m}'); + +# Math::BigInt will know that we loaded Math::BigInt::Calc. + +require Math::BigInt; + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); + +# Now load Math::BigFloat again with a different lib. + +Math::BigFloat -> import(lib => "BareCalc"); + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + 'ref Math::BigFloat -> bzero() -> {_m}'); + +# See if Math::BigInt knows about Math::BigInt::BareCalc. + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + "Math::BigInt is using library Math::BigInt::Calc"); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); + +# See that Math::BigInt supports "only". + +eval { Math::BigInt -> import("only" => "Calc") }; +subtest 'Math::BigInt -> import("only" => "Calc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); +}; + +# See that Math::BigInt supports "try". + +eval { Math::BigInt -> import("try" => "BareCalc") }; +subtest 'Math::BigInt -> import("try" => "BareCalc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); +} diff --git a/cpan/Math-BigInt/t/lib_load-mbi-mbf.t b/cpan/Math-BigInt/t/lib_load-mbi-mbf.t new file mode 100644 index 0000000000..8868667fe3 --- /dev/null +++ b/cpan/Math-BigInt/t/lib_load-mbi-mbf.t @@ -0,0 +1,72 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use lib "t"; + +# First load Math::BigInt with Math::BigInt::Calc. + +use Math::BigInt lib => "Calc"; + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + 'ref Math::BigInt -> bzero() -> {value}'); + +# Math::BigFloat will know that we loaded Math::BigInt::Calc. + +require Math::BigFloat; + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); + +# Now load Math::BigInt again with a different lib. + +Math::BigInt -> import(lib => "BareCalc"); + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + 'ref Math::BigInt -> bzero() -> {value}'); + +# See if Math::BigFloat knows about Math::BigInt::BareCalc. + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + "Math::BigFloat is using library Math::BigInt::Calc"); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); + +# See that Math::BigFloat supports "only". + +eval { Math::BigFloat -> import("only" => "Calc") }; +subtest 'Math::BigFloat -> import("only" => "Calc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); +}; + +# See that Math::BigFloat supports "try". + +eval { Math::BigFloat -> import("try" => "BareCalc") }; +subtest 'Math::BigFloat -> import("try" => "BareCalc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); +} diff --git a/cpan/Math-BigInt/t/lib_load.t b/cpan/Math-BigInt/t/lib_load.t deleted file mode 100644 index 68871e2244..0000000000 --- a/cpan/Math-BigInt/t/lib_load.t +++ /dev/null @@ -1,32 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 4; - -use lib 't'; - -# first load Math::BigInt with Math::BigInt::Calc -use Math::BigInt lib => 'Calc'; - -# Math::BigFloat will remember that we loaded Math::BigInt::Calc -require Math::BigFloat; -is(Math::BigFloat->config("lib"), 'Math::BigInt::Calc', - 'Math::BigFloat got Math::BigInt::Calc'); - -# now load Math::BigInt again with a different lib -Math::BigInt->import(lib => 'BareCalc'); - -# and finally test that Math::BigFloat knows about Math::BigInt::BareCalc - -is(Math::BigFloat->config("lib"), 'Math::BigInt::BareCalc', - 'Math::BigFloat was notified'); - -# See that Math::BigFloat supports "only" -eval { Math::BigFloat->import('only' => 'Calc') }; -is(Math::BigFloat->config("lib"), 'Math::BigInt::Calc', '"only" worked'); - -# See that Math::BigFloat supports "try" -eval { Math::BigFloat->import('try' => 'BareCalc') }; -is(Math::BigFloat->config("lib"), 'Math::BigInt::BareCalc', '"try" worked'); diff --git a/cpan/Math-BigInt/t/mbf_ali.t b/cpan/Math-BigInt/t/mbf_ali.t index 3999aa7e82..b96d2051b5 100644 --- a/cpan/Math-BigInt/t/mbf_ali.t +++ b/cpan/Math-BigInt/t/mbf_ali.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/mbi_ali.t b/cpan/Math-BigInt/t/mbi_ali.t index 45ed6c4dc6..7e3e0a063f 100644 --- a/cpan/Math-BigInt/t/mbi_ali.t +++ b/cpan/Math-BigInt/t/mbi_ali.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/mbi_rand.t b/cpan/Math-BigInt/t/mbi_rand.t index fce5e20cdd..eae6e39e02 100644 --- a/cpan/Math-BigInt/t/mbi_rand.t +++ b/cpan/Math-BigInt/t/mbi_rand.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/mbimbf.t b/cpan/Math-BigInt/t/mbimbf.t index d9167e1807..23599ddb6a 100644 --- a/cpan/Math-BigInt/t/mbimbf.t +++ b/cpan/Math-BigInt/t/mbimbf.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes diff --git a/cpan/Math-BigInt/t/nan_cmp.t b/cpan/Math-BigInt/t/nan_cmp.t index c84be9003e..adaf906226 100644 --- a/cpan/Math-BigInt/t/nan_cmp.t +++ b/cpan/Math-BigInt/t/nan_cmp.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that overloaded compare works when NaN are involved diff --git a/cpan/Math-BigInt/t/new-mbf.t b/cpan/Math-BigInt/t/new-mbf.t index 0400390c35..d4fa8b6017 100644 --- a/cpan/Math-BigInt/t/new-mbf.t +++ b/cpan/Math-BigInt/t/new-mbf.t @@ -1,9 +1,11 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 100; +use Test::More tests => 112; + +use Scalar::Util qw< refaddr >; my $class; @@ -35,6 +37,110 @@ while (<DATA>) { } +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + no warnings "numeric"; + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); +# is($x, "0", 'output arg has the right value'); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + no warnings "uninitialized"; + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new($x) +# +# In this case, when $x isa Math::BigFloat, only the sign and value should be +# copied from $x, not the accuracy or precision. + +SKIP: { + skip "This test reveals a bug that has not been fixed yet", 2; + + my ($a, $p, $x, $y); + + $a = $class -> accuracy(); # get original + $class -> accuracy(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> accuracy(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> accuracy(), 4711, 'object has the global accuracy'); + $class -> accuracy($a); # reset + + $p = $class -> precision(); # get original + $class -> precision(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> precision(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> precision(), 4711, 'object has the global precision'); + $class -> precision($p); # reset +} + +# Make sure that library thingies are indeed copied. + +{ + my ($x, $y); + + $x = $class -> new("314"); # create object + $y = $class -> new($x); # create new object + subtest 'library thingy is copied' => sub { + my @keys = ('_m', '_e'); + plan tests => scalar @keys; + for my $key (@keys) { + isnt(refaddr($y -> {$key}), refaddr($x -> {$key}), + 'library thingy is a copy'); + } + }; +} + +# Other tests where we must use the scientific notation in the output. + +for my $str (qw/ + 1e+4294967296 + 1e+18446744073709551616 + 1e+79228162514264337593543950336 + 1e+340282366920938463463374607431768211456 + 1e+1461501637330902918203684832716283019655932542976 + 1e+6277101735386680763835789423207666416102355444464034512896 + /) +{ + my $x; + $x = $class -> new($str); + subtest $str, sub { + plan tests => 2, + + is(ref($x), $class, "output arg is a $class"); + is($x -> bnstr(), $str, 'output arg has the right value'); + } +} + __END__ NaN:NaN diff --git a/cpan/Math-BigInt/t/new-mbi.t b/cpan/Math-BigInt/t/new-mbi.t new file mode 100644 index 0000000000..07d826d4ca --- /dev/null +++ b/cpan/Math-BigInt/t/new-mbi.t @@ -0,0 +1,279 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 106; + +use Scalar::Util qw< refaddr >; + +my $class; + +BEGIN { $class = 'Math::BigInt'; } +BEGIN { use_ok($class); } + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0) = split /:/; + my $x; + my $test = qq|\$x = $class -> new("$in0");|; + my $desc = $test; + + eval $test; + die $@ if $@; # this should never happen + + subtest $desc, sub { + plan tests => 2, + + # Check output. + + is(ref($x), $class, "output arg is a $class"); + is($x, $out0, 'output arg has the right value'); + }; + +} + +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + no warnings "numeric"; + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + #is($x, "0", 'output arg has the right value'); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + no warnings "uninitialized"; + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new($x) +# +# In this case, when $x isa Math::BigInt, only the sign and value should be +# copied from $x, not the accuracy or precision. + +{ + my ($a, $p, $x, $y); + + $a = $class -> accuracy(); # get original + $class -> accuracy(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> accuracy(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> accuracy(), 4711, 'object has the global accuracy'); + $class -> accuracy($a); # reset + + $p = $class -> precision(); # get original + $class -> precision(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> precision(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> precision(), 4711, 'object has the global precision'); + $class -> precision($p); # reset +} + +# Make sure that library thingies are indeed copied. + +{ + my ($x, $y); + + $x = $class -> new("314"); # create object + $y = $class -> new($x); # create new object + subtest 'library thingy is copied' => sub { + my @keys = ('value'); + plan tests => scalar @keys; + for my $key (@keys) { + isnt(refaddr($y -> {$key}), refaddr($x -> {$key}), + 'library thingy is a copy'); + } + }; +} + +__END__ + +NaN:NaN +inf:inf +infinity:inf ++inf:inf ++infinity:inf +-inf:-inf +-infinity:-inf + +# This is the same data as in from_bin-mbf.t, except that some of them are +# commented out, since new() only treats input as binary if it has a "0b" or +# "0B" prefix, possibly with a leading "+" or "-" sign. Duplicates from above +# are also commented out. + +0b1p+0:1 +0b.1p+1:1 +0b.01p+2:1 +0b.001p+3:1 +0b.0001p+4:1 +0b10p-1:1 +0b100p-2:1 +0b1000p-3:1 + +-0b1p+0:-1 + +0b0p+0:0 +0b0p+7:0 +0b0p-7:0 +0b0.p+0:0 +0b.0p+0:0 +0b0.0p+0:0 + +0b1100101011111110:51966 +0B1100101011111110:51966 +b1100101011111110:51966 +B1100101011111110:51966 +#1100101011111110:51966 + +0b1.1001p+3:NaN +0b10010.001101p-1:NaN +-0b.11110001001101010111100110111101111p+31:NaN +0b10.0100011010001010110011110001001101p+34:39093746765 + +0b.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN + +# This is more or less the same data as in from_oct-mbf.t, except that some of +# them are commented out, since new() does not consider a number with just a +# leading zero to be an octal number. Duplicates from above are also commented +# out. + +# Without "0o" prefix. + +001p+0:1 +00.4p+1:1 +00.2p+2:1 +00.1p+3:1 +00.04p+4:1 +02p-1:1 +04p-2:1 +010p-3:1 + +-01p+0:-1 + +00p+0:0 +00p+7:0 +00p-7:0 +00.p+0:0 +00.0p+0:0 + +#145376:51966 +#0145376:51966 +#00145376:51966 + +03.1p+2:NaN +022.15p-1:NaN +-00.361152746757p+32:NaN +044.3212636115p+30:39093746765 + +0.p+0:NaN +.p+0:NaN + +# With "0o" prefix. + +0o01p+0:1 +0o0.4p+1:1 +0o0.2p+2:1 +0o0.1p+3:1 +0o0.04p+4:1 +0o02p-1:1 +0o04p-2:1 +0o010p-3:1 + +-0o1p+0:-1 + +0o0p+0:0 +0o0p+7:0 +0o0p-7:0 +0o0.p+0:0 +0o.0p+0:0 +0o0.0p+0:0 + +0o145376:51966 +0O145376:51966 +o145376:51966 +O145376:51966 + +0o3.1p+2:NaN +0o22.15p-1:NaN +-0o0.361152746757p+32:NaN +0o44.3212636115p+30:39093746765 + +0o.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN + +# This is the same data as in from_hex-mbf.t, except that some of them are +# commented out, since new() only treats input as hexadecimal if it has a "0x" +# or "0X" prefix, possibly with a leading "+" or "-" sign. + +0x1p+0:1 +0x.8p+1:1 +0x.4p+2:1 +0x.2p+3:1 +0x.1p+4:1 +0x2p-1:1 +0x4p-2:1 +0x8p-3:1 + +-0x1p+0:-1 + +0x0p+0:0 +0x0p+7:0 +0x0p-7:0 +0x0.p+0:0 +0x.0p+0:0 +0x0.0p+0:0 + +0xcafe:51966 +0Xcafe:51966 +xcafe:51966 +Xcafe:51966 +#cafe:51966 + +0x1.9p+3:NaN +0x12.34p-1:NaN +-0x.789abcdefp+32:NaN +0x12.3456789ap+31:39093746765 + +0x.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN diff --git a/cpan/Math-BigInt/t/new_overloaded.t b/cpan/Math-BigInt/t/new_overloaded.t index 011f54fc78..b5a4f274e4 100644 --- a/cpan/Math-BigInt/t/new_overloaded.t +++ b/cpan/Math-BigInt/t/new_overloaded.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Math::BigFloat->new had a bug where it would assume any object is a # Math::BigInt which broke overloaded non-Math::BigInt objects. diff --git a/cpan/Math-BigInt/t/nparts-mbf.t b/cpan/Math-BigInt/t/nparts-mbf.t index a680628122..0c558ad3be 100644 --- a/cpan/Math-BigInt/t/nparts-mbf.t +++ b/cpan/Math-BigInt/t/nparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/nparts-mbi.t b/cpan/Math-BigInt/t/nparts-mbi.t index c2f41f3a08..a970535339 100644 --- a/cpan/Math-BigInt/t/nparts-mbi.t +++ b/cpan/Math-BigInt/t/nparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/objectify_mbf.t b/cpan/Math-BigInt/t/objectify_mbf.t index 258ed7b196..8ea7abe1e0 100644 --- a/cpan/Math-BigInt/t/objectify_mbf.t +++ b/cpan/Math-BigInt/t/objectify_mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigFloat or subclass thereof. diff --git a/cpan/Math-BigInt/t/objectify_mbi.t b/cpan/Math-BigInt/t/objectify_mbi.t index 8bb3571969..8efb4520c7 100644 --- a/cpan/Math-BigInt/t/objectify_mbi.t +++ b/cpan/Math-BigInt/t/objectify_mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigInt or subclass thereof. diff --git a/cpan/Math-BigInt/t/req_mbf0.t b/cpan/Math-BigInt/t/req_mbf0.t index f8af78727f..976cb0c263 100644 --- a/cpan/Math-BigInt/t/req_mbf0.t +++ b/cpan/Math-BigInt/t/req_mbf0.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bzero() works diff --git a/cpan/Math-BigInt/t/req_mbf1.t b/cpan/Math-BigInt/t/req_mbf1.t index f9b7cc48e2..74ad48bca0 100644 --- a/cpan/Math-BigInt/t/req_mbf1.t +++ b/cpan/Math-BigInt/t/req_mbf1.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bone() works diff --git a/cpan/Math-BigInt/t/req_mbfa.t b/cpan/Math-BigInt/t/req_mbfa.t index 1a83b1cca6..a436aa27a2 100644 --- a/cpan/Math-BigInt/t/req_mbfa.t +++ b/cpan/Math-BigInt/t/req_mbfa.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bnan() works diff --git a/cpan/Math-BigInt/t/req_mbfi.t b/cpan/Math-BigInt/t/req_mbfi.t index 9db1e9ab84..69c82c0f08 100644 --- a/cpan/Math-BigInt/t/req_mbfi.t +++ b/cpan/Math-BigInt/t/req_mbfi.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then binf() works diff --git a/cpan/Math-BigInt/t/req_mbfn.t b/cpan/Math-BigInt/t/req_mbfn.t index ffeb8b3b0e..eef0e011af 100644 --- a/cpan/Math-BigInt/t/req_mbfn.t +++ b/cpan/Math-BigInt/t/req_mbfn.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then new() works diff --git a/cpan/Math-BigInt/t/req_mbfw.t b/cpan/Math-BigInt/t/req_mbfw.t index db095677c0..2e7ece75b2 100644 --- a/cpan/Math-BigInt/t/req_mbfw.t +++ b/cpan/Math-BigInt/t/req_mbfw.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that requiring Math::BigFloat and then calling import() works diff --git a/cpan/Math-BigInt/t/require.t b/cpan/Math-BigInt/t/require.t index 3c34db6885..32fde97158 100644 --- a/cpan/Math-BigInt/t/require.t +++ b/cpan/Math-BigInt/t/require.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigInt works diff --git a/cpan/Math-BigInt/t/round.t b/cpan/Math-BigInt/t/round.t index 4110626c3d..e92b57fd40 100644 --- a/cpan/Math-BigInt/t/round.t +++ b/cpan/Math-BigInt/t/round.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding with non-integer A and P parameters diff --git a/cpan/Math-BigInt/t/rt-16221.t b/cpan/Math-BigInt/t/rt-16221.t index d531046085..ccd66a5e38 100644 --- a/cpan/Math-BigInt/t/rt-16221.t +++ b/cpan/Math-BigInt/t/rt-16221.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # # Verify that # - Math::BigInt::objectify() calls as_int() (or as_number(), as a fallback) diff --git a/cpan/Math-BigInt/t/sparts-mbf.t b/cpan/Math-BigInt/t/sparts-mbf.t index 1e16763b8a..b1a7a4a87e 100644 --- a/cpan/Math-BigInt/t/sparts-mbf.t +++ b/cpan/Math-BigInt/t/sparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/sparts-mbi.t b/cpan/Math-BigInt/t/sparts-mbi.t index 86620b7faf..5d1dab333f 100644 --- a/cpan/Math-BigInt/t/sparts-mbi.t +++ b/cpan/Math-BigInt/t/sparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/sub_ali.t b/cpan/Math-BigInt/t/sub_ali.t index 2f145b4e23..4b125db344 100644 --- a/cpan/Math-BigInt/t/sub_ali.t +++ b/cpan/Math-BigInt/t/sub_ali.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/sub_mbf.t b/cpan/Math-BigInt/t/sub_mbf.t index 472ad9445e..08845c7b5c 100644 --- a/cpan/Math-BigInt/t/sub_mbf.t +++ b/cpan/Math-BigInt/t/sub_mbf.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 6; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/sub_mbi.t b/cpan/Math-BigInt/t/sub_mbi.t index 65ea327a5a..ae2855f054 100644 --- a/cpan/Math-BigInt/t/sub_mbi.t +++ b/cpan/Math-BigInt/t/sub_mbi.t @@ -1,9 +1,9 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292 # tests in require'd file +use Test::More tests => 4280 # tests in require'd file + 5; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/sub_mif.t b/cpan/Math-BigInt/t/sub_mif.t index 250db3f189..8e9cad4f10 100644 --- a/cpan/Math-BigInt/t/sub_mif.t +++ b/cpan/Math-BigInt/t/sub_mif.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes diff --git a/cpan/Math-BigInt/t/to_base-mbi.t b/cpan/Math-BigInt/t/to_base-mbi.t index c97e2887e1..61f2ae7850 100644 --- a/cpan/Math-BigInt/t/to_base-mbi.t +++ b/cpan/Math-BigInt/t/to_base-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/to_base_num-mbi.t b/cpan/Math-BigInt/t/to_base_num-mbi.t index 4c66b91ed2..821aefb896 100644 --- a/cpan/Math-BigInt/t/to_base_num-mbi.t +++ b/cpan/Math-BigInt/t/to_base_num-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/to_ieee754-mbf.t b/cpan/Math-BigInt/t/to_ieee754-mbf.t index ef79870d0d..7994b705a1 100644 --- a/cpan/Math-BigInt/t/to_ieee754-mbf.t +++ b/cpan/Math-BigInt/t/to_ieee754-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/trap.t b/cpan/Math-BigInt/t/trap.t index 05af8821b4..28d75cf6d8 100644 --- a/cpan/Math-BigInt/t/trap.t +++ b/cpan/Math-BigInt/t/trap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test that config ( trap_nan => 1, trap_inf => 1) really works/dies diff --git a/cpan/Math-BigInt/t/upgrade.inc b/cpan/Math-BigInt/t/upgrade.inc index 92e85a043b..ce5771eef3 100644 --- a/cpan/Math-BigInt/t/upgrade.inc +++ b/cpan/Math-BigInt/t/upgrade.inc @@ -430,7 +430,6 @@ NaN:-inf: 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 -0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input @@ -443,7 +442,6 @@ NaN:-inf: 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 -0x__123:NaN 0x9:9 0x11:17 0x21:33 @@ -493,10 +491,6 @@ abc:NaN # only one underscore between two digits _123:NaN _123_:NaN -123_:NaN -1__23:NaN -1E1__2:NaN -1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN diff --git a/cpan/Math-BigInt/t/upgrade.t b/cpan/Math-BigInt/t/upgrade.t index b161a8fe2e..fa72e8da2a 100644 --- a/cpan/Math-BigInt/t/upgrade.t +++ b/cpan/Math-BigInt/t/upgrade.t @@ -1,9 +1,9 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 2146 # tests in require'd file +use Test::More tests => 2134 # tests in require'd file + 2; # tests in this file use Math::BigInt upgrade => 'Math::BigFloat'; diff --git a/cpan/Math-BigInt/t/upgrade2.t b/cpan/Math-BigInt/t/upgrade2.t index 5009d61678..8b8c03691d 100644 --- a/cpan/Math-BigInt/t/upgrade2.t +++ b/cpan/Math-BigInt/t/upgrade2.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/upgradef.t b/cpan/Math-BigInt/t/upgradef.t index d79297ba75..d76e97c74b 100644 --- a/cpan/Math-BigInt/t/upgradef.t +++ b/cpan/Math-BigInt/t/upgradef.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; @@ -16,7 +16,7 @@ use overload; sub isa { my ($self, $class) = @_; - return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these + return if $class =~ /^Math::Big(Int|Float$)/; # we aren't one of these UNIVERSAL::isa($self, $class); } @@ -43,8 +43,8 @@ $LIB = "Math::BigInt::Calc"; # backend is(Math::BigFloat->upgrade(), $EXPECTED_CLASS, qq|Math::BigFloat->upgrade()|); -is(Math::BigFloat->downgrade() || '', '', - qq/Math::BigFloat->downgrade() || ''/); +is(Math::BigFloat->downgrade(), undef, + qq|Math::BigFloat->downgrade()|); $x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123); diff --git a/cpan/Math-BigInt/t/use.t b/cpan/Math-BigInt/t/use.t index d04a11afc1..a84e3dff21 100644 --- a/cpan/Math-BigInt/t/use.t +++ b/cpan/Math-BigInt/t/use.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # use Module(); doesn't call import() - thanx for cpan testers David. M. Town # and Andreas Marcel Riechert for spotting it. It is fixed by the same code diff --git a/cpan/Math-BigInt/t/use_lib1.t b/cpan/Math-BigInt/t/use_lib1.t index 6c80a6af47..eb12b91fff 100644 --- a/cpan/Math-BigInt/t/use_lib1.t +++ b/cpan/Math-BigInt/t/use_lib1.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigFloat lib => 'BareCalc'; # loads "BareCalc" is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', "Math::BigInt->config('lib')"); diff --git a/cpan/Math-BigInt/t/use_lib2.t b/cpan/Math-BigInt/t/use_lib2.t index dc03e1f1e0..d3a7b45165 100644 --- a/cpan/Math-BigInt/t/use_lib2.t +++ b/cpan/Math-BigInt/t/use_lib2.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,10 +9,10 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigInt; # loads "Calc" +use Math::BigFloat lib => 'BareCalc'; # ignores "BareCalc" -is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', +is(Math::BigInt->config('lib'), 'Math::BigInt::Calc', "Math::BigInt->config('lib')"); is(Math::BigFloat->new(123)->badd(123), 246, diff --git a/cpan/Math-BigInt/t/use_lib3.t b/cpan/Math-BigInt/t/use_lib3.t index 2dcd72bdcd..bcf7967d19 100644 --- a/cpan/Math-BigInt/t/use_lib3.t +++ b/cpan/Math-BigInt/t/use_lib3.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt lib => 'BareCalc'; +use Math::BigInt lib => 'BareCalc'; # ignores "BareCalc" use Math::BigFloat; is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', diff --git a/cpan/Math-BigInt/t/use_lib4.t b/cpan/Math-BigInt/t/use_lib4.t index d5739c3776..190d7bbf17 100644 --- a/cpan/Math-BigInt/t/use_lib4.t +++ b/cpan/Math-BigInt/t/use_lib4.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent, except this, since the later overrides @@ -10,10 +10,10 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt lib => 'BareCalc'; -use Math::BigFloat lib => 'Calc'; +use Math::BigInt lib => 'BareCalc'; # loads "BareCalc" +use Math::BigFloat lib => 'Calc'; # ignores "Calc" -is(Math::BigInt->config('lib'), 'Math::BigInt::Calc', +is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', "Math::BigInt->config('lib')"); is(Math::BigFloat->new(123)->badd(123), 246, diff --git a/cpan/Math-BigInt/t/use_lib5.t b/cpan/Math-BigInt/t/use_lib5.t index 1c122dd134..9fff6c8593 100644 --- a/cpan/Math-BigInt/t/use_lib5.t +++ b/cpan/Math-BigInt/t/use_lib5.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigFloat lib => 'BareCalc'; # loads "BareCalc" use Math::BigInt; is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', diff --git a/cpan/Math-BigInt/t/use_lib6.t b/cpan/Math-BigInt/t/use_lib6.t index 7271ca419d..cd0aea7774 100644 --- a/cpan/Math-BigInt/t/use_lib6.t +++ b/cpan/Math-BigInt/t/use_lib6.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,9 +9,8 @@ use lib 't'; use Test::More tests => 1; -use Math::BigInt lib => 'BareCalc'; -eval "use Math::BigFloat only => 'foobar';"; +use Math::BigInt lib => 'BareCalc'; # loads "BareCalc" +eval "use Math::BigFloat only => 'foobar';"; # ignores "foobar" -my $regex = "Couldn't load the specified math lib" - . ".*and fallback.*is disallowed"; -like($@, qr/$regex/); +is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', + "Math::BigInt->config('lib')"); diff --git a/cpan/Math-BigInt/t/use_mbfw.t b/cpan/Math-BigInt/t/use_mbfw.t index 06d9c286eb..3b19c55c97 100644 --- a/cpan/Math-BigInt/t/use_mbfw.t +++ b/cpan/Math-BigInt/t/use_mbfw.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that using Math::BigFloat with "with" and "lib" at the same time works # broken in versions up to v1.63 diff --git a/cpan/Math-BigInt/t/with_sub.t b/cpan/Math-BigInt/t/with_sub.t index 75af3a3ec0..2f007ad616 100644 --- a/cpan/Math-BigInt/t/with_sub.t +++ b/cpan/Math-BigInt/t/with_sub.t @@ -1,11 +1,11 @@ -#!perl +# -*- mode: perl; -*- # Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass'; use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 1; # tests in this file use Math::BigFloat with => 'Math::BigInt::Subclass', diff --git a/cpan/Math-BigRat/lib/Math/BigRat.pm b/cpan/Math-BigRat/lib/Math/BigRat.pm index e799abd58b..5f3af33b3e 100644 --- a/cpan/Math-BigRat/lib/Math/BigRat.pm +++ b/cpan/Math-BigRat/lib/Math/BigRat.pm @@ -16,11 +16,12 @@ use 5.006; use strict; use warnings; -use Carp qw< carp croak >; +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; -use Math::BigFloat 1.999718; +use Math::BigFloat (); -our $VERSION = '0.2617'; +our $VERSION = '0.2620'; our @ISA = qw(Math::BigFloat); @@ -793,12 +794,21 @@ sub badd { ($class, $x, $y, @r) = objectify(2, @_); } - # +inf + +inf => +inf, -inf + -inf => -inf - return $x->binf(substr($x->{sign}, 0, 1)) - if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; - - # +inf + -inf or -inf + +inf => NaN - return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + unless ($x -> is_finite() && $y -> is_finite()) { + if ($x -> is_nan() || $y -> is_nan()) { + return $x -> bnan(@r); + } elsif ($x -> is_inf("+")) { + return $x -> bnan(@r) if $y -> is_inf("-"); + return $x -> binf("+", @r); + } elsif ($x -> is_inf("-")) { + return $x -> bnan(@r) if $y -> is_inf("+"); + return $x -> binf("-", @r); + } elsif ($y -> is_inf("+")) { + return $x -> binf("+", @r); + } elsif ($y -> is_inf("-")) { + return $x -> binf("-", @r); + } + } # 1 1 gcd(3, 4) = 1 1*3 + 1*4 7 # - + - = --------- = -- @@ -1115,6 +1125,20 @@ sub binc { $x->bnorm()->round(@r); } +sub binv { + my $x = shift; + my @r = @_; + + return $x if $x->modify('binv'); + + return $x if $x -> is_nan(); + return $x -> bzero() if $x -> is_inf(); + return $x -> binf("+") if $x -> is_zero(); + + ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n}); + $x -> round(@r); +} + ############################################################################## # is_foo methods (the rest is inherited) @@ -1206,6 +1230,35 @@ sub parts { ($n, $d); } +sub dparts { + my $x = shift; + my $class = ref $x; + + croak("dparts() is an instance method") unless $class; + + if ($x -> is_nan()) { + return $class -> bnan(), $class -> bnan() if wantarray; + return $class -> bnan(); + } + + if ($x -> is_inf()) { + return $class -> binf($x -> sign()), $class -> bzero() if wantarray; + return $class -> binf($x -> sign()); + } + + # 355/113 => 3 + 16/113 + + my ($q, $r) = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d}); + + my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q)); + return $int unless wantarray; + + my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r), + $LIB -> _str($x -> {_d})); + + return $int, $frc; +} + sub length { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); @@ -1353,11 +1406,11 @@ sub blog { # $x->blog(undef) signals that the base is Euler's number. if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { - # E.g., Math::BigFloat->blog(256, 2) + # E.g., Math::BigRat->blog(256, 2) ($class, $x, $base, @r) = defined $_[2] ? objectify(2, @_) : objectify(1, @_); } else { - # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2) + # E.g., Math::BigRat::blog(256, 2) or $x->blog(2) ($class, $x, $base, @r) = defined $_[1] ? objectify(2, @_) : objectify(1, @_); } @@ -1398,6 +1451,24 @@ sub blog { return $x -> binf($sign); } + # Now take care of the cases where $x and/or $base is 1/N. + # + # log(1/N) / log(B) = -log(N)/log(B) + # log(1/N) / log(1/B) = log(N)/log(B) + # log(N) / log(1/B) = -log(N)/log(B) + + my $neg = 0; + if ($x -> numerator() -> is_one()) { + $x -> binv(); + $neg = !$neg; + } + if (defined(blessed($base)) && $base -> isa($class)) { + if ($base -> numerator() -> is_one()) { + $base = $base -> copy() -> binv(); + $neg = !$neg; + } + } + # At this point we are done handling all exception cases and trivial cases. $base = Math::BigFloat -> new($base) if defined $base; @@ -1411,7 +1482,7 @@ sub blog { $x -> {_n} = $xtmp -> {_n}; $x -> {_d} = $xtmp -> {_d}; - return $x; + return $neg ? $x -> bneg() : $x; } sub bexp { @@ -1813,9 +1884,9 @@ sub bcmp { if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { # $x is NaN and/or $y is NaN - return undef if $x->{sign} eq $nan || $y->{sign} eq $nan; + return if $x->{sign} eq $nan || $y->{sign} eq $nan; # $x and $y are both either +inf or -inf - return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; # $x = +inf and $y < +inf return +1 if $x->{sign} eq '+inf'; # $x = -inf and $y > -inf @@ -1860,9 +1931,9 @@ sub bacmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; - return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; + return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; } @@ -1953,7 +2024,17 @@ sub numify { # Non-finite number. - return $x->bstr() if $x->{sign} !~ /^[+-]$/; + if ($x -> is_nan()) { + require Math::Complex; + my $inf = $Math::Complex::Inf; + return $inf - $inf; + } + + if ($x -> is_inf()) { + require Math::Complex; + my $inf = $Math::Complex::Inf; + return $x -> is_negative() ? -$inf : $inf; + } # Finite number. @@ -2029,18 +2110,27 @@ sub as_oct { sub from_hex { my $class = shift; - $class->new(@_); + # The relationship should probably go the otherway, i.e, that new() calls + # from_hex(). Fixme! + my ($x, @r) = @_; + $x =~ s|^\s*(?:0?[Xx]_*)?|0x|; + $class->new($x, @r); } sub from_bin { my $class = shift; - $class->new(@_); + # The relationship should probably go the otherway, i.e, that new() calls + # from_bin(). Fixme! + my ($x, @r) = @_; + $x =~ s|^\s*(?:0?[Bb]_*)?|0b|; + $class->new($x, @r); } sub from_oct { my $class = shift; + # Why is this different from from_hex() and from_bin()? Fixme! my @parts; for my $c (@_) { push @parts, Math::BigInt->from_oct($c); @@ -2053,53 +2143,97 @@ sub from_oct { sub import { my $class = shift; - my @a; - my $lib = ''; - my $try = 'try'; + my @a; # unrecognized arguments + my $lib_param = ''; + my $lib_value = ''; + + while (@_) { + my $param = shift; + + # Enable overloading of constants. + + if ($param eq ':constant') { + overload::constant + + integer => sub { + $class -> new(shift); + }, - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + float => sub { + $class -> new(shift); + }, - if ($_[$i] eq ':constant') { - # this rest causes overlord er load to step in - overload::constant float => sub { $class->new(shift); }; + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; } - #elsif ($_[$i] eq 'upgrade') { - # # this causes upgrading - # $upgrade = $_[$i+1]; # or undef to disable - # $i++; - #} + # Upgrading. - elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - elsif ($_[$i] =~ /^(lib|try|only)\z/) { - $lib = $_[$i+1] || ''; - $try = $1; # "lib", "try" or "only" - $i++; + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] eq 'with') { - # this argument is no longer used - # $LIB = $_[$i+1] || 'Calc'; - # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; - $i++; + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - else { - push @a, $_[$i]; + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { + # alternative library + $lib_param = $param; # "lib", "try", or "only" + $lib_value = shift; + next; } + + if ($param eq 'with') { + # alternative class for our private parts() + # XXX: no longer supported + # $LIB = shift() || 'Calc'; + # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; + shift; + next; + } + + # Unrecognized parameter. + + push @a, $param; } require Math::BigInt; my @import = ('objectify'); - push @import, $try, $lib if $lib ne ''; + push @import, $lib_param, $lib_value if $lib_param ne ''; Math::BigInt -> import(@import); # find out which one was actually loaded @@ -2211,6 +2345,10 @@ Returns a copy of the denominator (the part under the line) as positive BigInt. Return a list consisting of (signed) numerator and (unsigned) denominator as BigInts. +=item dparts() + +Returns the integer part and the fraction part. + =item numify() my $y = $x->numify(); @@ -2525,6 +2663,12 @@ does floored division (F-division), returning an integer $q and a remainder $r so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>. +=item binv() + + $x->binv(); + +Inverse of $x. + =item bdec() $x->bdec(); @@ -2705,6 +2849,70 @@ supported. =back +=head1 NUMERIC LITERALS + +After C<use Math::BigRat ':constant'> all numeric literals in the given scope +are converted to C<Math::BigRat> objects. This conversion happens at compile +time. Every non-integer is convert to a NaN. + +For example, + + perl -MMath::BigRat=:constant -le 'print 2**150' + +prints the exact value of C<2**150>. Note that without conversion of constants +to objects the expression C<2**150> is calculated using Perl scalars, which +leads to an inaccurate result. + +Please note that strings are not affected, so that + + use Math::BigRat qw/:constant/; + + $x = "1234567890123456789012345678901234567890" + + "123456789123456789"; + +does give you what you expect. You need an explicit Math::BigRat->new() around +at least one of the operands. You should also quote large constants to prevent +loss of precision: + + use Math::BigRat; + + $x = Math::BigRat->new("1234567889123456789123456789123456789"); + +Without the quotes Perl first converts the large number to a floating point +constant at compile time, and then converts the result to a Math::BigRat object +at run time, which results in an inaccurate result. + +=head2 Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. + +Hexadecimal floating point literals: + + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 + +Octal floating point literals (with "0" prefix): + + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 + +Octal floating point literals (with "0o" prefix) (requires v5.34.0): + + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 + +Binary floating point literals: + + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 + =head1 BUGS Please report any bugs or feature requests to diff --git a/cpan/Math-BigRat/t/badd-mbr.t b/cpan/Math-BigRat/t/badd-mbr.t new file mode 100644 index 0000000000..1f96200736 --- /dev/null +++ b/cpan/Math-BigRat/t/badd-mbr.t @@ -0,0 +1,164 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 173; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($xval, $yval, $zval) = split /:/; + my ($x, $y, $got, @got); + + for my $context_is_scalar (0, 1) { + for my $y_is_scalar (0, 1) { + + my $test = qq|\$x = $class -> new("$xval");|; + + $test .= $y_is_scalar + ? qq| \$y = "$yval";| + : qq| \$y = $class -> new("$yval");|; + + $test .= $context_is_scalar + ? qq| \$got = \$x -> badd(\$y);| + : qq| \@got = \$x -> badd(\$y);|; + + my $desc = "badd() in "; + $desc .= $context_is_scalar ? "scalar context" : "list context"; + $desc .= $y_is_scalar ? " with y as scalar" : " with y as object"; + + subtest $desc, + sub { + plan tests => $context_is_scalar ? 7 : 8; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + if ($context_is_scalar) { + + # Check output. + + is(ref($got), $class, + "'$test' output arg is a $class"); + + is($got -> bstr(), $zval, + "'$test' output arg has the right value"); + + } else { + + # Check number of output arguments. + + cmp_ok(scalar @got, '==', 1, + "'$test' gives one output arg"); + + # Check output. + + is(ref($got[0]), $class, + "'$test' output arg is a $class"); + + is($got[0] -> bstr(), $zval, + "'$test' output arg has the right value"); + } + + # Check the invocand. + + is(ref($x), $class, + "'$test' invocand is still a $class"); + + is($x -> bstr(), $zval, + "'$test' invocand has the right value"); + + # Check the input argument. + + if ($y_is_scalar) { + + is(ref($y), '', + "'$test' second input arg is still a scalar"); + + is($y, $yval, + "'$test' second input arg is unmodified"); + + } else { + + is(ref($y), $class, + "'$test' second input arg is still a $class"); + + is($y -> bstr(), $yval, + "'$test' second input arg is unmodified"); + } + }; + } + } +} + +__DATA__ + +# x and/or y is NaN + +NaN:NaN:NaN + +NaN:-inf:NaN +NaN:-3:NaN +NaN:0:NaN +NaN:3:NaN +NaN:inf:NaN + +-inf:NaN:NaN +-3:NaN:NaN +0:NaN:NaN +3:NaN:NaN +inf:NaN:NaN + +# x = inf + +inf:-inf:NaN +inf:-3:inf +inf:-2:inf +inf:-1:inf +inf:0:inf +inf:1:inf +inf:2:inf +inf:3:inf +inf:inf:inf + +# x = -inf + +-inf:-inf:-inf +-inf:-3:-inf +-inf:-2:-inf +-inf:-1:-inf +-inf:0:-inf +-inf:1:-inf +-inf:2:-inf +-inf:3:-inf +-inf:inf:NaN + +# y = inf + +-3:inf:inf +-2:inf:inf +-1:inf:inf +0:inf:inf +1:inf:inf +2:inf:inf +3:inf:inf + +# y = -inf + +-3:-inf:-inf +-2:-inf:-inf +-1:-inf:-inf +0:-inf:-inf +1:-inf:-inf +2:-inf:-inf +3:-inf:-inf diff --git a/cpan/Math-BigRat/t/big_ap.t b/cpan/Math-BigRat/t/big_ap.t index 1ac46e5d9f..dd114be707 100644 --- a/cpan/Math-BigRat/t/big_ap.t +++ b/cpan/Math-BigRat/t/big_ap.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test that accuracy() and precision() in BigInt/BigFloat do not disturb # the rounding force in BigRat. diff --git a/cpan/Math-BigRat/t/bigfltrt.t b/cpan/Math-BigRat/t/bigfltrt.t index 856318614f..27a17b2d81 100644 --- a/cpan/Math-BigRat/t/bigfltrt.t +++ b/cpan/Math-BigRat/t/bigfltrt.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/bigrat.t b/cpan/Math-BigRat/t/bigrat.t index fec6afd568..8c31cfe2dc 100644 --- a/cpan/Math-BigRat/t/bigrat.t +++ b/cpan/Math-BigRat/t/bigrat.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 202; +use Test::More tests => 201; # basic testing of Math::BigRat @@ -346,7 +346,8 @@ $x = $mbr->new('-7/5')->bsstr(); is($x, '-7/5'); ############################################################################## -# numify() + +note("numify()"); my @array = qw/1 2 3 4 5 6 7 8 9/; $x = $mbr->new('8/8'); @@ -367,23 +368,60 @@ is($array[$x], 6); $x = $mbr->new('-8/1'); is($array[$x], 2); # -8 => 2 -$x = $mbr->new('33/8'); -is($x->numify() * 1000, 4125); - -$x = $mbr->new('-33/8'); -is($x->numify() * 1000, -4125); - -$x = $mbr->new('inf'); -is($x->numify(), 'inf'); +require Math::Complex; -$x = $mbr->new('-inf'); -is($x->numify(), '-inf'); +my $inf = $Math::Complex::Inf; +my $nan = $inf - $inf; -$x = $mbr->new('NaN'); -is($x->numify(), 'NaN'); +sub isnumeric { + my $value = shift; + ($value ^ $value) eq "0"; +} -$x = $mbr->new('4/3'); -is($x->numify(), 4/3); +subtest qq|$mbr -> new("33/8") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("33/8") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", 4.125, '$x has the right value'); +}; + +subtest qq|$mbr -> new("-33/8") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("-33/8") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", -4.125, '$x has the right value'); +}; + +subtest qq|$mbr -> new("inf") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("inf") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", $inf, '$x has the right value'); +}; + +subtest qq|$mbr -> new("-inf") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("-inf") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", -$inf, '$x has the right value'); +}; + +subtest qq|$mbr -> new("NaN") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("NaN") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "!=", $nan, '$x has the right value'); # Note: NaN != NaN +}; ############################################################################## # as_hex(), as_bin(), as_oct() diff --git a/cpan/Math-BigRat/t/bigratpm.inc b/cpan/Math-BigRat/t/bigratpm.inc index b3015360b8..9d5f77ed09 100644 --- a/cpan/Math-BigRat/t/bigratpm.inc +++ b/cpan/Math-BigRat/t/bigratpm.inc @@ -318,9 +318,6 @@ NaN:1:NaN 5/2:2.5 3/2:1.5 5/4:1.25 -NaN:NaN -+inf:inf --inf:-inf &fnan abc:NaN @@ -361,10 +358,6 @@ inf/-5:-inf -inf/-5:inf 123:123 -123.4567:-1234567/10000 -# invalid inputs -1__2:NaN -1E1__2:NaN -11__2E2:NaN #1.E3:NaN .2E-3.:NaN #1e3e4:NaN diff --git a/cpan/Math-BigRat/t/bigratpm.t b/cpan/Math-BigRat/t/bigratpm.t index 40f9f6eb8a..d6d9641b21 100644 --- a/cpan/Math-BigRat/t/bigratpm.t +++ b/cpan/Math-BigRat/t/bigratpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 905; +use Test::More tests => 899; use Math::BigRat lib => 'Calc'; diff --git a/cpan/Math-BigRat/t/bigratup.t b/cpan/Math-BigRat/t/bigratup.t index f424486a52..1f9bf49c29 100644 --- a/cpan/Math-BigRat/t/bigratup.t +++ b/cpan/Math-BigRat/t/bigratup.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test whether $Math::BigInt::upgrade breaks our neck diff --git a/cpan/Math-BigRat/t/binv-mbr.t b/cpan/Math-BigRat/t/binv-mbr.t new file mode 100644 index 0000000000..dfba7fd652 --- /dev/null +++ b/cpan/Math-BigRat/t/binv-mbr.t @@ -0,0 +1,89 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 21; + +use Scalar::Util qw< refaddr >; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($xval, $yval) = split /:/; + my ($x, $got, @got); + + for my $context_is_scalar (0, 1) { + + my $test = qq|\$x = $class -> new("$xval");|; + + $test .= $context_is_scalar + ? qq| \$got = \$x -> binv();| + : qq| \@got = \$x -> binv();|; + + my $desc = "binv() in "; + $desc .= $context_is_scalar ? "scalar context" : "list context"; + + subtest $desc, + sub { + plan tests => $context_is_scalar ? 4 : 5; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + if ($context_is_scalar) { + + # Check output. + + is(ref($got), $class, + "'$test' output arg is a $class"); + + is($x -> bstr(), $yval, + "'$test' output arg has the right value"); + + is(refaddr($got), refaddr($x), + "'$test' output arg is the invocand"); + + } else { + + # Check number of output arguments. + + cmp_ok(scalar(@got), '==', 1, + "'$test' gives one output arg"); + + # Check output. + + is(ref($got[0]), $class, + "'$test' output arg is a $class"); + + is($got[0] -> bstr(), $yval, + "'$test' output arg has the right value"); + + is(refaddr($got[0]), refaddr($x), + "'$test' output arg is the invocand"); + } + }; + } +} + +__DATA__ + +NaN:NaN +inf:0 +5:1/5 +2:1/2 +1:1 +0:inf +-1:-1 +-2:-1/2 +-5:-1/5 +-inf:0 diff --git a/cpan/Math-BigRat/t/bitwise.t b/cpan/Math-BigRat/t/bitwise.t index 6bd499fa51..490b0f3dcf 100644 --- a/cpan/Math-BigRat/t/bitwise.t +++ b/cpan/Math-BigRat/t/bitwise.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/bnok-mbr.t b/cpan/Math-BigRat/t/bnok-mbr.t index 2328297497..7de6365d91 100644 --- a/cpan/Math-BigRat/t/bnok-mbr.t +++ b/cpan/Math-BigRat/t/bnok-mbr.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/const-mbr.t b/cpan/Math-BigRat/t/const-mbr.t new file mode 100644 index 0000000000..672882d3be --- /dev/null +++ b/cpan/Math-BigRat/t/const-mbr.t @@ -0,0 +1,319 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "171"; + +use Math::BigRat ":constant"; + +my $class = "Math::BigRat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix requires v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999" . + "/1000000000000000000000000000000000000000000000000000000000000000000000000", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "9999999999999999999999999999999999999999999999999999999999999999999999999" + . "/10", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "201/64", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "201/64", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +is(1.0 / 3.0, "1/3", + "1.0 / 3.0 = 1/3"); diff --git a/cpan/Math-BigRat/t/dparts-mbr.t b/cpan/Math-BigRat/t/dparts-mbr.t new file mode 100644 index 0000000000..454bf59a0f --- /dev/null +++ b/cpan/Math-BigRat/t/dparts-mbr.t @@ -0,0 +1,67 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 17; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($x_str, $int_str, $frc_str) = split /:/; + my $test; + + $test = qq|\$x = $class -> new("$x_str");| + . qq| (\$i, \$f) = \$x -> dparts();|; + + subtest $test => sub { + plan tests => 5; + + my $x = $class -> new($x_str); + my ($int_got, $frc_got) = $x -> dparts(); + + is(ref($int_got), $class, "class of integer part"); + is(ref($frc_got), $class, "class of fraction part"); + + is($int_got, $int_str, "value of integer part"); + is($frc_got, $frc_str, "value of fraction part"); + is($x, $x_str, "input is unmodified"); + }; + + $test = qq|\$x = $class -> new("$x_str");| + . qq| \$i = \$x -> dparts();|; + + subtest $test => sub { + plan tests => 3, + + my $x = $class -> new($x_str); + my $int_got = $x -> dparts(); + + isa_ok($int_got, $class); + + is($int_got, $int_str, "value of integer part"); + is($x, $x_str, "input is unmodified"); + }; +} + +__DATA__ + +NaN:NaN:NaN + +inf:inf:0 +-inf:-inf:0 + +-9/4:-2:-1/4 +-1:-1:0 +0:0:0 +1:1:0 +9/4:2:1/4 diff --git a/cpan/Math-BigRat/t/hang.t b/cpan/Math-BigRat/t/hang.t index 21b9304cbd..3e8637749e 100644 --- a/cpan/Math-BigRat/t/hang.t +++ b/cpan/Math-BigRat/t/hang.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test for bug #34584: hang in exp(1/2) diff --git a/cpan/Math-BigRat/t/new-mbr.t b/cpan/Math-BigRat/t/new-mbr.t index dad99428d1..24da7a8356 100644 --- a/cpan/Math-BigRat/t/new-mbr.t +++ b/cpan/Math-BigRat/t/new-mbr.t @@ -1,21 +1,25 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; -use Math::BigRat; +use Test::More tests => 8; + +my $class; + +BEGIN { $class = 'Math::BigRat'; } +BEGIN { use_ok($class); } use Scalar::Util qw< refaddr >; # CPAN RT #132712. -my $q1 = Math::BigRat -> new("-1/2"); +my $q1 = $class -> new("-1/2"); my ($n, $d) = $q1 -> parts(); my $n_orig = $n -> copy(); my $d_orig = $d -> copy(); -my $q2 = Math::BigRat -> new($n, $d); +my $q2 = $class -> new($n, $d); cmp_ok($n, "==", $n_orig, "The value of the numerator hasn't changed"); @@ -26,3 +30,39 @@ isnt(refaddr($n), refaddr($n_orig), "The addresses of the numerators have changed"); isnt(refaddr($d), refaddr($d_orig), "The addresses of the denominators have changed"); + +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} diff --git a/cpan/Math-BigRat/t/requirer.t b/cpan/Math-BigRat/t/requirer.t index 6788783a29..4e2fadb969 100644 --- a/cpan/Math-BigRat/t/requirer.t +++ b/cpan/Math-BigRat/t/requirer.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring BigRat works diff --git a/cpan/Math-BigRat/t/rt121139.t b/cpan/Math-BigRat/t/rt121139.t index b0cd214ad3..97f28a9060 100644 --- a/cpan/Math-BigRat/t/rt121139.t +++ b/cpan/Math-BigRat/t/rt121139.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check for cpan rt #121139 diff --git a/cpan/Math-BigRat/t/trap.t b/cpan/Math-BigRat/t/trap.t index bab85d4e5d..a61abb9b45 100644 --- a/cpan/Math-BigRat/t/trap.t +++ b/cpan/Math-BigRat/t/trap.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that config( trap_nan => 1, trap_inf => 1) really works/dies diff --git a/cpan/bignum/gentest/scope-nested-const.sh b/cpan/bignum/gentest/scope-nested-const.sh new file mode 100644 index 0000000000..9dde4a52c5 --- /dev/null +++ b/cpan/bignum/gentest/scope-nested-const.sh @@ -0,0 +1,78 @@ +#!/bin/sh +# -*- mode: cperl; coding: utf-8-unix; -*- + +eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}' + if 0; + +#!perl +#line 9 + +use strict; +use warnings; + +use Algorithm::Combinatorics 'permutations'; + +my $data = [ + ['bigint', 'Math::BigInt' ], + ['bignum', 'Math::BigFloat'], + ['bigrat', 'Math::BigRat' ], + ]; + +print <<"EOF"; +#!perl + +use strict; +use warnings; + +use Test::More tests => 48; +EOF + +my $iter = permutations([0, 1, 2]); +while (my $idxs = $iter -> next()) { + + my $p0 = $data -> [ $idxs -> [0] ][0]; + my $c0 = $data -> [ $idxs -> [0] ][1]; + my $p1 = $data -> [ $idxs -> [1] ][0]; + my $c1 = $data -> [ $idxs -> [1] ][1]; + my $p2 = $data -> [ $idxs -> [2] ][0]; + my $c2 = $data -> [ $idxs -> [2] ][1]; + + print <<"EOF"; + +note "\\n$p0 -> $p1 -> $p2\\n\\n"; + +{ + note "use $p0;"; + use $p0; + is(ref(1), "$c0"); + + { + note "use $p1;"; + use $p1; + is(ref(1), "$c1"); + + { + note "use $p2;"; + use $p2; + is(ref(1), "$c2"); + + note "no $p2;"; + no $p2; + is(ref(1), ""); + } + + is(ref(1), "$c1"); + + note "no $p1;"; + no $p1; + is(ref(1), ""); + } + + is(ref(1), "$c0"); + + note "no $p0;"; + no $p0; + is(ref(1), ""); +} +EOF +} diff --git a/cpan/bignum/gentest/scope-nested-hex-oct.sh b/cpan/bignum/gentest/scope-nested-hex-oct.sh new file mode 100644 index 0000000000..c91a454906 --- /dev/null +++ b/cpan/bignum/gentest/scope-nested-hex-oct.sh @@ -0,0 +1,86 @@ +#!/bin/sh +# -*- mode: cperl; coding: utf-8-unix; -*- + +eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}' + if 0; + +#!perl +#line 9 + +use strict; +use warnings; + +use Algorithm::Combinatorics 'permutations'; + +my $data = [ + ['bigint', 'Math::BigInt' ], + ['bignum', 'Math::BigFloat'], + ['bigrat', 'Math::BigRat' ], + ]; + +print <<"EOF"; +#!perl + +use strict; +use warnings; + +use Test::More tests => 96; +EOF + +my $iter = permutations([0, 1, 2]); +while (my $idxs = $iter -> next()) { + + my $p0 = $data -> [ $idxs -> [0] ][0]; + my $c0 = $data -> [ $idxs -> [0] ][1]; + my $p1 = $data -> [ $idxs -> [1] ][0]; + my $c1 = $data -> [ $idxs -> [1] ][1]; + my $p2 = $data -> [ $idxs -> [2] ][0]; + my $c2 = $data -> [ $idxs -> [2] ][1]; + + print <<"EOF"; + +note "\\n$p0 -> $p1 -> $p2\\n\\n"; + +{ + note "use $p0;"; + use $p0; + is(ref(hex("1")), "$c0", 'ref(hex("1"))'); + is(ref(oct("1")), "$c0", 'ref(oct("1"))'); + + { + note "use $p1;"; + use $p1; + is(ref(hex("1")), "$c1", 'ref(hex("1"))'); + is(ref(oct("1")), "$c1", 'ref(oct("1"))'); + + { + note "use $p2;"; + use $p2; + is(ref(hex("1")), "$c2", 'ref(hex("1"))'); + is(ref(oct("1")), "$c2", 'ref(oct("1"))'); + + note "no $p2;"; + no $p2; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "$c1", 'ref(hex("1"))'); + is(ref(oct("1")), "$c1", 'ref(oct("1"))'); + + note "no $p1;"; + no $p1; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "$c0", 'ref(hex("1"))'); + is(ref(oct("1")), "$c0", 'ref(oct("1"))'); + + note "no $p0;"; + no $p0; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} +EOF +} diff --git a/cpan/bignum/lib/Math/BigFloat/Trace.pm b/cpan/bignum/lib/Math/BigFloat/Trace.pm index 2ff54e3015..01126a17ca 100644 --- a/cpan/bignum/lib/Math/BigFloat/Trace.pm +++ b/cpan/bignum/lib/Math/BigFloat/Trace.pm @@ -1,58 +1,76 @@ -#!perl +# -*- mode: perl; -*- package Math::BigFloat::Trace; -require 5.010; use strict; use warnings; use Exporter; use Math::BigFloat; -our ($accuracy, $precision, $round_mode, $div_scale); - our @ISA = qw(Exporter Math::BigFloat); -our $VERSION = '0.53'; +our $VERSION = '0.63'; use overload; # inherit overload from Math::BigFloat # Globals -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; - my $self = Math::BigFloat->new($value, $a, $p, $round_mode); - # remember, downgrading may return a BigInt, so don't meddle with class - # bless $self, $class; + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigFloat new '%s' => '%s' (%s)\n", + $value, $self, ref($self); - print "MBF new '$value' => '$self' (", ref($self), ")"; return $self; } sub import { - print "MBF import ", join(' ', @_); - my $self = shift; + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, - # we catch the constants, the rest goes go BigFloat - my @a = (); - foreach (@_) { - push @a, $_ if $_ ne ':constant'; + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; } - overload::constant float => sub { $self->new(shift); }; - Math::BigFloat->import(@a); # need it for subclasses -# $self->export_to_level(1,$self,@_); # need this ? + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? } 1; diff --git a/cpan/bignum/lib/Math/BigInt/Trace.pm b/cpan/bignum/lib/Math/BigInt/Trace.pm index 833927c1f4..2fbd6aae32 100644 --- a/cpan/bignum/lib/Math/BigInt/Trace.pm +++ b/cpan/bignum/lib/Math/BigInt/Trace.pm @@ -1,48 +1,76 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Trace; -require 5.010; use strict; use warnings; use Exporter; use Math::BigInt; -our ($accuracy, $precision, $round_mode, $div_scale); - our @ISA = qw(Exporter Math::BigInt); -our $VERSION = '0.53'; +our $VERSION = '0.63'; use overload; # inherit overload from Math::BigInt # Globals -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; - my $self = Math::BigInt->new($value, $a, $p, $round_mode); - bless $self, $class; - print "MBI new '$value' => '$self' (", ref($self), ")"; + + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigInt new '%s' => '%s' (%s)\n", + $value, $self, ref($self); + return $self; } sub import { - print "MBI import ", join(' ', @_); - my $self = shift; - Math::BigInt::import($self, @_); # need it for subclasses -# $self->export_to_level(1, $self, @_); # need this ? - @_ = (); + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + } + + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? } 1; diff --git a/cpan/bignum/lib/Math/BigRat/Trace.pm b/cpan/bignum/lib/Math/BigRat/Trace.pm new file mode 100644 index 0000000000..8d370c7df5 --- /dev/null +++ b/cpan/bignum/lib/Math/BigRat/Trace.pm @@ -0,0 +1,76 @@ +# -*- mode: perl; -*- + +package Math::BigRat::Trace; + +use strict; +use warnings; + +use Exporter; +use Math::BigRat; + +our @ISA = qw(Exporter Math::BigRat); + +our $VERSION = '0.63'; + +use overload; # inherit overload from Math::BigRat + +# Globals +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + + my $a = $accuracy; + $a = $_[0] if defined $_[0]; + + my $p = $precision; + $p = $_[1] if defined $_[1]; + + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigRat new '%s' => '%s' (%s)\n", + $value, $self, ref($self); + + return $self; +} + +sub import { + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + } + + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? +} + +1; diff --git a/cpan/bignum/lib/bigint.pm b/cpan/bignum/lib/bigint.pm index 060ff4dda4..d0e3799e07 100644 --- a/cpan/bignum/lib/bigint.pm +++ b/cpan/bignum/lib/bigint.pm @@ -1,10 +1,11 @@ package bigint; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; our @ISA = qw( Exporter ); @@ -12,94 +13,40 @@ our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; +use Math::BigInt; -############################################################################## +my $obj_class = "Math::BigInt"; -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bigint::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - return Math::BigInt->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +############################################################################## - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bigint\-\>$name, not a valid method"); +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -sub upgrade { - $Math::BigInt::upgrade; +sub precision { + my $self = shift; + $obj_class -> precision(@_); } -sub _binary_constant { - # this takes a binary/hexadecimal/octal constant string and returns it - # as string suitable for new. Basically it converts octal to decimal, and - # passes every thing else unmodified back. - my $string = shift; - - return Math::BigInt->new($string) if $string =~ /^0[bx]/; +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); +} - # so it must be an octal constant - Math::BigInt->from_oct($string); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); } -sub _float_constant { - # this takes a floating point constant string and returns it truncated to - # integer. For instance, '4.5' => '4', '1.234e2' => '123' etc - my $float = shift; - - # some simple cases first - return $float if ($float =~ /^[+-]?[0-9]+$/); # '+123','-1','0' etc - return $float - if ($float =~ /^[+-]?[0-9]+\.?[eE]\+?[0-9]+$/); # 123e2, 123.e+2 - return '0' if ($float =~ /^[+-]?[0]*\.[0-9]+$/); # .2, 0.2, -.1 - if ($float =~ /^[+-]?[0-9]+\.[0-9]*$/) { # 1., 1.23, -1.2 etc - $float =~ s/\..*//; - return $float; - } - my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($float); - return $float if !defined $mis; # doesn't look like a number to me - my $ec = int($$ev); - my $sign = $$mis; - $sign = '' if $sign eq '+'; - if ($$es eq '-') { - # ignore fraction part entirely - if ($ec >= length($$miv)) { # 123.23E-4 - return '0'; - } - return $sign . substr($$miv, 0, length($$miv) - $ec); # 1234.45E-2 = 12 - } - # xE+y - if ($ec >= length($$mfv)) { - $ec -= length($$mfv); - return $sign.$$miv.$$mfv if $ec == 0; # 123.45E+2 => 12345 - return $sign.$$miv.$$mfv.'E'.$ec; # 123.45e+3 => 12345e1 - } - $mfv = substr($$mfv, 0, $ec); - $sign.$$miv.$mfv; # 123.45e+1 => 1234 +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); } -sub unimport { - $^H{bigint} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -108,6 +55,81 @@ sub in_effect { $hinthash->{bigint}; } +sub _float_constant { + my $str = shift; + + # We can't pass input directly to new() because of the way it handles the + # combination of non-integers with no upgrading. Such cases are by + # Math::BigInt returned as NaN, but we truncate to an integer. + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + my $pos = index($nstr, 'e'); + my $expo_sgn = substr($nstr, $pos + 1, 1); + my $sign = substr($nstr, 0, 1); + my $mant = substr($nstr, 1, $pos - 1); + my $mant_len = CORE::length($mant); + my $expo = substr($nstr, $pos + 2); + + if ($expo_sgn eq '-') { + my $upgrade = $obj_class -> upgrade(); + return $upgrade -> new($nstr) if defined $upgrade; + + if ($mant_len <= $expo) { + return $obj_class -> bzero(); # underflow + } else { + $mant = substr $mant, 0, $mant_len - $expo; # truncate + return $obj_class -> new($sign . $mant); + } + } else { + $mant .= "0" x $expo; # pad with zeros + return $obj_class -> new($sign . $mant); + } + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# # the following two routines are for "use bigint qw/hex oct/;": @@ -126,9 +148,9 @@ sub _hex_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_hex($chrs); + $x = $obj_class -> from_hex($chrs); } else { - $x = Math::BigInt -> bzero(); + $x = $obj_class -> bzero(); } # Warn about trailing garbage. @@ -166,7 +188,7 @@ sub _oct_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_bin($chrs); + $x = $obj_class -> from_bin($chrs); } # Warn about trailing garbage. @@ -187,7 +209,7 @@ sub _oct_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_oct($chrs); + $x = $obj_class -> from_oct($chrs); } # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it @@ -227,16 +249,20 @@ my ($prev_oct, $prev_hex, $overridden); if (LEXICAL) { eval <<'.' } sub _hex(_) { my $hh = (caller 0)[10]; - return $prev_hex ? &$prev_hex($_[0]) : CORE::hex($_[0]) - unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat}; - _hex_core($_[0]); + return $$hh{bigint} ? bigint::_hex_core($_[0]) + : $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); } sub _oct(_) { my $hh = (caller 0)[10]; - return $prev_oct ? &$prev_oct($_[0]) : CORE::oct($_[0]) - unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat}; - _oct_core($_[0]); + return $$hh{bigint} ? bigint::_oct_core($_[0]) + : $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); } . @@ -247,128 +273,153 @@ sub _override { no warnings 'redefine'; *CORE::GLOBAL::oct = \&_oct; *CORE::GLOBAL::hex = \&_hex; - $overridden++; + $overridden = 1; +} + +sub unimport { + $^H{bigint} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); } sub import { - my $self = shift; + my $class = shift; $^H{bigint} = 1; # we are in effect + $^H{bignum} = undef; + $^H{bigrat} = undef; # for newer Perls always override hex() and oct() with a lexical version: if (LEXICAL) { _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($ver, $trace); # version? trace? - my ($a, $p); # accuracy, precision - for (my $i = 0; $i < $l; $i++, $j++) { - if ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(v|version)$/) { + + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? trace? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; + } + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; + } + + if ($param =~ /^(v|version)$/) { $ver = 1; - splice @a, $j, 1; - $j--; - } elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; - } elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/) { - die ("unknown option $_[$i]"); + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - } else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; + } + + croak("Unknown option '$param'"); } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import); - bigint->accuracy($a) if defined $a; - bigint->precision($p) if defined $p; + $obj_class -> import(@import); + if ($ver) { - print "bigint\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # we take care of floating point constants, since BigFloat isn't available - # and BigInt doesn't like them: - overload::constant float => - sub { - Math::BigInt->new(_float_constant(shift)); - }; - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - _binary_constant(shift); - }; - # if another big* was already loaded: - my ($package) = caller(); + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN, e and PI - } + overload::constant + + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); + }; } -sub inf () { Math::BigInt->binf(); } -sub NaN () { Math::BigInt->bnan(); } +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } + +sub PI () { $obj_class -> new(3); } +sub e () { $obj_class -> new(2); } + +sub bpi ($) { $obj_class -> new(3); } -sub PI () { Math::BigInt->new(3); } -sub e () { Math::BigInt->new(2); } -sub bpi ($) { Math::BigInt->new(3); } sub bexp ($$) { - my $x = Math::BigInt->new($_[0]); - $x->bexp($_[1]); + my $x = $obj_class -> new(shift); + $x -> bexp(@_); } 1; @@ -379,44 +430,82 @@ __END__ =head1 NAME -bigint - Transparent BigInteger support for Perl +bigint - transparent big integer support for Perl =head1 SYNOPSIS use bigint; - $x = 2 + 4.5,"\n"; # BigInt 6 - print 2 ** 512,"\n"; # really is what you think it is - print inf + 42,"\n"; # inf - print NaN * 7,"\n"; # NaN - print hex("0x1234567890123490"),"\n"; # Perl v5.10.0 or later + $x = 2 + 4.5; # Math::BigInt 6 + print 2 ** 512; # Math::BigInt 134...096 + print inf + 42; # Math::BigInt inf + print NaN * 7; # Math::BigInt NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bigint; - print 2 ** 256,"\n"; # a normal Perl scalar now + print 2 ** 256; # a normal Perl scalar now } - # Import into current package: + # for older Perls, import into current package: use bigint qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION +All numeric literal in the given scope are converted to Math::BigInt objects. +Numeric literal that represent non-integers are truncated to an integer. All +results of expressions are also truncated to integer. + All operators (including basic math operations) except the range operator C<..> -are overloaded. Integer constants are created as proper BigInts. +are overloaded. -Floating point constants are truncated to integer. All parts and results of -expressions are also truncated. +Unlike the L<integer> pragma, the C<bigint> pragma creates integers that are +only limited in their size by the available memory. -Unlike L<integer>, this pragma creates integer constants that are only -limited in their size by the available memory and CPU time. +So, the following: + + use bigint; + $x = 1234; + +creates a Math::BigInt and stores a reference to in $x. This happens +transparently and behind your back, so to speak. + +You can see this with the following: + + perl -Mbigint -le 'print ref(1234)' + +Since numbers are actually objects, you can call all the usual methods from +Math::BigFloat on them. This even works to some extent on expressions: + + perl -Mbigint -le '$x = 1234; print $x->bdec()' + perl -Mbigint -le 'print 1234->copy()->binc();' + perl -Mbigint -le 'print 1234->copy()->binc->badd(6);' + perl -Mbigint -le 'print +(1234)->copy()->binc()' + +(Note that print doesn't do what you expect if the expression starts with +'(' hence the C<+>) + +You can even chain the operations together as usual: + + perl -Mbigint -le 'print 1234->copy()->binc->badd(6);' + 1241 + +Please note the following does not work as expected (prints nothing), since +overloading of '..' is not yet possible in Perl (as of v5.8.0): + + perl -Mbigint -le 'for (1..2) { print ref($_); }' =head2 use integer vs. use bigint -There is one small difference between C<use integer> and C<use bigint>: the -former will not affect assignments to variables and the return value of -some functions. C<bigint> truncates these results to integer too: +There are some difference between C<use integer> and C<use bigint>. + +Whereas C<use integer> is limited to what can be handled as a Perl scalar, C<use +bigint> can handle arbitrarily large integers. + +Also, C<use integer> does affect assignments to variables and the return value +of some functions. C<use bigint> truncates these results to integer: # perl -Minteger -wle 'print 3.2' 3.2 @@ -436,9 +525,9 @@ some functions. C<bigint> truncates these results to integer too: # perl -Minteger -wle 'print exp(1) + 0' 2 -In practice this makes seldom a difference as B<parts and results> of -expressions will be truncated anyway, but this can, for instance, affect the -return value of subroutines: +In practice this seldom makes a difference for small integers as B<parts and +results> of expressions are truncated anyway, but this can, for instance, affect +the return value of subroutines: sub three_integer { use integer; return 3.2; } sub three_bigint { use bigint; return 3.2; } @@ -447,16 +536,15 @@ return value of subroutines: =head2 Options -bigint recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +C<bigint> recognizes some options that can be passed while loading it via +C<use>. The following options exist: -=over 2 +=over 4 =item a or accuracy This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +than or equal to zero. See Math::BigInt's bround() method for details. perl -Mbigint=a,2 -le 'print 12345+1' @@ -465,54 +553,45 @@ Note that setting precision and accuracy at the same time is not possible. =item p or precision This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, and -are <B>ignored</B> since all operations happen in integer space. -A positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer and are ignore like negative values. - -See Math::BigInt's bfround() function for details. +integer. Negative values mean a fixed number of digits after the dot, and are +ignored since all operations happen in integer space. A positive value rounds to +this digit left from the dot. 0 means round to integer. See Math::BigInt's +bfround() method for details. - perl -Mbignum=p,5 -le 'print 123456789+123' + perl -mbigint=p,5 -le 'print 123456789+123' Note that setting precision and accuracy at the same time is not possible. =item t or trace -This enables a trace mode and is primarily for debugging bigint or -Math::BigInt. - -=item hex +This enables a trace mode and is primarily for debugging. -Override the built-in hex() method with a version that can handle big -integers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bigint pragma is active. - -=item oct - -Override the built-in oct() method with a version that can handle big -integers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigint pragma is active. - -=item l, lib, try or only +=item l, lib, try, or only Load a different math lib, see L<Math Library>. + perl -Mbigint=l,GMP -e 'print 2 ** 512' perl -Mbigint=lib,GMP -e 'print 2 ** 512' perl -Mbigint=try,GMP -e 'print 2 ** 512' perl -Mbigint=only,GMP -e 'print 2 ** 512' -Currently there is no way to specify more than one library on the command -line. This means the following does not work: +=item hex - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bigint> pragma is active. -This will be hopefully fixed soon ;) +=item oct + +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bigint> pragma is active. =item v or version -This prints out the name and version of all modules used and then exits. +this prints out the name and version of the modules and then exits. perl -Mbigint=v @@ -520,59 +599,36 @@ This prints out the name and version of all modules used and then exits. =head2 Math Library -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: use bigint lib => 'Calc'; -You can change this by using: +you can change this by using: - use bignum lib => 'GMP'; + use bigint lib => 'GMP'; -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: use bigint lib => 'Foo,Math::BigInt::Bar'; -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: - use bignum try => 'GMP'; + use bigint try => 'GMP'; If you want the code to die instead of falling back, use C<only> instead: - use bignum only => 'GMP'; - -Please see respective module documentation for further details. - -=head2 Internal Format + use bigint only => 'GMP'; -The numbers are stored as objects, and their internals might change at anytime, -especially between math operations. The objects also might belong to different -classes, like Math::BigInt, or Math::BigInt::Lite. Mixing them together, even -with normal scalars is not extraordinary, but normal and expected. - -You should not depend on the internal format, all accesses must go through -accessor methods. E.g. looking at $x->{sign} is not a good idea since there -is no guaranty that the object in question has such a hash key, nor is a hash -underneath at all. - -=head2 Sign - -The sign is either '+', '-', 'NaN', '+inf' or '-inf'. -You can access it with the sign() method. - -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +Please see the respective module documentation for further details. =head2 Method calls -Since all numbers are now objects, you can use all functions that are part of -the BigInt API. You can only use the bxxx() notation, and not the fxxx() -notation, though. +Since all numbers are now objects, you can use all methods that are part of the +Math::BigInt API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -580,14 +636,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -603,12 +659,12 @@ Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigInt for further details. =head2 Methods -=over 2 +=over 4 =item inf() @@ -624,24 +680,23 @@ handle bareword C<NaN> properly. # perl -Mbigint=e -wle 'print e' -Returns Euler's number C<e>, aka exp(1). Note that under bigint, this is -truncated to an integer, and hence simple '2'. +Returns Euler's number C<e>, aka exp(1). Note that under C<bigint>, this is +truncated to an integer, i.e., 2. =item PI # perl -Mbigint=PI -wle 'print PI' -Returns PI. Note that under bigint, this is truncated to an integer, and hence -simple '3'. +Returns PI. Note that under C<bigint>, this is truncated to an integer, i.e., 3. =item bexp() - bexp($power,$accuracy); + bexp($power, $accuracy); -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. -Note that under bigint, the result is truncated to an integer. +Note that under C<bigint>, the result is truncated to an integer. Example: @@ -651,8 +706,8 @@ Example: bpi($accuracy); -Returns PI to the wanted accuracy. Note that under bigint, this is truncated -to an integer, and hence simple '3'. +Returns PI to the wanted accuracy. Note that under C<bigint>, this is truncated +to an integer, i.e., 3. Example: @@ -661,7 +716,7 @@ Example: =item upgrade() Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. +C<Math::BigInt-E<gt>upgrade()>. =item in_effect() @@ -670,7 +725,7 @@ C<$Math::BigInt::upgrade>. print "in effect\n" if bigint::in_effect; # true { no bigint; - print "in effect\n" if bigint::in_effect; # false + print "in effect\n" if bigint::in_effect; # false } Returns true or false if C<bigint> is in effect in the current scope. @@ -681,39 +736,45 @@ This method only works on Perl v5.9.4 or later. =head1 CAVEATS -=over 2 +=over 4 + +=item Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bigint> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> objects. +C<bigint> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigInt> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: - use bignum; + use bigint; my $x = "900000000000000009"; my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigint> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> objects, use a literal number in the expression: +outputs C<0> on default 32-bit builds, since C<bigint> never sees the string +literals. To ensure the expression is all treated as C<Math::BigInt> objects, +use a literal number in the expression: print +(0+$x) - $y; -=item ranges +=item Ranges -Perl does not allow overloading of ranges, so you can neither safely use -ranges with bigint endpoints, nor is the iterator variable a bigint. +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bigint> endpoints, nor is the iterator variable a C<Math::BigInt>. use 5.010; for my $i (12..13) { for my $j (20..21) { say $i ** $j; # produces a floating-point number, - # not a big integer + # not an object } } @@ -723,11 +784,11 @@ This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bigint> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bigint>: use bigint qw/hex oct/; @@ -748,17 +809,6 @@ Compare this to: =back -=head1 MODULES USED - -C<bigint> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. - -The following modules are currently used by bigint: - - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - =head1 EXAMPLES Some cool command line examples to impress the Python crowd ;) You might want @@ -767,19 +817,16 @@ to compare them to the results under -Mbignum or -Mbigrat: perl -Mbigint -le 'print sqrt(33)' perl -Mbigint -le 'print 2*255' perl -Mbigint -le 'print 4.5+2*255' - perl -Mbigint -le 'print 3/7 + 5/7 + 8/3' perl -Mbigint -le 'print 123->is_odd()' - perl -Mbigint -le 'print log(2)' - perl -Mbigint -le 'print 2 ** 0.5' - perl -Mbigint=a,65 -le 'print 2 ** 0.2' - perl -Mbignum=a,65,l,GMP -le 'print 7 ** 7777' + perl -Mbigint=l,GMP -le 'print 7 ** 7777' =head1 BUGS -For information about bugs and how to report them, see the BUGS section in the -documentation available with the perldoc command. - - perldoc bignum +Please report any bugs or feature requests to +C<bug-bignum at rt.cpan.org>, or through the web interface at +L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). +We will be notified, and then you'll automatically be notified of +progress on your bug as I make changes. =head1 SUPPORT @@ -787,10 +834,31 @@ You can find documentation for this module with the perldoc command. perldoc bigint -For more information, see the SUPPORT section in the documentation available -with the perldoc command. +You can also look for information at: + +=over 4 + +=item * GitHub + +L<https://github.com/pjacklam/p5-bignum> - perldoc bignum +=item * RT: CPAN's request tracker + +L<https://rt.cpan.org/Dist/Display.html?Name=bignum> + +=item * MetaCPAN + +L<https://metacpan.org/release/bignum> + +=item * CPAN Testers Matrix + +L<http://matrix.cpantesters.org/?dist=bignum> + +=item * CPAN Ratings + +L<https://cpanratings.perl.org/dist/bignum> + +=back =head1 LICENSE diff --git a/cpan/bignum/lib/bignum.pm b/cpan/bignum/lib/bignum.pm index fb390fc6a0..a0c07a4d42 100644 --- a/cpan/bignum/lib/bignum.pm +++ b/cpan/bignum/lib/bignum.pm @@ -1,62 +1,52 @@ package bignum; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; -our @ISA = qw( bigint ); +our @ISA = qw( Exporter ); our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; -use bigint (); +use Math::BigFloat; + +my $obj_class = "Math::BigFloat"; ############################################################################## -BEGIN { - *inf = \&bigint::inf; - *NaN = \&bigint::NaN; - *hex = \&bigint::hex; - *oct = \&bigint::oct; +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bignum::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - Math::BigInt->$name($_[0]); - return Math::BigFloat->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +sub precision { + my $self = shift; + $obj_class -> precision(@_); +} - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bignum\-\>$name, not a valid method"); +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); } -sub unimport { - $^H{bignum} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); +} + +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); +} + +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -65,157 +55,364 @@ sub in_effect { $hinthash->{bignum}; } +sub _float_constant { + my $str = shift; + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + return $obj_class -> new($nstr); + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# +# the following two routines are for "use bignum qw/hex oct/;": + +use constant LEXICAL => $] > 5.009004; + +# Internal function with the same semantics as CORE::hex(). This function is +# not used directly, but rather by other front-end functions. + +sub _hex_core { + my $str = shift; + + # Strip off, clean, and parse as much as we can from the beginning. + + my $x; + if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_hex($chrs); + } else { + $x = $obj_class -> bzero(); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +# Internal function with the same semantics as CORE::oct(). This function is +# not used directly, but rather by other front-end functions. + +sub _oct_core { + my $str = shift; + + $str =~ s/^\s*//; + + # Hexadecimal input. + + return _hex_core($str) if $str =~ /^0?[xX]/; + + my $x; + + # Binary input. + + if ($str =~ /^0?[bB]/) { + + # Strip off, clean, and parse as much as we can from the beginning. + + if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_bin($chrs); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal binary digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; + } + + # Octal input. Strip off, clean, and parse as much as we can from the + # beginning. + + if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_oct($chrs); + } + + # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it + # is more helpful to warn about all invalid digits. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal octal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +{ + my $proto = LEXICAL ? '_' : ';$'; + eval ' +sub hex(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _hex_core($str); +} +. + + eval ' +sub oct(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _oct_core($str); +} +. +} + +############################################################################# +# the following two routines are for Perl 5.9.4 or later and are lexical + +my ($prev_oct, $prev_hex, $overridden); + +if (LEXICAL) { eval <<'.' } +sub _hex(_) { + my $hh = (caller 0)[10]; + return $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $$hh{bigint} ? bigint::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); +} + +sub _oct(_) { + my $hh = (caller 0)[10]; + return $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $$hh{bigint} ? bigint::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); +} +. + +sub _override { + return if $overridden; + $prev_oct = *CORE::GLOBAL::oct{CODE}; + $prev_hex = *CORE::GLOBAL::hex{CODE}; + no warnings 'redefine'; + *CORE::GLOBAL::oct = \&_oct; + *CORE::GLOBAL::hex = \&_hex; + $overridden = 1; +} + +sub unimport { + $^H{bignum} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); +} sub import { - my $self = shift; + my $class = shift; - $^H{bignum} = 1; # we are in effect + $^H{bignum} = 1; # we are in effect + $^H{bigint} = undef; + $^H{bigrat} = undef; - # for newer Perls override hex() and oct() with a lexical version: - if ($] > 5.009004) { - bigint::_override(); + # for newer Perls always override hex() and oct() with a lexical version: + if (LEXICAL) { + _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - my $upgrade = 'Math::BigFloat'; - my $downgrade = 'Math::BigInt'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($ver, $trace); # version? trace? - my ($a, $p); # accuracy, precision - for (my $i = 0; $i < $l; $i++, $j++) { - if ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; } - elsif ($_[$i] =~ /^(v|version)$/) { - $ver = 1; - splice @a, $j, 1; - $j--; + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; } - elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] !~ /^(PI|e|bexp|bpi|hex|oct)\z/) { - die ("unknown option $_[$i]"); + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - $upgrade = 'Math::BigFloat::Trace'; - } - else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(v|version)$/) { + $ver = 1; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not - } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import, upgrade => $upgrade); - - if ($trace) { - require Math::BigFloat::Trace; - $class = 'Math::BigFloat::Trace'; - $downgrade = 'Math::BigInt::Trace'; - } - else { - require Math::BigFloat; - $class = 'Math::BigFloat'; + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; + } + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; + } + + croak("Unknown option '$param'"); } - $class->import(':constant', 'downgrade', $downgrade); - bignum->accuracy($a) if defined $a; - bignum->precision($p) if defined $p; + $obj_class -> import(@import); + if ($ver) { - print "bignum\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; - print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - bigint::_binary_constant(shift); + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. + + overload::constant + + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); }; +} - # if another big* was already loaded: - my ($package) = caller(); +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN - } +# This should depend on the current accuracy/precision. Fixme! +sub PI () { $obj_class -> new('3.141592653589793238462643383279502884197'); } +sub e () { $obj_class -> new('2.718281828459045235360287471352662497757'); } + +sub bpi ($) { + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> bpi(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $x; } -sub PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); } -sub e () { Math::BigFloat->new('2.718281828459045235360287471352662497757'); } -sub bpi ($) { Math::BigFloat->bpi(@_); } sub bexp ($$) { - my $x = Math::BigFloat->new($_[0]); - $x->bexp($_[1]); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> new(shift); + $x -> bexp(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $x; } 1; @@ -226,69 +423,49 @@ __END__ =head1 NAME -bignum - Transparent BigNumber support for Perl +bignum - transparent big number support for Perl =head1 SYNOPSIS use bignum; - $x = 2 + 4.5,"\n"; # BigFloat 6.5 - print 2 ** 512 * 0.1,"\n"; # really is what you think it is - print inf * inf,"\n"; # prints inf - print NaN * 3,"\n"; # prints NaN + $x = 2 + 4.5; # Math::BigFloat 6.5 + print 2 ** 512 * 0.1; # Math::BigFloat 134...09.6 + print inf + 42; # Math::BigFloat inf + print NaN * 7; # Math::BigFloat NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bignum; - print 2 ** 256,"\n"; # a normal Perl scalar now + print 2 ** 256; # a normal Perl scalar now } # for older Perls, import into current package: use bignum qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION -All operators (including basic math operations) are overloaded. Integer and -floating-point constants are created as proper BigInts or BigFloats, -respectively. +All numeric literals in the given scope are converted to Math::BigFloat objects. -If you do +All operators (including basic math operations) except the range operator C<..> +are overloaded. - use bignum; - -at the top of your script, Math::BigFloat and Math::BigInt will be loaded -and any constant number will be converted to an object (Math::BigFloat for -floats like 3.1415 and Math::BigInt for integers like 1234). - -So, the following line: +So, the following: + use bignum; $x = 1234; -creates actually a Math::BigInt and stores a reference to in $x. -This happens transparently and behind your back, so to speak. +creates a Math::BigFloat and stores a reference to in $x. This happens +transparently and behind your back, so to speak. You can see this with the following: perl -Mbignum -le 'print ref(1234)' -Don't worry if it says Math::BigInt::Lite, bignum and friends will use Lite -if it is installed since it is faster for some operations. It will be -automatically upgraded to BigInt whenever necessary: - - perl -Mbignum -le 'print ref(2**255)' - -This also means it is a bad idea to check for some specific package, since -the actual contents of $x might be something unexpected. Due to the -transparent way of bignum C<ref()> should not be necessary, anyway. - -Since Math::BigInt and BigFloat also overload the normal math operations, -the following line will still work: - - perl -Mbignum -le 'print ref(1234+1234)' - Since numbers are actually objects, you can call all the usual methods from -BigInt/BigFloat on them. This even works to some extent on expressions: +Math::BigFloat on them. This even works to some extent on expressions: perl -Mbignum -le '$x = 1234; print $x->bdec()' perl -Mbignum -le 'print 1234->copy()->binc();' @@ -303,44 +480,6 @@ You can even chain the operations together as usual: perl -Mbignum -le 'print 1234->copy()->binc->badd(6);' 1241 -Under bignum (or bigint or bigrat), Perl will "upgrade" the numbers -appropriately. This means that: - - perl -Mbignum -le 'print 1234+4.5' - 1238.5 - -will work correctly. These mixed cases don't do always work when using -Math::BigInt or Math::BigFloat alone, or at least not in the way normal Perl -scalars work. - -If you do want to work with large integers like under C<use integer;>, try -C<use bigint;>: - - perl -Mbigint -le 'print 1234.5+4.5' - 1238 - -There is also C<use bigrat;> which gives you big rationals: - - perl -Mbigrat -le 'print 1234+4.1' - 12381/10 - -The entire upgrading/downgrading is still experimental and might not work -as you expect or may even have bugs. You might get errors like this: - - Can't use an undefined value as an ARRAY reference at - /usr/local/lib/perl5/5.8.0/Math/BigInt/Calc.pm line 864 - -This means somewhere a routine got a BigFloat/Lite but expected a BigInt (or -vice versa) and the upgrade/downgrad path was missing. This is a bug, please -report it so that we can fix it. - -You might consider using just Math::BigInt or Math::BigFloat, since they -allow you finer control over what get's done in which module/space. For -instance, simple loop counters will be Math::BigInts under C<use bignum;> and -this is slower than keeping them as Perl scalars: - - perl -Mbignum -le 'for ($i = 0; $i < 10; $i++) { print ref($i); }' - Please note the following does not work as expected (prints nothing), since overloading of '..' is not yet possible in Perl (as of v5.8.0): @@ -348,16 +487,15 @@ overloading of '..' is not yet possible in Perl (as of v5.8.0): =head2 Options -bignum recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +C<bignum> recognizes some options that can be passed while loading it via via +C<use>. The following options exist: -=over 2 +=over 4 =item a or accuracy This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +than or equal to zero. See Math::BigInt's bround() method for details. perl -Mbignum=a,50 -le 'print sqrt(20)' @@ -366,9 +504,9 @@ Note that setting precision and accuracy at the same time is not possible. =item p or precision This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, while -a positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer. See Math::BigInt's bfround() function for details. +integer. Negative values mean a fixed number of digits after the dot, while a +positive value rounds to this digit left from the dot. 0 means round to integer. +See Math::BigInt's bfround() method for details. perl -Mbignum=p,-50 -le 'print sqrt(20)' @@ -376,54 +514,71 @@ Note that setting precision and accuracy at the same time is not possible. =item t or trace -This enables a trace mode and is primarily for debugging bignum or -Math::BigInt/Math::BigFloat. +This enables a trace mode and is primarily for debugging. -=item l or lib +=item l, lib, try, or only Load a different math lib, see L<Math Library>. perl -Mbignum=l,GMP -e 'print 2 ** 512' - -Currently there is no way to specify more than one library on the command -line. This means the following does not work: - - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' - -This will be hopefully fixed soon ;) + perl -Mbignum=lib,GMP -e 'print 2 ** 512' + perl -Mbignum=try,GMP -e 'print 2 ** 512' + perl -Mbignum=only,GMP -e 'print 2 ** 512' =item hex -Override the built-in hex() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bignum pragma is active. +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bignum> pragma is active. =item oct -Override the built-in oct() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigint pragma is active. +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bignum> pragma is active. =item v or version -This prints out the name and version of all modules used and then exits. +this prints out the name and version of the modules and then exits. perl -Mbignum=v =back -=head2 Methods +=head2 Math Library + +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: + + use bignum lib => 'Calc'; + +you can change this by using: + + use bignum lib => 'GMP'; + +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: -Beside import() and AUTOLOAD() there are only a few other methods. + use bignum lib => 'Foo,Math::BigInt::Bar'; + +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: + + use bignum try => 'GMP'; + +If you want the code to die instead of falling back, use C<only> instead: + + use bignum only => 'GMP'; + +Please see respective module documentation for further details. -Since all numbers are now objects, you can use all functions that are part of -the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not -the fxxx() notation, though. This makes it possible that the underlying object -might morph into a different class than BigFloat. +=head2 Method calls -=head2 Caveats +Since all numbers are now objects, you can use all methods that are part of the +Math::BigFloat API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -431,18 +586,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -If you want to make a real copy, use the following: - - $y = $x->copy(); - -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -453,33 +604,35 @@ B<both> the original and the copy being destroyed: $x = 9; $y = $x; print $x->bmul(2), " ", $y,"\n"; # prints 18 18 -Using methods that do not modify, but test the contents works: +Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigFloat for further details. -=over 2 +=head2 Methods + +=over 4 =item inf() -A shortcut to return Math::BigInt->binf(). Useful because Perl does not always +A shortcut to return Math::BigFloat->binf(). Useful because Perl does not always handle bareword C<inf> properly. =item NaN() -A shortcut to return Math::BigInt->bnan(). Useful because Perl does not always +A shortcut to return Math::BigFloat->bnan(). Useful because Perl does not always handle bareword C<NaN> properly. =item e # perl -Mbignum=e -wle 'print e' -Returns Euler's number C<e>, aka exp(1). +Returns Euler's number C<e>, aka exp(1) -=item PI() +=item PI # perl -Mbignum=PI -wle 'print PI' @@ -487,10 +640,10 @@ Returns PI. =item bexp() - bexp($power,$accuracy); + bexp($power, $accuracy); -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. Example: @@ -509,7 +662,7 @@ Example: =item upgrade() Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. +C<Math::BigFloat-E<gt>upgrade()>. =item in_effect() @@ -527,100 +680,67 @@ This method only works on Perl v5.9.4 or later. =back -=head2 Math Library - -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: - - use bignum lib => 'Calc'; - -You can change this by using: - - use bignum lib => 'GMP'; - -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: - - use bignum lib => 'Foo,Math::BigInt::Bar'; - -Please see respective module documentation for further details. - -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: - - use bignum try => 'GMP'; - -If you want the code to die instead of falling back, use C<only> instead: - - use bignum only => 'GMP'; - -=head2 INTERNAL FORMAT - -The numbers are stored as objects, and their internals might change at anytime, -especially between math operations. The objects also might belong to different -classes, like Math::BigInt, or Math::BigFloat. Mixing them together, even -with normal scalars is not extraordinary, but normal and expected. - -You should not depend on the internal format, all accesses must go through -accessor methods. E.g. looking at $x->{sign} is not a bright idea since there -is no guaranty that the object in question has such a hashkey, nor is a hash -underneath at all. - -=head2 SIGN +=head1 CAVEATS -The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored separately. -You can access it with the sign() method. +=over 4 -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +=item Hexadecimal, octal, and binary floating point literals -=head1 CAVEATS - -=over 2 +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bignum> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> or L<Math::BigFloat> -objects. +C<bigrat> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigRat> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: - use bignum; + use bigrat; my $x = "900000000000000009"; my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigrat> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> or C<BigFloat> objects, use a literal number in the -expression: +outputs C<0> on default 32-bit builds, since C<bignum> never sees the string +literals. To ensure the expression is all treated as C<Math::BigFloat> objects, +use a literal number in the expression: print +(0+$x) - $y; +=item Ranges + +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bignum> endpoints, nor is the iterator variable a C<Math::BigFloat>. + + use 5.010; + for my $i (12..13) { + for my $j (20..21) { + say $i ** $j; # produces a floating-point number, + # not an object + } + } + =item in_effect() This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bignum> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bignum>: - use bigint qw/hex oct/; + use bignum qw/hex oct/; print hex("0x1234567890123456"); { - no bigint; + no bignum; print hex("0x1234567890123456"); } @@ -628,44 +748,32 @@ The second call to hex() will warn about a non-portable constant. Compare this to: - use bigint; + use bignum; - # will warn only under older than v5.9.4 + # will warn only under Perl older than v5.9.4 print hex("0x1234567890123456"); =back -=head1 MODULES USED - -C<bignum> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. - -The following modules are currently used by bignum: - - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - Math::BigFloat - =head1 EXAMPLES Some cool command line examples to impress the Python crowd ;) perl -Mbignum -le 'print sqrt(33)' - perl -Mbignum -le 'print 2*255' - perl -Mbignum -le 'print 4.5+2*255' + perl -Mbignum -le 'print 2**255' + perl -Mbignum -le 'print 4.5+2**255' perl -Mbignum -le 'print 3/7 + 5/7 + 8/3' perl -Mbignum -le 'print 123->is_odd()' perl -Mbignum -le 'print log(2)' perl -Mbignum -le 'print exp(1)' perl -Mbignum -le 'print 2 ** 0.5' perl -Mbignum=a,65 -le 'print 2 ** 0.2' - perl -Mbignum=a,65,l,GMP -le 'print 7 ** 7777' + perl -Mbignum=l,GMP -le 'print 7 ** 7777' =head1 BUGS Please report any bugs or feature requests to -C<bug-math-bigint at rt.cpan.org>, or through the web interface at +C<bug-bignum at rt.cpan.org>, or through the web interface at L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. diff --git a/cpan/bignum/lib/bigrat.pm b/cpan/bignum/lib/bigrat.pm index 28a341c489..18f4ff0e2d 100644 --- a/cpan/bignum/lib/bigrat.pm +++ b/cpan/bignum/lib/bigrat.pm @@ -1,63 +1,52 @@ package bigrat; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; -our @ISA = qw( bigint ); +our @ISA = qw( Exporter ); our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; -use bigint (); +use Math::BigRat; + +my $obj_class = "Math::BigRat"; ############################################################################## -BEGIN { - *inf = \&bigint::inf; - *NaN = \&bigint::NaN; - *hex = \&bigint::hex; - *oct = \&bigint::oct; +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bigrat::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - Math::BigInt->$name($_[0]); - Math::BigFloat->$name($_[0]); - return Math::BigRat->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +sub precision { + my $self = shift; + $obj_class -> precision(@_); +} - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bigrat\-\>$name, not a valid method"); +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); } -sub unimport { - $^H{bigrat} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); +} + +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); +} + +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -66,150 +55,364 @@ sub in_effect { $hinthash->{bigrat}; } +sub _float_constant { + my $str = shift; + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + return $obj_class -> new($nstr); + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# +# the following two routines are for "use bigrat qw/hex oct/;": -sub import { - my $self = shift; +use constant LEXICAL => $] > 5.009004; + +# Internal function with the same semantics as CORE::hex(). This function is +# not used directly, but rather by other front-end functions. + +sub _hex_core { + my $str = shift; + + # Strip off, clean, and parse as much as we can from the beginning. + + my $x; + if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_hex($chrs); + } else { + $x = $obj_class -> bzero(); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +# Internal function with the same semantics as CORE::oct(). This function is +# not used directly, but rather by other front-end functions. + +sub _oct_core { + my $str = shift; + + $str =~ s/^\s*//; + + # Hexadecimal input. + + return _hex_core($str) if $str =~ /^0?[xX]/; + + my $x; + + # Binary input. + + if ($str =~ /^0?[bB]/) { + + # Strip off, clean, and parse as much as we can from the beginning. + + if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_bin($chrs); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal binary digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; + } - # see also bignum->import() for additional comments + # Octal input. Strip off, clean, and parse as much as we can from the + # beginning. + + if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_oct($chrs); + } + + # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it + # is more helpful to warn about all invalid digits. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal octal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +{ + my $proto = LEXICAL ? '_' : ';$'; + eval ' +sub hex(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _hex_core($str); +} +. + + eval ' +sub oct(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _oct_core($str); +} +. +} + +############################################################################# +# the following two routines are for Perl 5.9.4 or later and are lexical + +my ($prev_oct, $prev_hex, $overridden); + +if (LEXICAL) { eval <<'.' } +sub _hex(_) { + my $hh = (caller 0)[10]; + return $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigint} ? bigint::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); +} + +sub _oct(_) { + my $hh = (caller 0)[10]; + return $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigint} ? bigint::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); +} +. + +sub _override { + return if $overridden; + $prev_oct = *CORE::GLOBAL::oct{CODE}; + $prev_hex = *CORE::GLOBAL::hex{CODE}; + no warnings 'redefine'; + *CORE::GLOBAL::oct = \&_oct; + *CORE::GLOBAL::hex = \&_hex; + $overridden = 1; +} + +sub unimport { + $^H{bigrat} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); +} + +sub import { + my $class = shift; $^H{bigrat} = 1; # we are in effect + $^H{bigint} = undef; + $^H{bignum} = undef; # for newer Perls always override hex() and oct() with a lexical version: - if ($] > 5.009004) { - bigint::_override(); + if (LEXICAL) { + _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - my $upgrade = 'Math::BigFloat'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($a, $p); - my ($ver, $trace); # version? trace? - for (my $i = 0; $i < $l ; $i++, $j++) { - if ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; + + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; } - elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; } - elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] =~ /^(v|version)$/) { - $ver = 1; - splice @a, $j, 1; - $j--; + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; } - elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; + + if ($param =~ /^(v|version)$/) { + $ver = 1; + next; } - elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/) { - die ("unknown option $_[$i]"); + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - $upgrade = 'Math::BigFloat::Trace'; - } - else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not + + croak("Unknown option '$param'"); } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import, upgrade => $upgrade); - require Math::BigFloat; - Math::BigFloat->import(upgrade => 'Math::BigRat', ':constant'); - require Math::BigRat; - Math::BigRat->import(@import); + $obj_class -> import(@import); - bigrat->accuracy($a) if defined $a; - bigrat->precision($p) if defined $p; if ($ver) { - print "bigrat\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; - print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; - print "Math::BigRat\t\t v$Math::BigRat::VERSION\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - bigint::_binary_constant(shift); - }; + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. - # if another big* was already loaded: - my ($package) = caller(); + overload::constant - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN - } + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); + }; } -sub PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); } -sub e () { Math::BigFloat->new('2.718281828459045235360287471352662497757'); } +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } + +# This should depend on the current accuracy/precision. Fixme! +sub PI () { $obj_class -> new('3.141592653589793238462643383279502884197'); } +sub e () { $obj_class -> new('2.718281828459045235360287471352662497757'); } sub bpi ($) { - local $Math::BigFloat::upgrade; - Math::BigFloat->bpi(@_); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> bpi(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $obj_class -> new($x); } sub bexp ($$) { - local $Math::BigFloat::upgrade; - my $x = Math::BigFloat->new($_[0]); - $x->bexp($_[1]); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> new(shift); + $x -> bexp(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $obj_class -> new($x); } 1; @@ -220,162 +423,162 @@ __END__ =head1 NAME -bigrat - Transparent BigNumber/BigRational support for Perl +bigrat - transparent big rational number support for Perl =head1 SYNOPSIS use bigrat; - print 2 + 4.5,"\n"; # BigFloat 6.5 - print 1/3 + 1/4,"\n"; # produces 7/12 + print 2 + 4.5; # Math::BigRat 13/2 + print 1/3 + 1/4; # Math::BigRat 7/12 + print inf + 42; # Math::BigRat inf + print NaN * 7; # Math::BigRat NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bigrat; - print 1/3,"\n"; # 0.33333... + print 1/3; # 0.33333... } - # Import into current package: + # for older Perls, import into current package: use bigrat qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION -All operators (including basic math operations) are overloaded. Integer and -floating-point constants are created as proper BigInts or BigFloats, -respectively. - -Other than L<bignum>, this module upgrades to Math::BigRat, meaning that -instead of 2.5 you will get 2+1/2 as output. - -=head2 Modules Used - -C<bigrat> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. +All numeric literal in the given scope are converted to Math::BigRat objects. -The following modules are currently used by bignum: +All operators (including basic math operations) except the range operator C<..> +are overloaded. - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - Math::BigFloat - Math::BigRat +So, the following: -=head2 Math Library + use bigrat; + $x = 1234; -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +creates a Math::BigRat and stores a reference to in $x. This happens +transparently and behind your back, so to speak. - use bigrat lib => 'Calc'; +You can see this with the following: -You can change this by using: + perl -Mbigrat -le 'print ref(1234)' - use bignum lib => 'GMP'; +Since numbers are actually objects, you can call all the usual methods from +Math::BigRat on them. This even works to some extent on expressions: -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + perl -Mbigrat -le '$x = 1234; print $x->bdec()' + perl -Mbigrat -le 'print 1234->copy()->binc();' + perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);' + perl -Mbigrat -le 'print +(1234)->copy()->binc()' - use bigrat lib => 'Foo,Math::BigInt::Bar'; +(Note that print doesn't do what you expect if the expression starts with +'(' hence the C<+>) -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: +You can even chain the operations together as usual: - use bignum try => 'GMP'; + perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);' + 1241 -If you want the code to die instead of falling back, use C<only> instead: +Please note the following does not work as expected (prints nothing), since +overloading of '..' is not yet possible in Perl (as of v5.8.0): - use bignum only => 'GMP'; + perl -Mbigrat -le 'for (1..2) { print ref($_); }' -Please see respective module documentation for further details. +=head2 Options -=head2 Sign +C<bigrat> recognizes some options that can be passed while loading it via +C<use>. The following options exist: -The sign is either '+', '-', 'NaN', '+inf' or '-inf'. +=over 4 -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +=item a or accuracy -=head2 Methods +This sets the accuracy for all math operations. The argument must be greater +than or equal to zero. See Math::BigInt's bround() method for details. -Since all numbers are not objects, you can use all functions that are part of -the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not -the fxxx() notation, though. This makes you independent on the fact that the -underlying object might morph into a different class than BigFloat. + perl -Mbigrat=a,50 -le 'print sqrt(20)' -=over 2 +Note that setting precision and accuracy at the same time is not possible. -=item inf() +=item p or precision -A shortcut to return Math::BigInt->binf(). Useful because Perl does not always -handle bareword C<inf> properly. +This sets the precision for all math operations. The argument can be any +integer. Negative values mean a fixed number of digits after the dot, while a +positive value rounds to this digit left from the dot. 0 means round to integer. +See Math::BigInt's bfround() method for details. -=item NaN() + perl -Mbigrat=p,-50 -le 'print sqrt(20)' -A shortcut to return Math::BigInt->bnan(). Useful because Perl does not always -handle bareword C<NaN> properly. +Note that setting precision and accuracy at the same time is not possible. -=item e +=item t or trace - # perl -Mbigrat=e -wle 'print e' +This enables a trace mode and is primarily for debugging. -Returns Euler's number C<e>, aka exp(1). +=item l, lib, try, or only -=item PI +Load a different math lib, see L<Math Library>. - # perl -Mbigrat=PI -wle 'print PI' + perl -Mbigrat=l,GMP -e 'print 2 ** 512' + perl -Mbigrat=lib,GMP -e 'print 2 ** 512' + perl -Mbigrat=try,GMP -e 'print 2 ** 512' + perl -Mbigrat=only,GMP -e 'print 2 ** 512' -Returns PI. +=item hex -=item bexp() +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bigrat> pragma is active. - bexp($power,$accuracy); +=item oct -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bigrat> pragma is active. -Example: +=item v or version - # perl -Mbigrat=bexp -wle 'print bexp(1,80)' +this prints out the name and version of the modules and then exits. -=item bpi() + perl -Mbigrat=v - bpi($accuracy); +=back -Returns PI to the wanted accuracy. +=head2 Math Library -Example: +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: - # perl -Mbigrat=bpi -wle 'print bpi(80)' + use bigrat lib => 'Calc'; -=item upgrade() +you can change this by using: -Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. + use bigrat lib => 'GMP'; -=item in_effect() +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: - use bigrat; + use bigrat lib => 'Foo,Math::BigInt::Bar'; - print "in effect\n" if bigrat::in_effect; # true - { - no bigrat; - print "in effect\n" if bigrat::in_effect; # false - } +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: -Returns true or false if C<bigrat> is in effect in the current scope. + use bigrat try => 'GMP'; -This method only works on Perl v5.9.4 or later. +If you want the code to die instead of falling back, use C<only> instead: -=back + use bigrat only => 'GMP'; -=head2 MATH LIBRARY +Please see the respective module documentation for further details. -Math with the numbers is done (by default) by a module called +=head2 Method calls -=head2 Caveat +Since all numbers are now objects, you can use all methods that are part of the +Math::BigRat API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -383,18 +586,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -If you want to make a real copy, use the following: - - $y = $x->copy(); - -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -405,94 +604,99 @@ B<both> the original and the copy being destroyed: $x = 9; $y = $x; print $x->bmul(2), " ", $y,"\n"; # prints 18 18 -Using methods that do not modify, but testthe contents works: +Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigFloat for further details. -=head2 Options +=head2 Methods -bignum recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +=over 4 -=over 2 +=item inf() -=item a or accuracy +A shortcut to return Math::BigRat->binf(). Useful because Perl does not always +handle bareword C<inf> properly. -This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +=item NaN() - perl -Mbigrat=a,50 -le 'print sqrt(20)' +A shortcut to return Math::BigRat->bnan(). Useful because Perl does not always +handle bareword C<NaN> properly. -Note that setting precision and accuracy at the same time is not possible. +=item e -=item p or precision + # perl -Mbigrat=e -wle 'print e' -This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, while -a positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer. See Math::BigInt's bfround() function for details. +Returns Euler's number C<e>, aka exp(1). - perl -Mbigrat=p,-50 -le 'print sqrt(20)' +=item PI -Note that setting precision and accuracy at the same time is not possible. + # perl -Mbigrat=PI -wle 'print PI' -=item t or trace +Returns PI. -This enables a trace mode and is primarily for debugging bignum or -Math::BigInt/Math::BigFloat. +=item bexp() -=item l or lib + bexp($power, $accuracy); -Load a different math lib, see L<MATH LIBRARY>. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. - perl -Mbigrat=l,GMP -e 'print 2 ** 512' +Example: -Currently there is no way to specify more than one library on the command -line. This means the following does not work: + # perl -Mbigrat=bexp -wle 'print bexp(1,80)' - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' +=item bpi() -This will be hopefully fixed soon ;) + bpi($accuracy); -=item hex +Returns PI to the wanted accuracy. -Override the built-in hex() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bigrat pragma is active. +Example: -=item oct + # perl -Mbigrat=bpi -wle 'print bpi(80)' -Override the built-in oct() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigrat pragma is active. +=item upgrade() -=item v or version +Return the class that numbers are upgraded to, is in fact returning +C<Math::BigRat-E<gt>upgrade()>. -This prints out the name and version of all modules used and then exits. +=item in_effect() - perl -Mbigrat=v + use bigrat; + + print "in effect\n" if bigrat::in_effect; # true + { + no bigrat; + print "in effect\n" if bigrat::in_effect; # false + } + +Returns true or false if C<bigrat> is in effect in the current scope. + +This method only works on Perl v5.9.4 or later. =back =head1 CAVEATS -=over 2 +=over 4 + +=item Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bigrat> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> or L<Math::BigRat> -objects. +C<bigrat> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigRat> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: @@ -501,30 +705,42 @@ For example: my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigrat> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> or C<Math::BigRat> objects, use a literal number in -the expression: +outputs C<0> on default 32-bit builds, since C<bigrat> never sees the string +literals. To ensure the expression is all treated as C<Math::BigRat> objects, +use a literal number in the expression: print +(0+$x) - $y; +=item Ranges + +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bigrat> endpoints, nor is the iterator variable a C<Math::BigRat>. + + use 5.010; + for my $i (12..13) { + for my $j (20..21) { + say $i ** $j; # produces a floating-point number, + # not an object + } + } + =item in_effect() This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bigrat> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bigrat>: - use bigint qw/hex oct/; + use bigrat qw/hex oct/; print hex("0x1234567890123456"); { - no bigint; + no bigrat; print hex("0x1234567890123456"); } @@ -532,7 +748,7 @@ The second call to hex() will warn about a non-portable constant. Compare this to: - use bigint; + use bigrat; # will warn only under Perl older than v5.9.4 print hex("0x1234567890123456"); @@ -542,18 +758,19 @@ Compare this to: =head1 EXAMPLES perl -Mbigrat -le 'print sqrt(33)' - perl -Mbigrat -le 'print 2*255' - perl -Mbigrat -le 'print 4.5+2*255' + perl -Mbigrat -le 'print 2**255' + perl -Mbigrat -le 'print 4.5+2**255' perl -Mbigrat -le 'print 3/7 + 5/7 + 8/3' perl -Mbigrat -le 'print 12->is_odd()'; - perl -Mbignum=l,GMP -le 'print 7 ** 7777' + perl -Mbigrat=l,GMP -le 'print 7 ** 7777' =head1 BUGS -For information about bugs and how to report them, see the BUGS section in the -documentation available with the perldoc command. - - perldoc bignum +Please report any bugs or feature requests to +C<bug-bignum at rt.cpan.org>, or through the web interface at +L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). +We will be notified, and then you'll automatically be notified of +progress on your bug as I make changes. =head1 SUPPORT @@ -561,10 +778,31 @@ You can find documentation for this module with the perldoc command. perldoc bigrat -For more information, see the SUPPORT section in the documentation available -with the perldoc command. +You can also look for information at: + +=over 4 + +=item * GitHub + +L<https://github.com/pjacklam/p5-bignum> + +=item * RT: CPAN's request tracker - perldoc bignum +L<https://rt.cpan.org/Dist/Display.html?Name=bignum> + +=item * MetaCPAN + +L<https://metacpan.org/release/bignum> + +=item * CPAN Testers Matrix + +L<http://matrix.cpantesters.org/?dist=bignum> + +=item * CPAN Ratings + +L<https://cpanratings.perl.org/dist/bignum> + +=back =head1 LICENSE @@ -588,7 +826,7 @@ L<Math::BigInt::FastCalc>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. =item * -Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2014-. +Maintained by Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2014-. =back diff --git a/cpan/bignum/t/bigexp.t b/cpan/bignum/t/bigexp.t index 61d39b2b82..61c98465ea 100644 --- a/cpan/bignum/t/bigexp.t +++ b/cpan/bignum/t/bigexp.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for bug #18025: bignum/bigrat can lead to a number that is both 1 and 0 diff --git a/cpan/bignum/t/bigint.t b/cpan/bignum/t/bigint.t index 5a5c00b72c..de9526e07b 100644 --- a/cpan/bignum/t/bigint.t +++ b/cpan/bignum/t/bigint.t @@ -1,139 +1,49 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 66; +use Test::More tests => 15; -use bigint qw/hex oct/; - -############################################################################### -# _constant tests - -foreach (qw/ - 123:123 - 123.4:123 - 1.4:1 - 0.1:0 - -0.1:0 - -1.1:-1 - -123.4:-123 - -123:-123 - 123e2:123e2 - 123e-1:12 - 123e-4:0 - 123e-3:0 - 123.345e-1:12 - 123.456e+2:12345 - 1234.567e+3:1234567 - 1234.567e+4:1234567E1 - 1234.567e+6:1234567E3 - /) -{ - my ($x, $y) = split /:/; - is(bigint::_float_constant("$x"), "$y", - qq|bigint::_float_constant("$x") = $y|); -} - -foreach (qw/ - 0100:64 - 0200:128 - 0x100:256 - 0b1001:9 - /) -{ - my ($x, $y) = split /:/; - is(bigint::_binary_constant("$x"), "$y", - qq|bigint::_binary_constant("$x") = "$y")|); -} +use bigint; ############################################################################### # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigInt', '$x = 5 makes $x a Math::BigInt'); # todo: is(2 + 2.5, 4.5); # should still work # todo: $x = 2 + 3.5; is(ref($x), 'Math::BigFloat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigInt', '$x = 2 ** 255 makes $x a Math::BigInt'); is(12->bfac(), 479001600, '12->bfac() = 479001600'); is(9/4, 2, '9/4 = 2'); -is(4.5 + 4.5, 8, '4.5 + 4.5 = 2'); # truncate -like(ref(4.5 + 4.5), qr/^Math::BigInt/, '4.5 + 4.5 makes a Math::BigInt'); +is(4.5 + 4.5, 8, '4.5 + 4.5 = 8'); # truncate +is(ref(4.5 + 4.5), 'Math::BigInt', '4.5 + 4.5 makes a Math::BigInt'); ############################################################################### # accuracy and precision -is(bigint->accuracy(), undef, 'get accuracy'); -is(bigint->accuracy(12), 12, 'set accuracy to 12'); -is(bigint->accuracy(), 12, 'get accuracy again'); - -is(bigint->precision(), undef, 'get precision'); -is(bigint->precision(12), 12, 'set precision to 12'); -is(bigint->precision(), 12, 'get precision again'); - -is(bigint->round_mode(), 'even', 'get round mode'); -is(bigint->round_mode('odd'), 'odd', 'set round mode'); -is(bigint->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bigint->accuracy(), undef, 'get accuracy'); +bigint->accuracy(12); +is(bigint->accuracy(), 12, 'get accuracy again'); +bigint->accuracy(undef); +is(bigint->accuracy(), undef, 'get accuracy again'); + +is(bigint->precision(), undef, 'get precision'); +bigint->precision(12); +is(bigint->precision(), 12, 'get precision again'); +bigint->precision(undef); +is(bigint->precision(), undef, 'get precision again'); + +is(bigint->round_mode(), 'even', 'get round mode'); +bigint->round_mode('odd'); +is(bigint->round_mode(), 'odd', 'get round mode again'); +bigint->round_mode('even'); +is(bigint->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/bignum.t b/cpan/bignum/t/bignum.t index f66f8f89aa..22ebece6b1 100644 --- a/cpan/bignum/t/bignum.t +++ b/cpan/bignum/t/bignum.t @@ -1,11 +1,11 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 50; +use Test::More tests => 19; use bignum qw/oct hex/; @@ -13,7 +13,7 @@ use bignum qw/oct hex/; # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigFloat', '$x = 5 makes $x a Math::BigFloat'); # :constant is(2 + 2.5, 4.5, '2 + 2.5 = 4.5'); $x = 2 + 3.5; @@ -24,11 +24,8 @@ $x = 2 + 2.1; is(ref($x), 'Math::BigFloat', '$x = 2 + 2.1 makes $x a Math::BigFloat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigFloat', '$x = 2 ** 255 makes $x a Math::BigFloat'); -# see if Math::BigInt constant and upgrading works -is(Math::BigInt::bsqrt("12"), '3.464101615137754587054892683011744733886', - 'Math::BigInt::bsqrt("12")'); is(sqrt(12), '3.464101615137754587054892683011744733886', 'sqrt(12)'); @@ -47,70 +44,20 @@ is(1/3, '0.3333333333333333333333333333333333333333', '1/3'); ############################################################################### # accuracy and precision -is(bignum->accuracy(), undef, 'get accuracy'); -is(bignum->accuracy(12), 12, 'set accuracy to 12'); -is(bignum->accuracy(), 12, 'get accuracy again'); - -is(bignum->precision(), undef, 'get precision'); -is(bignum->precision(12), 12, 'set precision to 12'); -is(bignum->precision(), 12, 'get precision again'); - -is(bignum->round_mode(), 'even', 'get round mode'); -is(bignum->round_mode('odd'), 'odd', 'set round mode'); -is(bignum->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bignum->accuracy(), undef, 'get accuracy'); +bignum->accuracy(12); +is(bignum->accuracy(), 12, 'get accuracy again'); +bignum->accuracy(undef); +is(bignum->accuracy(), undef, 'get accuracy again'); + +is(bignum->precision(), undef, 'get precision'); +bignum->precision(12); +is(bignum->precision(), 12, 'get precision again'); +bignum->precision(undef); +is(bignum->precision(), undef, 'get precision again'); + +is(bignum->round_mode(), 'even', 'get round mode'); +bignum->round_mode('odd'); +is(bignum->round_mode(), 'odd', 'get round mode again'); +bignum->round_mode('even'); +is(bignum->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/bigrat.t b/cpan/bignum/t/bigrat.t index 23f8f81cdf..bbb3fb00e0 100644 --- a/cpan/bignum/t/bigrat.t +++ b/cpan/bignum/t/bigrat.t @@ -1,27 +1,31 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 55; +use Test::More tests => 29;; -use bigrat qw/oct hex/; +use bigrat; ############################################################################### # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigRat', '$x = 5 makes $x a Math::BigRat'); -# todo: is(2 + 2.5, 4.5); # should still work -# todo: $x = 2 + 3.5; is(ref($x), 'Math::BigFloat'); +is(2 + 2.5, 4.5); # should still work +$x = 2 + 3.5; +is(ref($x), 'Math::BigRat', '$x = 2 + 3.5 makes $x a Math::BigRat'); + +is(2 * 2.1, 4.2, '2 * 2.1 = 4.2'); +$x = 2 + 2.1; +is(ref($x), 'Math::BigRat', '$x = 2 + 2.1 makes $x a Math::BigRat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigRat', '$x = 2 ** 255 makes $x a Math::BigRat'); -# see if Math::BigRat constant works is(1/3, '1/3', qq|1/3 = '1/3'|); is(1/4+1/3, '7/12', qq|1/4+1/3 = '7/12'|); is(5/7+3/7, '8/7', qq|5/7+3/7 = '8/7'|); @@ -46,70 +50,20 @@ is(3/7 / 1.5, '2/7', qq|3/7 / 1.5 = '2/7'|); ############################################################################### # accuracy and precision -is(bigrat->accuracy(), undef, 'get accuracy'); -is(bigrat->accuracy(12), 12, 'set accuracy to 12'); -is(bigrat->accuracy(), 12, 'get accuracy again'); - -is(bigrat->precision(), undef, 'get precision'); -is(bigrat->precision(12), 12, 'set precision to 12'); -is(bigrat->precision(), 12, 'get precision again'); - -is(bigrat->round_mode(), 'even', 'get round mode'); -is(bigrat->round_mode('odd'), 'odd', 'set round mode'); -is(bigrat->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bigrat->accuracy(), undef, 'get accuracy'); +bigrat->accuracy(12); +is(bigrat->accuracy(), 12, 'get accuracy again'); +bigrat->accuracy(undef); +is(bigrat->accuracy(), undef, 'get accuracy again'); + +is(bigrat->precision(), undef, 'get precision'); +bigrat->precision(12); +is(bigrat->precision(), 12, 'get precision again'); +bigrat->precision(undef); +is(bigrat->precision(), undef, 'get precision again'); + +is(bigrat->round_mode(), 'even', 'get round mode'); +bigrat->round_mode('odd'); +is(bigrat->round_mode(), 'odd', 'get round mode again'); +bigrat->round_mode('even'); +is(bigrat->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/biinfnan.t b/cpan/bignum/t/biinfnan.t deleted file mode 100644 index c3349173fc..0000000000 --- a/cpan/bignum/t/biinfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bigint; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/bir_e_pi.t b/cpan/bignum/t/bir_e_pi.t deleted file mode 100644 index 8305580b04..0000000000 --- a/cpan/bignum/t/bir_e_pi.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### -# test for e() and PI() exports - -use strict; -use warnings; - -use Test::More tests => 4; - -use bigrat qw/e PI bexp bpi/; - -is(e, "2.718281828459045235360287471352662497757", 'e'); -is(PI, "3.141592653589793238462643383279502884197", 'PI'); - -# These tests should actually produce big rationals, but this is not yet -# implemented. - -is(bexp(1, 10), "2.718281828", 'bexp(1, 10)'); -is(bpi(10), "3.141592654", 'bpi(10)'); diff --git a/cpan/bignum/t/bn_lite.t b/cpan/bignum/t/bn_lite.t deleted file mode 100644 index d26fe5ceb7..0000000000 --- a/cpan/bignum/t/bn_lite.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### - -use strict; -use warnings; - -use Test::More; - -if (eval { require Math::BigInt::Lite; 1 }) { - plan tests => 1; - # can use Lite, so let bignum try it - require bignum; - bignum->import(); - # can't get to work a ref(1+1) here, presumable because :constant phase - # already done - is($bignum::_lite, 1, '$bignum::_lite is 1'); -} else { - plan skip_all => "no Math::BigInt::Lite"; -} diff --git a/cpan/bignum/t/bninfnan.t b/cpan/bignum/t/bninfnan.t deleted file mode 100644 index e437ca116b..0000000000 --- a/cpan/bignum/t/bninfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bignum; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/br_lite.t b/cpan/bignum/t/br_lite.t deleted file mode 100644 index 79ac2c655c..0000000000 --- a/cpan/bignum/t/br_lite.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### - -use strict; -use warnings; - -use Test::More; - -if (eval { require Math::BigInt::Lite; 1 }) { - plan tests => 1; - # can use Lite, so let bignum try it - require bigrat; - bigrat->import(); - # can't get to work a ref(1+1) here, presumable because :constant phase - # already done - is($bigrat::_lite, 1, '$bigrat::_lite is 1'); -} else { - plan skip_all => "no Math::BigInt::Lite"; -} diff --git a/cpan/bignum/t/brinfnan.t b/cpan/bignum/t/brinfnan.t deleted file mode 100644 index 1be81649ef..0000000000 --- a/cpan/bignum/t/brinfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bigrat; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/const-bigint.t b/cpan/bignum/t/const-bigint.t new file mode 100644 index 0000000000..441bbd33a1 --- /dev/null +++ b/cpan/bignum/t/const-bigint.t @@ -0,0 +1,237 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "118"; + +use bigint; + +my $class = "Math::BigInt"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x= 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +like(ref($x), qr/^Math::BigInt(::Lite)?$/, + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 0; +is($x, "0", "integer literal 0"); +like(ref($x), qr/^Math::BigInt(::Lite)?$/, + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} diff --git a/cpan/bignum/t/const-bignum.t b/cpan/bignum/t/const-bignum.t new file mode 100644 index 0000000000..b9021d6032 --- /dev/null +++ b/cpan/bignum/t/const-bignum.t @@ -0,0 +1,337 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "171"; + +use bignum; + +my $class = "Math::BigFloat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Octal literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "0.999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999.9", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.22.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "3.140625", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "3.140625", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +is(1.0 / 3.0, "0.3333333333333333333333333333333333333333", + "1.0 / 3.0 = 0.3333333333333333333333333333333333333333"); diff --git a/cpan/bignum/t/const-bigrat.t b/cpan/bignum/t/const-bigrat.t new file mode 100644 index 0000000000..1f3ff6f1fc --- /dev/null +++ b/cpan/bignum/t/const-bigrat.t @@ -0,0 +1,316 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "170"; + +use bigrat; + +my $class = "Math::BigRat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); +} + +################################################################################ +# The following tests are unique to Math::BigRat. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999/" + . "1000000000000000000000000000000000000000000000000000000000000000000000000", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "9999999999999999999999999999999999999999999999999999999999999999999999999/" + . "10", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "201/64", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "201/64", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} diff --git a/cpan/bignum/t/bii_e_pi.t b/cpan/bignum/t/e_pi-bigint.t index d9e20b5641..798da75836 100644 --- a/cpan/bignum/t/bii_e_pi.t +++ b/cpan/bignum/t/e_pi-bigint.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for e() and PI() exports diff --git a/cpan/bignum/t/big_e_pi.t b/cpan/bignum/t/e_pi-bignum.t index 06b4b0860a..08098b0952 100644 --- a/cpan/bignum/t/big_e_pi.t +++ b/cpan/bignum/t/e_pi-bignum.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for e() and PI() exports diff --git a/cpan/bignum/t/e_pi-bigrat.t b/cpan/bignum/t/e_pi-bigrat.t new file mode 100644 index 0000000000..bd15821630 --- /dev/null +++ b/cpan/bignum/t/e_pi-bigrat.t @@ -0,0 +1,22 @@ +# -*- mode: perl; -*- + +############################################################################### +# test for e() and PI() exports + +use strict; +use warnings; + +use Test::More tests => 4; + +use bigrat qw/e PI bexp bpi/; + +is(e, "2718281828459045235360287471352662497757/" + . "1000000000000000000000000000000000000000", 'e'); +is(PI, "3141592653589793238462643383279502884197/" + . "1000000000000000000000000000000000000000", 'PI'); + +# These tests should actually produce big rationals, but this is not yet +# implemented. Fixme! + +is(bexp(1, 10), "679570457/250000000", 'bexp(1, 10)'); +is(bpi(10), "1570796327/500000000", 'bpi(10)'); diff --git a/cpan/bignum/t/import-bigint.t b/cpan/bignum/t/import-bigint.t new file mode 100644 index 0000000000..cdef019efa --- /dev/null +++ b/cpan/bignum/t/import-bigint.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bigint; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bigint -> import("l" => "foo") }; +is($@, '', + qq|eval { bigint -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("lib" => "foo") }; +is($@, '', + qq|eval { bigint -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("try" => "foo") }; +is($@, '', + qq|eval { bigint -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("try" => "foo") }; +is($@, '', + qq|eval { bigint -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bigint -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("only" => "bar") }; +is($@, "", + qq|eval { bigint -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bigint -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bigint -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/import-bignum.t b/cpan/bignum/t/import-bignum.t new file mode 100644 index 0000000000..e3ed2a50fe --- /dev/null +++ b/cpan/bignum/t/import-bignum.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bignum; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bignum -> import("l" => "foo") }; +is($@, '', + qq|eval { bignum -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("lib" => "foo") }; +is($@, '', + qq|eval { bignum -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("try" => "foo") }; +is($@, '', + qq|eval { bignum -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("try" => "foo") }; +is($@, '', + qq|eval { bignum -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bignum -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("only" => "bar") }; +is($@, "", + qq|eval { bignum -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bignum -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bignum -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/import-bigrat.t b/cpan/bignum/t/import-bigrat.t new file mode 100644 index 0000000000..965e0af9e8 --- /dev/null +++ b/cpan/bignum/t/import-bigrat.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bigrat; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bigrat -> import("l" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("lib" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("try" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("try" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bigrat -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("only" => "bar") }; +is($@, "", + qq|eval { bigrat -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bigrat -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bigrat -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/in_effect.t b/cpan/bignum/t/in_effect.t index b4507ea54a..28cc7c9dad 100644 --- a/cpan/bignum/t/in_effect.t +++ b/cpan/bignum/t/in_effect.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test in_effect() @@ -6,30 +6,70 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 21; -use bigint; -use bignum; -use bigrat; +{ + use bigint; + + can_ok('bigint', qw/in_effect/); -can_ok('bigint', qw/in_effect/); -can_ok('bignum', qw/in_effect/); -can_ok('bigrat', qw/in_effect/); + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; -SKIP: { - skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + is(bigint::in_effect(), 1, 'bigint in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigint not in effect'); + } - is(bigint::in_effect(), 1, 'bigint in effect'); - is(bignum::in_effect(), 1, 'bignum in effect'); - is(bigrat::in_effect(), 1, 'bigrat in effect'); + { + no bigint; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } } { - no bigint; - no bignum; - no bigrat; + use bignum; + + can_ok('bignum', qw/in_effect/); + + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), 1, 'bignum in effect'); + is(bigrat::in_effect(), undef, 'bigint not in effect'); + } + + { + no bignum; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } +} + +{ + use bigrat; + + can_ok('bigrat', qw/in_effect/); + + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), 1, 'bigint in effect'); + } + + { + no bigrat; - is(bigint::in_effect(), undef, 'bigint not in effect'); - is(bignum::in_effect(), undef, 'bignum not in effect'); - is(bigrat::in_effect(), undef, 'bigrat not in effect'); + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } } diff --git a/cpan/bignum/t/infnan-bigint.t b/cpan/bignum/t/infnan-bigint.t new file mode 100644 index 0000000000..92869be2eb --- /dev/null +++ b/cpan/bignum/t/infnan-bigint.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bigint; + +my $class = "Math::BigInt"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan-bignum.t b/cpan/bignum/t/infnan-bignum.t new file mode 100644 index 0000000000..3c4691051d --- /dev/null +++ b/cpan/bignum/t/infnan-bignum.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bignum; + +my $class = "Math::BigFloat"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan-bigrat.t b/cpan/bignum/t/infnan-bigrat.t new file mode 100644 index 0000000000..bd171a89ea --- /dev/null +++ b/cpan/bignum/t/infnan-bigrat.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bigrat; + +my $class = "Math::BigRat"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan.inc b/cpan/bignum/t/infnan.inc deleted file mode 100644 index 5ecc7b5936..0000000000 --- a/cpan/bignum/t/infnan.inc +++ /dev/null @@ -1,91 +0,0 @@ -#!perl - -use strict; -use warnings; - -my $x; - -############################################################################### -# inf tests - -$x = 1 + inf; -like(ref($x), qr/^Math::BigInt/, '$x = 1 + inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = 1 + inf; $x->bstr() = 'inf'|); - -$x = 1 * inf; -like(ref($x), qr/^Math::BigInt/, '$x = 1 * inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = 1 * inf; $x->bstr() = 'inf'|); - -# these don't work without exporting inf() -$x = inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf; $x->bstr() = 'inf'|); - -$x = inf + inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf + inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf + inf; $x->bstr() = 'inf'|); - -$x = inf * inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf * inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf * inf; $x->bstr() = 'inf'|); - -############################################################################### -# NaN tests - -$x = 1 + NaN; -like(ref($x), qr/^Math::BigInt/, '$x = 1 + NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = 1 + NaN; $x->bstr() = 'NaN'|); - -$x = 1 * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = 1 * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = 1 * NaN; $x->bstr() = 'NaN'|); - -# these don't work without exporting NaN() -$x = NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN; $x->bstr() = 'NaN'|); - -$x = NaN + NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN + NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN + NaN; $x->bstr() = 'NaN'|); - -$x = NaN * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN * NaN; $x->bstr() = 'NaN'|); - -############################################################################### -# mixed tests - -# these don't work without exporting NaN() or inf() - -$x = NaN + inf; -like(ref($x), qr/^Math::BigInt/, '$x = NaN + inf makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN + inf; $x->bstr() = 'NaN'|); - -$x = NaN * inf; -like(ref($x), qr/^Math::BigInt/, '$x = NaN * inf makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN * inf; $x->bstr() = 'NaN'|); - -$x = inf * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = inf * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = inf * NaN; $x->bstr() = 'NaN'|); - -############################################################################### -# inf and NaN as strings. - -for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { - my $x = 1 + $nan; - is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"; \$x->bstr() = "NaN"|); - isa_ok($x, "Math::BigInt"); -} - -for my $inf (qw/ inf inF iNf iNF Inf InF INf INF - infinity Infinity InFiNiTy iNfInItY - /) -{ - my $x = 1 + $inf; - is($x->bstr(), "inf", qq|\$x = 1 + "$inf"; \$x->bstr() = "inf"|); - isa_ok($x, "Math::BigInt"); -} - -1; diff --git a/cpan/bignum/t/option_a.t b/cpan/bignum/t/option_a.t index 2a9d17154d..6cd02268e1 100644 --- a/cpan/bignum/t/option_a.t +++ b/cpan/bignum/t/option_a.t @@ -1,22 +1,36 @@ -#!perl - -############################################################################### +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 6; + +{ + my $class = "Math::BigInt"; + + use bigint a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -use bignum a => '12'; + bigint -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); +} + +{ + my $class = "Math::BigFloat"; -my @CLASSES = qw/Math::BigInt Math::BigFloat/; + use bignum a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -foreach my $class (@CLASSES) { - is($class->accuracy(),12, "$class accuracy = 12"); + bignum -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); } -bignum->import(accuracy => '23'); +{ + my $class = "Math::BigRat"; + + use bigrat a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -foreach my $class (@CLASSES) { - is($class->accuracy(), 23, "$class accuracy = 23"); + bigrat -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); } diff --git a/cpan/bignum/t/option_l.t b/cpan/bignum/t/option_l.t index 25ca325f3e..74a1ce7ece 100644 --- a/cpan/bignum/t/option_l.t +++ b/cpan/bignum/t/option_l.t @@ -1,52 +1,72 @@ -#!perl +# -*- mode: perl; -*- # test the "l", "lib", "try" and "only" options: use strict; use warnings; -use Test::More tests => 19; +use Test::More tests => 14; use bignum; -# Catch warnings. +# Catch warning. -my @WARNINGS; +my $warning; local $SIG{__WARN__} = sub { - push @WARNINGS, $_[0]; + $warning = $_[0]; }; my $rc; -$rc = eval { bignum->import( "l" => "foo" ) }; -is($@, '', # shouldn't die - qq|eval { bignum->import( "l" => "foo" ) }|); -is(scalar(@WARNINGS), 1, 'one warning'); -like($WARNINGS[0], qr/using fallback/, 'using fallback'); +$warning = ""; +$rc = eval { bignum->import("l" => "foo") }; +subtest qq|eval { bignum->import("l" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "lib" => "foo" ) }; -is($@, '', # ditto - qq|eval { bignum->import( "lib" => "foo" ) }|); -is(scalar @WARNINGS, 2, 'two warnings'); -like($WARNINGS[1], qr/using fallback/, 'using fallback'); + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; + +$warning = ""; +$rc = eval { bignum->import("lib" => "foo") }; +subtest qq|eval { bignum->import("lib" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "try" => "foo" ) }; -is($@, '', # shouldn't die - qq|eval { bignum->import( "try" => "foo" ) }|); + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; -$rc = eval { bignum->import( "try" => "foo" ) }; -is($@, '', # ditto - qq|eval { bignum->import( "try" => "foo" ) }|); +$warning = ""; +$rc = eval { bignum->import("try" => "foo") }; +subtest qq|eval { bignum->import("try" => "foo") }| => sub { + plan tests => 2; + + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; -$rc = eval { bignum->import( "foo" => "bar" ) }; -like($@, qr/^Unknown option foo/i, 'died'); # should die +$warning = ""; +$rc = eval { bignum->import("only" => "foo") }; +subtest qq|eval { bignum->import("only" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "only" => "bar" ) }; -like($@, qr/fallback.*disallowed/i, 'died'); # should die + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; + +$warning = ""; +$rc = eval { bignum->import("foo" => "bar") }; +subtest qq|eval { bignum->import("foo" => "bar") }| => sub { + plan tests => 2; + + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; # test that options are only lowercase (don't see a reason why allow UPPER) foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { - $rc = eval { bignum->import( $_ => "bar" ) }; - like($@, qr/^Unknown option $_/i, 'died'); # should die + $rc = eval { bignum->import($_ => "bar") }; + like($@, qr/^Unknown option /i, + qq|eval { bignum->import($_ => "bar") }|); } diff --git a/cpan/bignum/t/option_p.t b/cpan/bignum/t/option_p.t index 6f57c92c81..672d73e199 100644 --- a/cpan/bignum/t/option_p.t +++ b/cpan/bignum/t/option_p.t @@ -1,20 +1,36 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 6; -my @CLASSES = qw/Math::BigInt Math::BigFloat/; +{ + my $class = "Math::BigInt"; -use bignum p => '12'; + use bigint p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); -foreach my $class (@CLASSES) { - is($class->precision(), 12, "$class precision = 12"); + bigint -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); } -bignum->import(p => '42'); +{ + my $class = "Math::BigFloat"; -foreach my $class (@CLASSES) { - is($class->precision(), 42, "$class precision = 42"); + use bignum p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); + + bignum -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); +} + +{ + my $class = "Math::BigRat"; + + use bigrat p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); + + bigrat -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); } diff --git a/cpan/bignum/t/overrides.t b/cpan/bignum/t/overrides.t index 371d91d667..c79563182b 100644 --- a/cpan/bignum/t/overrides.t +++ b/cpan/bignum/t/overrides.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; @@ -6,7 +6,7 @@ use warnings; # Test behaviour of hex and oct overrides in detail, and also how the three # modules interact. -use Test::More tests => 35; +use Test::More tests => 31; my $hex_called; my $oct_called; @@ -33,13 +33,14 @@ BEGIN { is oct(@_), "16", 'bigint oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > do { no bigint; 5.009004 }; + skip "no lexical hex/oct", 2 unless $] > "5.009004"; is ref hex(1), 'Math::BigInt', 'bigint hex() works when bignum and bigrat are loaded'; is ref oct(1), 'Math::BigInt', 'bigint oct() works when bignum and bigrat are loaded'; } } + { use bignum; $_ = "20"; @@ -50,13 +51,14 @@ BEGIN { is oct(@_), "16", 'bignum oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > 5.009004; - is ref hex(1), 'Math::BigInt', + skip "no lexical hex/oct", 2 unless $] > "5.009004"; + is ref hex(1), 'Math::BigFloat', 'bignum hex() works when bigint and bigrat are loaded'; - is ref oct(1), 'Math::BigInt', + is ref oct(1), 'Math::BigFloat', 'bignum oct() works when bigint and bigrat are loaded'; } } + { use bigrat; $_ = "20"; @@ -67,10 +69,10 @@ BEGIN { is oct(@_), "16", 'bigrat oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > 5.009004; - is ref hex(1), 'Math::BigInt', + skip "no lexical hex/oct", 2 unless $] > "5.009004"; + is ref hex(1), 'Math::BigRat', 'bigrat hex() works when bignum and bigint are loaded'; - is ref oct(1), 'Math::BigInt', + is ref oct(1), 'Math::BigRat', 'bigrat oct() works when bignum and bigint are loaded'; } } @@ -94,21 +96,23 @@ is $oct_called, 1, 'existing oct overrides are called'; ::is oct("20"), "16", 'exported oct function works with "decimal"'; # (used to return 20 because it thought it was decimal) } + { package _importer2; use bignum 'hex', 'oct'; ::is \&hex, \&bignum::hex, 'bignum exports hex'; ::is \&oct, \&bignum::oct, 'bignum exports oct'; - ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint'; - ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint'; +# ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint'; +# ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint'; } + { package _importer3; use bigrat 'hex', 'oct'; ::is \&hex, \&bigrat::hex, 'bigrat exports hex'; ::is \&oct, \&bigrat::oct, 'bigrat exports oct'; - ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint'; - ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint'; +# ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint'; +# ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint'; } is ref(hex 0), "", 'hex export is not global'; is ref(oct 0), "", 'oct export is not global'; diff --git a/cpan/bignum/t/ratopt_a.t b/cpan/bignum/t/ratopt_a.t index e5ee13b942..9a5ce7c061 100644 --- a/cpan/bignum/t/ratopt_a.t +++ b/cpan/bignum/t/ratopt_a.t @@ -1,13 +1,13 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 7; +use Test::More tests => 3; -my @CLASSES = qw/Math::BigInt Math::BigFloat Math::BigRat/; +my @CLASSES = qw/Math::BigRat/; # bigrat (bug until v0.15) use bigrat a => 2; diff --git a/cpan/bignum/t/scope_i.t b/cpan/bignum/t/scope-bigint.t index e76ceeee25..0196884a09 100644 --- a/cpan/bignum/t/scope_i.t +++ b/cpan/bignum/t/scope-bigint.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test "no bigint;" and overloading of hex()/oct() for newer Perls @@ -16,8 +16,8 @@ isnt(ref(2.0), '', 'is in effect'); isnt(ref(0x20), '', 'is in effect'); SKIP: { - # Quote version number due to "use bigint;" - skip('Need at least Perl v5.9.4', 2) if $] < "5.009004"; + # Quote numbers due to "use bigint;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; is(ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); is(ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); @@ -30,6 +30,6 @@ SKIP: { is(ref(2.0), '', 'is not in effect'); is(ref(0x20), '', 'is not in effect'); - isnt(ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt(ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); } diff --git a/cpan/bignum/t/scope-bignum.t b/cpan/bignum/t/scope-bignum.t new file mode 100644 index 0000000000..c10b24978c --- /dev/null +++ b/cpan/bignum/t/scope-bignum.t @@ -0,0 +1,35 @@ +# -*- mode: perl; -*- + +############################################################################### +# Test "no bignum;" and overloading of hex()/oct() for newer Perls + +use strict; +use warnings; + +use Test::More tests => 10; + +# no :hex and :oct means these do not get overloaded for older Perls: +use bignum; + +isnt(ref(1), '', 'is in effect'); +isnt(ref(2.0), '', 'is in effect'); +isnt(ref(0x20), '', 'is in effect'); + +SKIP: { + # Quote numbers due to "use bignum;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; + + is(ref(hex(9)), 'Math::BigFloat', 'hex is overloaded'); + is(ref(oct(07)), 'Math::BigFloat', 'oct is overloaded'); +} + +{ + no bignum; + + is(ref(1), '', 'is not in effect'); + is(ref(2.0), '', 'is not in effect'); + is(ref(0x20), '', 'is not in effect'); + + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); +} diff --git a/cpan/bignum/t/scope_r.t b/cpan/bignum/t/scope-bigrat.t index 8ad2626bf8..d7731d3ecf 100644 --- a/cpan/bignum/t/scope_r.t +++ b/cpan/bignum/t/scope-bigrat.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test "no bigrat;" and overloading of hex()/oct() for newer Perls @@ -16,10 +16,11 @@ isnt(ref(2.0), '', 'is in effect'); isnt(ref(0x20), '', 'is in effect'); SKIP: { - skip('Need at least Perl v5.9.4', 2) if $] < 5.009004; + # Quote numbers due to "use bigrat;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; - is(ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); - is(ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); + is(ref(hex(9)), 'Math::BigRat', 'hex is overloaded'); + is(ref(oct(07)), 'Math::BigRat', 'oct is overloaded'); } { @@ -29,6 +30,6 @@ SKIP: { is(ref(2.0), '', 'is not in effect'); is(ref(0x20), '', 'is not in effect'); - isnt(ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt(ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); } diff --git a/cpan/bignum/t/scope-nested-const.t b/cpan/bignum/t/scope-nested-const.t new file mode 100644 index 0000000000..b2f2a4d039 --- /dev/null +++ b/cpan/bignum/t/scope-nested-const.t @@ -0,0 +1,222 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 48; + +note "\nbigint -> bignum -> bigrat\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); +} + +note "\nbigint -> bigrat -> bignum\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); +} + +note "\nbignum -> bigint -> bigrat\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); +} + +note "\nbignum -> bigrat -> bigint\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); +} + +note "\nbigrat -> bigint -> bignum\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); +} + +note "\nbigrat -> bignum -> bigint\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); +} diff --git a/cpan/bignum/t/scope-nested-hex-oct.t b/cpan/bignum/t/scope-nested-hex-oct.t new file mode 100644 index 0000000000..df26efa7f4 --- /dev/null +++ b/cpan/bignum/t/scope-nested-hex-oct.t @@ -0,0 +1,274 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More; + +plan skip_all => 'Need at least Perl v5.10.1' if $] < "5.010001"; + +plan tests => 96; + +note "\nbigint -> bignum -> bigrat\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigint -> bigrat -> bignum\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbignum -> bigint -> bigrat\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbignum -> bigrat -> bigint\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigrat -> bigint -> bignum\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigrat -> bignum -> bigint\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} diff --git a/cpan/bignum/t/scope_f.t b/cpan/bignum/t/scope_f.t deleted file mode 100644 index e932ea2b9f..0000000000 --- a/cpan/bignum/t/scope_f.t +++ /dev/null @@ -1,34 +0,0 @@ -#!perl - -############################################################################### -# Test "no bignum;" and overloading of hex()/oct() for newer Perls - -use strict; -use warnings; - -use Test::More tests => 10; - -# no :hex and :oct means these do not get overloaded for older Perls: -use bignum; - -isnt (ref(1), '', 'is in effect'); -isnt (ref(2.0), '', 'is in effect'); -isnt (ref(0x20), '', 'is in effect'); - -SKIP: { - skip ('Need at least Perl v5.9.4', 2) if $] < 5.009004; - - is (ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); - is (ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); - } - -{ - no bignum; - - is (ref(1), '', 'is not in effect'); - is (ref(2.0), '', 'is not in effect'); - is (ref(0x20), '', 'is not in effect'); - - isnt (ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt (ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); -} |