diff options
| author | Nicolas R <atoomic@cpan.org> | 2022-07-20 19:22:52 +0000 |
|---|---|---|
| committer | ℕicolas ℝ <nicolas@atoomic.org> | 2022-07-20 14:49:02 -0600 |
| commit | 04ce75ea5d4462d0a877e2912d76ce95fe31251f (patch) | |
| tree | eea211bbda621839fa3a4a0876f147e67169310d /cpan | |
| parent | 8270a88baa1fb2c2323982b6cbe05a4ad70ba889 (diff) | |
| download | perl-04ce75ea5d4462d0a877e2912d76ce95fe31251f.tar.gz | |
Sync Math::BigInt with CPAN 1.999837
From ChangeLog:
1.999837 2022-07-02
* Improve the interoperability between objects of different classes for
* the
methods that are still used as functions.
1.999836 2022-06-24
* Improve compatibility with older versions of the Math-BigRat
* distribution.
Math-BigInt version 1.999835 works with Math-BigRat version 0.2623
and newer.
Math-BigInt version 1.999836 works with Math-BigRat version 0.2618
and newer.
* Re-enable upgrading in Math::BigFloat->bdiv().
* Fix an error in the enabling/disabling of upgrading/downgrading.
* Fix typos and other formatting errors.
1.999835 2022-05-24
* Fix bug related to upgrading in Math::BigInt->brsft(). This bug
only showed up in Perl versions 5.16 and older.
1.999834 2022-05-23
* Further improvements to upgrading and downgrading.
1.999833 2022-05-23
* Fix Math::BigFloat->bpi(). The previous attempt at correcting it
wasn't sufficient. Added test to verify the fix.
* Correct the formatting in the CHANGES file.
1.999832 2022-05-21
* Improve as_int(), as_float(), and as_rat() so that they return a
Math::BigInt, Math::BigFloat, and Math::BigRat, respectivly,
regardless of upgrading and downgrading.
* Improve stringification method bsstr() so that it handles upgrading
and downgrading better.
* Fix Math::BigFloat->bpi(), which unfortunately didn't handle
downgrading.
* Avoid unnecessary downgrading/upgrading.
* Add missed cases where downgrading/upgrading should be performed.
* Avoid unnecessary stringification.
1.999831 2022-05-16
* Further improvements to upgrading, downgrading, and rounding.
* New stringification method bfstr() for representing numbers as
* fractions.
E.g., Math::BigFloat -> new("1.25") -> bfstr() returns "5/4".
* Miscellaneous bug fixes.
* Fixed errors and typos in the documentation.
Diffstat (limited to 'cpan')
73 files changed, 3895 insertions, 15017 deletions
diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index d404f66af3..66300a4928 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -20,7 +20,7 @@ use Carp qw< carp croak >; use Scalar::Util qw< blessed >; use Math::BigInt qw< >; -our $VERSION = '1.999830'; +our $VERSION = '1.999837'; $VERSION =~ tr/_//d; require Exporter; @@ -261,8 +261,7 @@ BEGIN { $rnd_mode = 'even'; tie $rnd_mode, 'Math::BigFloat'; - # we need both of them in this package: - *as_int = \&as_number; + *as_number = \&as_int; } sub DESTROY { @@ -272,7 +271,6 @@ sub DESTROY { sub AUTOLOAD { # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx() my $name = $AUTOLOAD; - $name =~ s/(.*):://; # split package my $c = $1 || __PACKAGE__; no strict 'refs'; @@ -286,7 +284,8 @@ sub AUTOLOAD { # delayed load of Carp and avoid recursion croak("Can't call $c\-\>$name, not a valid method"); } - # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() + # try one level up, but subst. bxxx() for fxxx() since MBI only got + # bxxx() $name =~ s/^f/b/; return &{"Math::BigInt"."::$name"}(@_); } @@ -353,7 +352,8 @@ sub config { ############################################################################### sub new { - # Create a new Math::BigFloat object from a string or another bigfloat object. + # Create a new Math::BigFloat object from a string or another bigfloat + # object. # _e: exponent # _m: mantissa # sign => ("+", "-", "+inf", "-inf", or "NaN") @@ -394,16 +394,19 @@ sub new { $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! + # Math::BigFloat or subclass + + if (defined(blessed($wanted)) && $wanted -> isa($class)) { + + # Don't copy the accuracy and precision, because a new object should get + # them from the global configuration. - 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]); + $self = $self->round(@r) + unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } @@ -427,43 +430,54 @@ sub new { } } - # Handle Infs. + # Shortcut for simple forms like '123' that have no trailing zeros. Trailing + # zeros would require a non-zero exponent. - if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { - return $downgrade->new($wanted) if defined $downgrade; - my $sgn = $1 || '+'; - $self = $class -> binf($sgn); - $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + 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 defined $downgrade; + $self->{sign} = $1 || '+'; + $self->{_m} = $LIB -> _new($2); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + $self = $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). + # Handle Infs. - if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { - return $downgrade->new($wanted) if defined $downgrade; - $self = $class -> bnan(); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; + if ($wanted =~ / ^ + \s* + ( [+-]? ) + inf (?: inity )? + \s* + \z + /ix) + { + my $sgn = $1 || '+'; + return $class -> binf($sgn, @r); } - # Shortcut for simple forms like '123' that have no trailing zeros. + # Handle explicit NaNs (not the ones returned due to invalid input). if ($wanted =~ / ^ - \s* # optional leading whitespace - ( [+-]? ) # optional sign - 0* # optional leading zeros - ( [1-9] (?: [0-9]* [1-9] )? ) # significand - \s* # optional trailing whitespace - $ - /x) + \s* + ( [+-]? ) + nan + \s* + \z + /ix) { - return $downgrade->new($1 . $2) if defined $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; + return $class -> bnan(@r); } my @parts; @@ -473,7 +487,7 @@ sub new { # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Xx]/ and - @parts = $class -> _hex_str_to_lib_parts($wanted) + @parts = $class -> _hex_str_to_flt_lib_parts($wanted) or @@ -481,7 +495,7 @@ sub new { # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Oo]/ and - @parts = $class -> _oct_str_to_lib_parts($wanted) + @parts = $class -> _oct_str_to_flt_lib_parts($wanted) or @@ -489,7 +503,7 @@ sub new { # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Bb]/ and - @parts = $class -> _bin_str_to_lib_parts($wanted) + @parts = $class -> _bin_str_to_flt_lib_parts($wanted) or @@ -497,34 +511,33 @@ sub new { # 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) + @parts = $class -> _dec_str_to_flt_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., + # included because _oct_str_to_flt_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)) + @parts = $class -> _oct_str_to_flt_lib_parts($wanted)) { - # The value is an integer iff the exponent is non-negative. + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; - if ($parts[2] eq '+' && $downgrade) { - return $downgrade->new($wanted, @r); - } + $self = $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 $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); 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. - return $class -> bnan(); + return $class -> bnan(@r); } sub from_dec { @@ -534,25 +547,23 @@ sub from_dec { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_dec'); + return $self 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)) { + $self = bless {}, $class unless $selfref; - # The value is an integer iff the exponent is non-negative. + if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; - if ($parts[2] eq '+') { - return $downgrade->new($str, @r) if defined $downgrade; - } + $self = $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 $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); return $self; } @@ -566,25 +577,23 @@ sub from_hex { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_hex'); + return $self 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 (my @parts = $class -> _hex_str_to_lib_parts($str)) { + $self = bless {}, $class unless $selfref; - # The value is an integer iff the exponent is non-negative. + if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) { + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; - if ($parts[2] eq '+' && defined $downgrade) { - return $downgrade -> from_hex($str, @r); - } + $self = $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 $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); return $self; } @@ -598,25 +607,23 @@ sub from_oct { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_oct'); + return $self 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 (my @parts = $class -> _oct_str_to_lib_parts($str)) { + $self = bless {}, $class unless $selfref; - # The value is an integer iff the exponent is non-negative. + if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; - if ($parts[2] eq '+') { - return $downgrade -> from_oct($str, @r) if defined $downgrade; - } + $self = $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 $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); return $self; } @@ -630,25 +637,23 @@ sub from_bin { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_bin'); + return $self 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 (my @parts = $class -> _bin_str_to_lib_parts($str)) { + $self = bless {}, $class unless $selfref; - # The value is an integer iff the exponent is non-negative. + if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; - if ($parts[2] eq '+') { - return $downgrade -> from_bin($str, @r) if defined $downgrade; - } + $self = $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 $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); return $self; } @@ -662,14 +667,14 @@ sub from_ieee754 { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_ieee754'); + return $self if $selfref && $self->modify('from_ieee754'); my $in = shift; # input string (or raw bytes) my $format = shift; # format ("binary32", "decimal64" etc.) my $enc; # significand encoding (applies only to decimal) my $k; # storage width in bits my $b; # base - my @r = @_; + my @r = @_; # rounding parameters, if any if ($format =~ /^binary(\d+)\z/) { $k = $1; @@ -730,7 +735,7 @@ sub from_ieee754 { # The maximum exponent, minimum exponent, and exponent bias. - my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec(); + my $emax = Math::BigFloat -> new(2) -> bpow($w - 1) -> bdec(); my $emin = 1 - $emax; my $bias = $emax; @@ -767,7 +772,7 @@ sub from_ieee754 { my $x; - $expo -> bsub($bias); # subtract bias + $expo = $expo -> bsub($bias); # subtract bias if ($expo < $emin) { # zero and subnormals if ($mant == 0) { # zero @@ -775,8 +780,8 @@ sub from_ieee754 { } else { # subnormals # compute (1/$b)**(N) rather than ($b)**(-N) $x = $class -> new("0.5"); # 1/$b - $x -> bpow($bias + $t - 1) -> bmul($mant); - $x -> bneg() if $sign eq '-'; + $x = $x -> bpow($bias + $t - 1) -> bmul($mant); + $x = $x -> bneg() if $sign eq '-'; } } @@ -784,7 +789,7 @@ sub from_ieee754 { if ($mant == 0) { # inf $x = $class -> binf($sign); } else { # nan - $x = $class -> bnan(); + $x = $class -> bnan(@r); } } @@ -793,12 +798,12 @@ sub from_ieee754 { if ($expo < $t) { # compute (1/$b)**(N) rather than ($b)**(-N) $x = $class -> new("0.5"); # 1/$b - $x -> bpow($t - $expo) -> bmul($mant); + $x = $x -> bpow($t - $expo) -> bmul($mant); } else { $x = $class -> new(2); - $x -> bpow($expo - $t) -> bmul($mant); + $x = $x -> bpow($expo - $t) -> bmul($mant); } - $x -> bneg() if $sign eq '-'; + $x = $x -> bneg() if $sign eq '-'; } if ($selfref) { @@ -810,8 +815,8 @@ sub from_ieee754 { $self = $x; } - return $downgrade -> new($x, @r) - if defined($downgrade) && $x -> is_int(); + return $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self -> is_int(); return $self -> round(@r); } @@ -821,9 +826,12 @@ sub from_ieee754 { sub bzero { # create/assign '+0' - if (@_ == 0) { - #carp("Using bone() as a function is deprecated;", - # " use bone() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -832,9 +840,18 @@ sub bzero { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $selfref && $self->modify('bzero'); - return $downgrade->bzero() if defined $downgrade; + # Don't modify constant (read-only) objects. + + return $self if $selfref && $self->modify('bzero'); + + # Get the rounding parameters, if any. + + my @r = @_; + + return $downgrade -> bzero(@r) if defined $downgrade; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -847,11 +864,13 @@ sub bzero { # parameters are given, and if called as a class method initialize the new # instance with the class variables. - if (@_) { + #return $self -> round(@r); # this should work, but doesnt; fixme! + + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; - $self->{_a} = $_[0]; - $self->{_p} = $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); + $self->{_a} = $r[0]; + $self->{_p} = $r[1]; } else { unless($selfref) { $self->{_a} = $class -> accuracy(); @@ -865,9 +884,12 @@ sub bzero { sub bone { # Create or assign '+1' (or -1 if given sign '-'). - if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - #carp("Using bone() as a function is deprecated;", - # " use bone() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -876,12 +898,26 @@ sub bone { my $class = $selfref || $self; $self->import() if $IMPORT == 0; # make require work - return if $selfref && $self->modify('bone'); - return $downgrade->bone() if defined $downgrade; + # Don't modify constant (read-only) objects. + + return $self if $selfref && $self->modify('bone'); - my $sign = shift; - $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; + return $downgrade -> bone(@_) if defined $downgrade; + + # Get the sign. + + my $sign = '+'; # default is to return +1 + if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) { + $sign = $1; + shift; + } + + # Get the rounding parameters, if any. + + my @r = @_; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -894,9 +930,11 @@ sub bone { # parameters are given, and if called as a class method initialize the new # instance with the class variables. - if (@_) { + #return $self -> round(@r); # this should work, but doesnt; fixme! + + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); $self->{_a} = $_[0]; $self->{_p} = $_[1]; } else { @@ -912,16 +950,15 @@ sub bone { sub binf { # create/assign a '+inf' or '-inf' - if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && - $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) { - #carp("Using binf() as a function is deprecated;", - # " use binf() as a method instead"); + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } - return $downgrade->binf(@_) if defined $downgrade; - my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; @@ -934,10 +971,26 @@ sub binf { } $self->import() if $IMPORT == 0; # make require work - return if $selfref && $self->modify('binf'); - my $sign = shift; - $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; + # Don't modify constant (read-only) objects. + + return $self if $selfref && $self->modify('binf'); + + return $downgrade -> binf(@_) if $downgrade; + + # Get the sign. + + my $sign = '+'; # default is to return positive infinity + if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) { + $sign = $1; + shift; + } + + # Get the rounding parameters, if any. + + my @r = @_; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -950,11 +1003,13 @@ sub binf { # parameters are given, and if called as a class method initialize the new # instance with the class variables. - if (@_) { + #return $self -> round(@r); # this should work, but doesnt; fixme! + + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; - $self->{_a} = $_[0]; - $self->{_p} = $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); + $self->{_a} = $r[0]; + $self->{_p} = $r[1]; } else { unless($selfref) { $self->{_a} = $class -> accuracy(); @@ -968,14 +1023,15 @@ sub binf { sub bnan { # create/assign a 'NaN' - if (@_ == 0) { - #carp("Using bnan() as a function is deprecated;", - # " use bnan() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } - return $downgrade->bnan(@_) if defined $downgrade; - my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; @@ -988,7 +1044,18 @@ sub bnan { } $self->import() if $IMPORT == 0; # make require work - return if $selfref && $self->modify('bnan'); + + # Don't modify constant (read-only) objects. + + return $self if $selfref && $self->modify('bnan'); + + return $downgrade -> bnan(@_) if defined $downgrade; + + # Get the rounding parameters, if any. + + my @r = @_; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -1001,11 +1068,13 @@ sub bnan { # parameters are given, and if called as a class method initialize the new # instance with the class variables. - if (@_) { + #return $self -> round(@r); # this should work, but doesnt; fixme! + + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; - $self->{_a} = $_[0]; - $self->{_p} = $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); + $self->{_a} = $r[0]; + $self->{_p} = $r[1]; } else { unless($selfref) { $self->{_a} = $class -> accuracy(); @@ -1018,6 +1087,15 @@ sub bnan { sub bpi { + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } + # Called as Argument list # --------- ------------- # Math::BigFloat->bpi() ("Math::BigFloat") @@ -1039,35 +1117,12 @@ sub bpi { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; + my @r = @_; # rounding paramters - 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; # initialize - } - - # ... 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; # initialize - } + if ($selfref) { # bpi() called as an instance method + return $self if $self -> modify('bpi'); + } else { # bpi() called as a class method + $self = bless {}, $class; # initialize new instance } ($self, @r) = $self -> _find_round_parameters(@r); @@ -1142,13 +1197,19 @@ EOF if ($last_digit lt '9') { substr($digits, -1, 1) = ++$last_digit; } else { - $digits =~ s/([0-8])(9+)$/ ($1 + 1) . ("0" x CORE::length($2)) /e; + $digits =~ s{([0-8])(9+)$} + { ($1 + 1) . ("0" x CORE::length($2)) }e; } } - # Append the exponent and convert to an object. + # Convert to an object. - $pi = Math::BigFloat -> new($digits . 'e-' . ($n - 1)); + $pi = bless { + sign => '+', + _m => $LIB -> _new($digits), + _es => '-', + _e => $LIB -> _new($n - 1), + }, $class; } else { @@ -1159,20 +1220,21 @@ EOF $n += 8; $HALF = $class -> new($HALF) unless ref($HALF); - my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy() -> bsqrt($n), - $HALF -> copy() -> bmul($HALF), $class -> bone); + my ($an, $bn, $tn, $pn) + = ($class -> bone, $HALF -> copy() -> bsqrt($n), + $HALF -> copy() -> bmul($HALF), $class -> bone); while ($pn < $n) { my $prev_an = $an -> copy(); - $an -> badd($bn) -> bmul($HALF, $n); - $bn -> bmul($prev_an) -> bsqrt($n); - $prev_an -> bsub($an); - $tn -> bsub($pn * $prev_an * $prev_an); - $pn -> badd($pn); + $an = $an -> badd($bn) -> bmul($HALF, $n); + $bn = $bn -> bmul($prev_an) -> bsqrt($n); + $prev_an = $prev_an -> bsub($an); + $tn = $tn -> bsub($pn * $prev_an * $prev_an); + $pn = $pn -> badd($pn); } - $an -> badd($bn); - $an -> bmul($an, $n) -> bdiv(4 * $tn, $n); + $an = $an -> badd($bn); + $an = $an -> bmul($an, $n) -> bdiv(4 * $tn, $n); - $an -> round(@r); + $an = $an -> round(@r); $pi = $an; } @@ -1186,54 +1248,95 @@ EOF $self -> {$key} = $pi -> {$key}; } + return $downgrade -> new($self -> bdstr(), @r) + if defined($downgrade) && $self->is_int(); return $self; } sub copy { - my $self = shift; - my $selfref = ref $self; - my $class = $selfref || $self; - - # If called as a class method, the object to copy is the next argument. + my ($x, $class); + if (ref($_[0])) { # $y = $x -> copy() + $x = shift; + $class = ref($x); + } else { # $y = Math::BigInt -> copy($y) + $class = shift; + $x = shift; + } - $self = shift() unless $selfref; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @_; my $copy = bless {}, $class; - $copy->{sign} = $self->{sign}; - $copy->{_es} = $self->{_es}; - $copy->{_m} = $LIB->_copy($self->{_m}); - $copy->{_e} = $LIB->_copy($self->{_e}); - $copy->{_a} = $self->{_a} if exists $self->{_a}; - $copy->{_p} = $self->{_p} if exists $self->{_p}; + $copy->{sign} = $x->{sign}; + $copy->{_es} = $x->{_es}; + $copy->{_m} = $LIB->_copy($x->{_m}); + $copy->{_e} = $LIB->_copy($x->{_e}); + $copy->{_a} = $x->{_a} if exists $x->{_a}; + $copy->{_p} = $x->{_p} if exists $x->{_p}; return $copy; } -sub as_number { +sub as_int { # return copy as a bigint representation of this Math::BigFloat number - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - return $x if $x->modify('as_number'); + return $x -> copy() if $x -> isa("Math::BigInt"); - if (!$x->isa('Math::BigFloat')) { - # if the object can as_number(), use it - return $x->as_number() if $x->can('as_number'); - # otherwise, get us a float and then a number - $x = $x->can('as_float') ? $x->as_float() : $class->new(0+"$x"); - } + # disable upgrading and downgrading - return Math::BigInt->binf($x->sign()) if $x->is_inf(); - return Math::BigInt->bnan() if $x->is_nan(); + require Math::BigInt; + my $upg = Math::BigInt -> upgrade(); + my $dng = Math::BigInt -> downgrade(); + Math::BigInt -> upgrade(undef); + Math::BigInt -> downgrade(undef); - my $z = $LIB->_copy($x->{_m}); - if ($x->{_es} eq '-') { # < 0 - $z = $LIB->_rsft($z, $x->{_e}, 10); - } elsif (! $LIB->_is_zero($x->{_e})) { # > 0 - $z = $LIB->_lsft($z, $x->{_e}, 10); + my $y; + if ($x -> is_inf()) { + $y = Math::BigInt -> binf($x->sign()); + } elsif ($x -> is_nan()) { + $y = Math::BigInt -> bnan(); + } else { + $y = $LIB->_copy($x->{_m}); + if ($x->{_es} eq '-') { # < 0 + $y = $LIB->_rsft($y, $x->{_e}, 10); + } elsif (! $LIB->_is_zero($x->{_e})) { # > 0 + $y = $LIB->_lsft($y, $x->{_e}, 10); + } + $y = Math::BigInt->new($x->{sign} . $LIB->_str($y)); } - $z = Math::BigInt->new($x->{sign} . $LIB->_str($z)); - $z; + + # reset upgrading and downgrading + + Math::BigInt -> upgrade($upg); + Math::BigInt -> downgrade($dng); + + return $y; +} + +sub as_float { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + return $x -> copy() if $x -> isa("Math::BigFloat"); + + # disable upgrading and downgrading + + require Math::BigFloat; + my $upg = Math::BigFloat -> upgrade(); + my $dng = Math::BigFloat -> downgrade(); + Math::BigFloat -> upgrade(undef); + Math::BigFloat -> downgrade(undef); + + my $y = Math::BigFloat -> new($x); + + # reset upgrading and downgrading + + Math::BigFloat -> upgrade($upg); + Math::BigFloat -> downgrade($dng); + + return $y; } ############################################################################### @@ -1242,14 +1345,14 @@ sub as_number { sub is_zero { # return true if arg (BFLOAT or num_str) is zero - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0; } sub is_one { # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given - my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); $sign = '+' if !defined $sign || $sign ne '-'; @@ -1260,7 +1363,7 @@ sub is_one { sub is_odd { # return true if arg (BFLOAT or num_str) is odd or false if even - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($LIB->_is_zero($x->{_e})) && @@ -1269,7 +1372,7 @@ sub is_odd { sub is_even { # return true if arg (BINT or num_str) is even or false if odd - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($x->{_es} eq '+') && # 123.45 isn't @@ -1278,7 +1381,7 @@ sub is_even { sub is_int { # return true if arg (BFLOAT or num_str) is an integer - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); (($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't ($x->{_es} eq '+')) ? 1 : 0; # 1e-1 => no integer @@ -1292,15 +1395,11 @@ sub bcmp { # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) # set up parameters - my ($class, $x, $y) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - return $upgrade->bcmp($x, $y) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # Handle all 'nan' cases. @@ -1339,8 +1438,9 @@ sub bcmp { my $mxl = $LIB->_len($x->{_m}); my $myl = $LIB->_len($y->{_m}); - # If the mantissas have the same length, there is no point in normalizing the - # exponents by the length of the mantissas, so treat that as a special case. + # If the mantissas have the same length, there is no point in normalizing + # the exponents by the length of the mantissas, so treat that as a special + # case. if ($mxl == $myl) { @@ -1378,8 +1478,8 @@ sub bcmp { if ($x->{_es} eq '+') { - # If the exponent of x is >= 0 and the exponent of y is >= 0, there is no - # need to do anything special. + # If the exponent of x is >= 0 and the exponent of y is >= 0, there is + # no need to do anything special. if ($y->{_es} eq '+') { $ex = $LIB->_copy($x->{_e}); @@ -1428,8 +1528,8 @@ sub bcmp { return $cmp if $cmp; # Compare the mantissas, but first normalize them by padding the shorter - # mantissa with zeros (shift left) until it has the same length as the longer - # mantissa. + # mantissa with zeros (shift left) until it has the same length as the + # longer mantissa. my $mx = $x->{_m}; my $my = $y->{_m}; @@ -1451,14 +1551,11 @@ sub bacmp { # Returns one of undef, <0, =0, >0. (suitable for sort) # set up parameters - my ($class, $x, $y) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - return $upgrade->bacmp($x, $y) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # handle +-inf and NaN's if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { @@ -1509,25 +1606,33 @@ sub bacmp { sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return $x if $x->modify('bneg'); - # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' - $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})); + return $x -> bnan(@r) if $x -> is_nan(); - return $downgrade -> new($x) - if defined($downgrade) && ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); - return $x; + # For +0 do not negate (to have always normalized +0). + $x->{sign} =~ tr/+-/-+/ + unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_m}); + + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) + && ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); + return $x -> round(@r); } sub bnorm { + # bnorm() can't support rounding, because bround() and bfround() call + # bnorm(), which would recurse indefinitely. + # adjust m and e so that m is smallest possible - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # inf, nan etc if ($x->{sign} !~ /^[+-]$/) { - return $downgrade->new($x) if defined $downgrade; + return $downgrade -> new($x) if defined $downgrade; return $x; } @@ -1548,13 +1653,17 @@ sub bnorm { } } else { # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing - # zeros). So, for something like 0Ey, set y to 1, and -0 => +0 - $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $LIB->_one() - if $LIB->_is_zero($x->{_m}); + # zeros). So, for something like 0Ey, set y to 0, and -0 => +0 + if ($LIB->_is_zero($x->{_m})) { + $x->{sign} = '+'; + $x->{_es} = '+'; + $x->{_e} = $LIB->_zero(); + } } - return $downgrade->new($x) if defined($downgrade) && $x->is_int(); - $x; + return $downgrade -> new($x) + if defined($downgrade) && $x->is_int(); + return $x; } sub binc { @@ -1563,19 +1672,28 @@ sub binc { return $x if $x->modify('binc'); + # Inf and NaN + + return $x -> bnan(@r) if $x -> is_nan(); + return $x -> binf($x->{sign}, @r) if $x -> is_inf(); + + # Non-integer + if ($x->{_es} eq '-') { - return $x->badd($class->bone(), @r); # digits after dot + return $x->badd($class->bone(), @r); } - if (!$LIB->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf - { - # 1e2 => 100, so after the shift below _m has a '0' as last digit + # If the exponent is non-zero, convert the internal representation, so that, + # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa. + + if (!$LIB->_is_zero($x->{_e})) { $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 - $x->{_e} = $LIB->_zero(); # normalize + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; # we know that the last digit of $x will be '1' or '9', depending on the # sign } + # now $x->{_e} == 0 if ($x->{sign} eq '+') { $x->{_m} = $LIB->_inc($x->{_m}); @@ -1585,8 +1703,10 @@ sub binc { $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->bround(@r); } - # inf, nan handling etc - $x->badd($class->bone(), @r); # badd() does round + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x; } sub bdec { @@ -1595,78 +1715,82 @@ sub bdec { return $x if $x->modify('bdec'); + # Inf and NaN + + return $x -> bnan(@r) if $x -> is_nan(); + return $x -> binf($x->{sign}, @r) if $x -> is_inf(); + + # Non-integer + if ($x->{_es} eq '-') { - return $x->badd($class->bone('-'), @r); # digits after dot + return $x->badd($class->bone('-'), @r); } + # If the exponent is non-zero, convert the internal representation, so that, + # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa. + if (!$LIB->_is_zero($x->{_e})) { $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 - $x->{_e} = $LIB->_zero(); # normalize + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; } + # now $x->{_e} == 0 my $zero = $x->is_zero(); - # <= 0 - if (($x->{sign} eq '-') || $zero) { + if (($x->{sign} eq '-') || $zero) { # x <= 0 $x->{_m} = $LIB->_inc($x->{_m}); $x->{sign} = '-' if $zero; # 0 => 1 => -1 $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->round(@r); } - # > 0 - elsif ($x->{sign} eq '+') { + elsif ($x->{sign} eq '+') { # x > 0 $x->{_m} = $LIB->_dec($x->{_m}); return $x->bnorm()->round(@r); } - # inf, nan handling etc - $x->badd($class->bone('-'), @r); # does round + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x -> round(@r); } sub badd { - # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first) - # return result as BFLOAT - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('badd'); # inf and NaN handling if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { - # NaN first + # $x is NaN and/or $y is NaN if ($x->{sign} eq $nan || $y->{sign} eq $nan) { - $x->bnan(); + $x = $x->bnan(); } - # inf handling + # $x is Inf and $y is Inf elsif ($x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/) { - # +inf++inf or -inf+-inf => same, rest is NaN - $x->bnan() if $x->{sign} ne $y->{sign}; + # +Inf + +Inf or -Inf + -Inf => same, rest is NaN + $x = $x->bnan() if $x->{sign} ne $y->{sign}; } - # +-inf + something => +inf; something +-inf => +-inf + # +-inf + something => +-inf; something +-inf => +-inf elsif ($y->{sign} =~ /^[+-]inf$/) { $x->{sign} = $y->{sign}; } - return $downgrade->new($x, @r) if defined $downgrade; - return $x; + return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade; + return $x -> round(@r); } - return $upgrade->badd($x, $y, @r) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + return $upgrade->badd($x, $y, @r) if defined $upgrade; $r[3] = $y; # no push! # for speed: no add for $x + 0 if ($y->is_zero()) { - $x->bround(@r); + $x = $x->round(@r); } # for speed: no add for 0 + $y @@ -1676,9 +1800,10 @@ sub badd { $x->{_es} = $y->{_es}; $x->{_m} = $LIB->_copy($y->{_m}); $x->{sign} = $y->{sign} || $nan; - $x->round(@r); + $x = $x->round(@r); } + # both $x and $y are non-zero else { # take lower of the two e's and adapt m1 to it to match m2 @@ -1688,16 +1813,13 @@ 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}); + ($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($y->{_m}); if ($es eq '-') { # < 0 $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); + ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); } elsif (!$LIB->_is_zero($e)) { # > 0 $add = $LIB->_lsft($add, $e, 10); } @@ -1708,38 +1830,28 @@ sub badd { $x->{_m} = $LIB->_add($x->{_m}, $add); } 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}); + $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign}); } # delete trailing zeros, then round - $x->bnorm()->round(@r); + $x = $x->bnorm()->round(@r); } - return $downgrade->new($x, @r) if defined($downgrade) && $x -> is_int(); - return $x; + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x; # rounding already done above } sub bsub { - # (BINT or num_str, BINT or num_str) return BINT - # subtract second arg from first, modify first - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('bsub'); - return $upgrade -> new($x) -> bsub($upgrade -> new($y), @r) - if defined $upgrade && (!$x -> isa($class) || !$y -> isa($class)); - if ($y -> is_zero()) { - $x -> round(@r); + $x = $x -> round(@r); } else { # To correctly handle the special case $x -> bsub($x), we note the sign @@ -1751,17 +1863,18 @@ sub bsub { if ($xsign ne $x -> {sign}) { # special case of $x -> bsub($x) results in 0 if ($xsign =~ /^[+-]$/) { - $x -> bzero(@r); + $x = $x -> bzero(@r); } else { - $x -> bnan(); # NaN, -inf, +inf + $x = $x -> bnan(); # NaN, -inf, +inf } - return $downgrade->new($x, @r) if defined $downgrade; - return $x; + return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade; + return $x -> round(@r); } $x = $x -> badd($y, @r); # badd does not leave internal zeros $y -> {sign} =~ tr/+-/-+/; # reset $y (does nothing for NaN) } - return $downgrade->new($x, @r) + + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); $x; # already rounded by badd() or no rounding } @@ -1770,72 +1883,73 @@ sub bmul { # multiply two numbers # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('bmul'); - return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return $x->bnan(@r) if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { - return $x->bnan() if $x->is_zero() || $y->is_zero(); + return $x->bnan(@r) if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf - return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); - return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); - return $x->binf('-'); + return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-', @r); } - return $upgrade->bmul($x, $y, @r) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + return $upgrade->bmul($x, $y, @r) if defined $upgrade; # 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}); + ($x->{_e}, $x->{_es}) + = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! # adjust sign: $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+'; - $x->bnorm->round(@r); + $x = $x->bnorm->round(@r); + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); + return $x; } sub bmuladd { # multiply two numbers and add the third to the result # set up parameters - my ($class, $x, $y, $z, @r) = objectify(3, @_); + my ($class, $x, $y, $z, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(3, @_); return $x if $x->modify('bmuladd'); - return $x->bnan() if (($x->{sign} eq $nan) || - ($y->{sign} eq $nan) || - ($z->{sign} eq $nan)); + return $x->bnan(@r) if (($x->{sign} eq $nan) || + ($y->{sign} eq $nan) || + ($z->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { - return $x->bnan() if $x->is_zero() || $y->is_zero(); + return $x->bnan(@r) if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf - return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); - return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); - return $x->binf('-'); + return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-', @r); } - return $upgrade->bmul($x, $y, @r) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); - # 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}); + ($x->{_e}, $x->{_es}) + = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1845,8 +1959,8 @@ sub bmuladd { # z=inf handling (z=NaN handled above) if ($z->{sign} =~ /^[+-]inf$/) { $x->{sign} = $z->{sign}; - return $downgrade->new($x) if defined $downgrade; - return $x; + return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade; + return $x -> round(@r); } # take lower of the two e's and adapt m1 to it to match m2 @@ -1856,17 +1970,14 @@ 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}); + ($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($z->{_m}); if ($es eq '-') # < 0 { $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); + ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1878,13 +1989,15 @@ sub bmuladd { $x->{_m} = $LIB->_add($x->{_m}, $add); } 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}); + $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign}); } # delete trailing zeros, then round - $x->bnorm()->round(@r); + $x = $x->bnorm()->round(@r); + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); + return $x; } sub bdiv { @@ -1892,10 +2005,10 @@ sub bdiv { # (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo) # set up parameters - my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_); + my ($class, $x, $y, @r) = (ref($_[0]), @_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $a, $p, $r) = objectify(2, @_); + ($class, $x, $y, @r) = objectify(2, @_); } return $x if $x->modify('bdiv'); @@ -1906,7 +2019,8 @@ sub bdiv { # Math::BigInt -> bdiv(). if ($x -> is_nan() || $y -> is_nan()) { - return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan(); + return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r)) + : $x -> bnan(@r); } # Divide by zero and modulo zero. This is handled the same way as in @@ -1916,12 +2030,14 @@ sub bdiv { if ($y -> is_zero()) { my ($quo, $rem); if ($wantarray) { - $rem = $x -> copy(); + $rem = $x -> copy() -> round(@r); + $rem = $downgrade -> new($rem, @r) + if defined($downgrade) && $rem -> is_int(); } if ($x -> is_zero()) { - $quo = $x -> bnan(); + $quo = $x -> bnan(@r); } else { - $quo = $x -> binf($x -> {sign}); + $quo = $x -> binf($x -> {sign}, @r); } return $wantarray ? ($quo, $rem) : $quo; } @@ -1932,12 +2048,12 @@ sub bdiv { if ($x -> is_inf()) { my ($quo, $rem); - $rem = $class -> bnan() if $wantarray; + $rem = $class -> bnan(@r) if $wantarray; if ($y -> is_inf()) { - $quo = $x -> bnan(); + $quo = $x -> bnan(@r); } else { my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; - $quo = $x -> binf($sign); + $quo = $x -> binf($sign, @r); } return $wantarray ? ($quo, $rem) : $quo; } @@ -1952,19 +2068,21 @@ sub bdiv { my ($quo, $rem); if ($wantarray) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { - $rem = $x -> copy(); - $quo = $x -> bzero(); + $rem = $x -> copy() -> round(@r); + $rem = $downgrade -> new($rem, @r) + if defined($downgrade) && $rem -> is_int(); + $quo = $x -> bzero(@r); } else { - $rem = $class -> binf($y -> {sign}); - $quo = $x -> bone('-'); + $rem = $class -> binf($y -> {sign}, @r); + $quo = $x -> bone('-', @r); } return ($quo, $rem); } else { if ($y -> is_inf()) { if ($x -> is_nan() || $x -> is_inf()) { - return $x -> bnan(); + return $x -> bnan(@r); } else { - return $x -> bzero(); + return $x -> bzero(@r); } } } @@ -1974,21 +2092,37 @@ sub bdiv { # the denominator (divisor) is non-zero. # x == 0? - return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero(); + if ($x->is_zero()) { + my ($quo, $rem); + $quo = $x->round(@r); + $quo = $downgrade -> new($quo, @r) + if defined($downgrade) && $quo -> is_int(); + if ($wantarray) { + $rem = $class -> bzero(@r); + return $quo, $rem; + } + return $quo; + } + + # Division might return a value that we can not represent exactly, so + # upgrade, if upgrading is enabled. + + return $upgrade -> bdiv($x, $y, @r) + if defined($upgrade) && !wantarray && !$LIB -> _is_one($y -> {_m}); # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params, $scale); - ($x, @params) = $x->_find_round_parameters($a, $p, $r, $y); + ($x, @params) = $x->_find_round_parameters($r[0], $r[1], $r[2], $y); - return $x if $x->is_nan(); # error in _find_round_parameters? + return $x -> round(@r) if $x->is_nan(); # error in _find_round_parameters? # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $class->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r; # round mode by caller or undef + $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not @@ -2001,7 +2135,8 @@ sub bdiv { $y = $class->new($y) unless $y->isa('Math::BigFloat'); - my $lx = $LIB -> _len($x->{_m}); my $ly = $LIB -> _len($y->{_m}); + my $lx = $LIB -> _len($x->{_m}); + my $ly = $LIB -> _len($y->{_m}); $scale = $lx if $lx > $scale; $scale = $ly if $ly > $scale; my $diff = $ly - $lx; @@ -2017,13 +2152,14 @@ sub bdiv { if ($xsign ne $x->{sign}) { # special case of $x /= $x results in 1 - $x->bone(); # "fixes" also sign of $y, since $x is $y + $x = $x->bone(); # "fixes" also sign of $y, since $x is $y } else { # correct $y's sign again $y->{sign} =~ tr/+-/-+/; # continue with normal div code: - # make copy of $x in case of list context for later remainder calculation + # make copy of $x in case of list context for later remainder + # calculation if (wantarray && $y_not_one) { $rem = $x->copy(); } @@ -2032,7 +2168,8 @@ sub bdiv { # check for / +-1 (+/- 1E0) if ($y_not_one) { - # promote BigInts and it's subclasses (except when already a Math::BigFloat) + # promote Math::BigInt and its subclasses (except when already a + # Math::BigFloat) $y = $class->new($y) unless $y->isa('Math::BigFloat'); # calculate the result to $scale digits and then round it @@ -2041,80 +2178,77 @@ sub bdiv { $x->{_m} = $LIB->_div($x->{_m}, $y->{_m}); # a/c # correct exponent of $x - ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); - #($x->{_e}, $x->{_es}) - # = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $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 + ($x->{_e}, $x->{_es}) + = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+'); + $x = $x->bnorm(); # remove trailing 0's } } # end else $x != $y # shortcut to not run through _find_round_parameters again if (defined $params[0]) { delete $x->{_a}; # clear before round - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { delete $x->{_p}; # clear before round - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it - delete $x->{_a}; delete $x->{_p}; + delete $x->{_a}; + delete $x->{_p}; } if (wantarray) { if ($y_not_one) { - $x -> bfloor(); - $rem->bmod($y, @params); # copy already done + $x = $x -> bfloor(); + $rem = $rem->bmod($y, @params); # copy already done } if ($fallback) { # clear a/p after round, since user did not request it - delete $rem->{_a}; delete $rem->{_p}; + delete $rem->{_a}; + delete $rem->{_p}; } - $x = $downgrade -> new($x) + $x = $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) && $x -> is_int(); - $rem = $downgrade -> new($rem) + $rem = $downgrade -> new($rem -> bdstr(), @r) if defined($downgrade) && $rem -> is_int(); return ($x, $rem); } - $x = $downgrade -> new($x) if defined($downgrade) && $x -> is_int(); - $x; + $x = $downgrade -> new($x, @r) + if defined($downgrade) && $x -> is_int(); + $x; # rounding already done above } sub bmod { # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder # set up parameters - my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $a, $p, $r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('bmod'); # At least one argument is NaN. This is handled the same way as in # Math::BigInt -> bmod(). - if ($x -> is_nan() || $y -> is_nan()) { - return $x -> bnan(); - } + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); # Modulo zero. This is handled the same way as in Math::BigInt -> bmod(). if ($y -> is_zero()) { - return $x; + return $x -> round(@r); } # Numerator (dividend) is +/-inf. This is handled the same way as in # Math::BigInt -> bmod(). if ($x -> is_inf()) { - return $x -> bnan(); + return $x -> bnan(@r); } # Denominator (divisor) is +/-inf. This is handled the same way as in @@ -2122,20 +2256,20 @@ sub bmod { if ($y -> is_inf()) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { - return $x; + return $x -> round(@r); } else { - return $x -> binf($y -> sign()); + return $x -> binf($y -> sign(), @r); } } - return $x->bzero() if $x->is_zero() + return $x->bzero(@r) if $x->is_zero() || ($x->is_int() && # check that $y == +1 or $y == -1: ($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m}))); my $cmp = $x->bacmp($y); # equal or $x < $y? if ($cmp == 0) { # $x == $y => result 0 - return $x -> bzero($a, $p); + return $x -> bzero(@r); } # only $y of the operands negative? @@ -2143,7 +2277,7 @@ sub bmod { $x->{sign} = $y->{sign}; # calc sign first if ($cmp < 0 && $neg == 0) { # $x < $y => result $x - return $x -> round($a, $p, $r); + return $x -> round(@r); } my $ym = $LIB->_copy($y->{_m}); @@ -2158,7 +2292,8 @@ sub bmod { { # 123 % 2.5 => 1230 % 25 => 5 => 0.5 $shifty = $LIB->_num($y->{_e}); # no more digits after dot - $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25 + # 123 => 1230, $y->{_m} is already 25 + $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10); } # $ym is now mantissa of $y based on exponent 0 @@ -2184,48 +2319,60 @@ sub bmod { $x->{_m} = $LIB->_mod($x->{_m}, $ym); $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0 - $x->bnorm(); + $x = $x->bnorm(); - if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place - { + # if one of them negative => correct in place + if ($neg != 0 && ! $x -> is_zero()) { my $r = $y - $x; $x->{_m} = $r->{_m}; $x->{_e} = $r->{_e}; $x->{_es} = $r->{_es}; $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0 - $x->bnorm(); + $x = $x->bnorm(); } - $x->round($a, $p, $r, $y); # round and return + $x = $x->round($r[0], $r[1], $r[2], $y); + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); + return $x; } sub bmodpow { # takes a very large number to a very large exponent in a given very # large modulus, quickly, thanks to binary exponentiation. Supports # negative exponents. - my ($class, $num, $exp, $mod) = objectify(3, @_); + my ($class, $num, $exp, $mod, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(3, @_); return $num if $num->modify('bmodpow'); + return $num -> bnan(@r) + if $mod->is_nan() || $exp->is_nan() || $mod->is_nan(); + # check modulus for valid values - return $num->bnan() if ($mod->{sign} ne '+' # NaN, -, -inf, +inf - || $mod->is_zero()); + return $num->bnan(@r) if $mod->{sign} ne '+' || $mod->is_zero(); # check exponent for valid values if ($exp->{sign} =~ /\w/) { # i.e., if it's NaN, +inf, or -inf... - return $num->bnan(); + return $num->bnan(@r); } - $num->bmodinv ($mod) if ($exp->{sign} eq '-'); + $num = $num->bmodinv($mod, @r) if $exp->{sign} eq '-'; # check num for valid values (also NaN if there was no inverse but $exp < 0) - return $num->bnan() if $num->{sign} !~ /^[+-]$/; + return $num->bnan(@r) if $num->{sign} !~ /^[+-]$/; # $mod is positive, sign on $exp is ignored, result also positive # XXX TODO: speed it up when all three numbers are integers - $num->bpow($exp)->bmod($mod); + $num = $num->bpow($exp)->bmod($mod); + + return $downgrade -> new($num -> bdstr(), @r) if defined($downgrade) + && ($num->is_int() || $num->is_inf() || $num->is_nan()); + return $num -> round(@r); } sub bpow { @@ -2276,8 +2423,7 @@ sub bpow { # We don't support complex numbers, so upgrade or return NaN. if ($x -> is_negative() && !$y -> is_int()) { - return $upgrade -> bpow($upgrade -> new($x), $y, $a, $p, $r) - if defined $upgrade; + return $upgrade -> bpow($x, $y, $a, $p, $r) if defined $upgrade; return $x -> bnan(); } @@ -2302,19 +2448,23 @@ sub bpow { $x->{_e} = $LIB -> _mul($x->{_e}, $y1); $x->{sign} = $new_sign; - $x -> bnorm(); + $x = $x -> bnorm(); # x ** (-y) = 1 / (x ** y) if ($y->{sign} eq '-') { # modify $x in place! my $z = $x -> copy(); - $x -> bone(); + $x = $x -> bone(); # round in one go (might ignore y's A!) return scalar $x -> bdiv($z, $a, $p, $r); } - $x -> round($a, $p, $r, $y); + $x = $x -> round($a, $p, $r, $y); + + return $downgrade -> new($x) + if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); + return $x; } sub blog { @@ -2322,29 +2472,32 @@ sub blog { # value is used as the base, otherwise the base is assumed to be Euler's # constant. - my ($class, $x, $base, $a, $p, $r); + my ($class, $x, $base, @r); - # Don't objectify the base, since an undefined base, as in $x->blog() or - # $x->blog(undef) signals that the base is Euler's number. + # Only objectify the base if it is defined, since an undefined base, as in + # $x->blog() or $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) - ($class, $x, $base, $a, $p, $r) = + ($class, $x, $base, @r) = defined $_[2] ? objectify(2, @_) : objectify(1, @_); } else { # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2) - ($class, $x, $base, $a, $p, $r) = + ($class, $x, $base, @r) = defined $_[1] ? objectify(2, @_) : objectify(1, @_); } return $x if $x->modify('blog'); - return $x -> bnan() if $x -> is_nan(); + return $x -> bnan(@r) if $x -> is_nan(); + + return $upgrade -> blog($x, $base, @r) + if defined($upgrade) && $x -> is_neg(); # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale, @params); - ($x, @params) = $x->_find_round_parameters($a, $p, $r); + ($x, @params) = $x->_find_round_parameters(@r); # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -2352,7 +2505,7 @@ sub blog { $params[0] = $class->div_scale(); # and round to it as accuracy $params[1] = undef; # P = undef $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r; # round mode by caller or undef + $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not @@ -2362,28 +2515,29 @@ sub blog { my $done = 0; if (defined $base) { - $base = $class -> new($base) unless ref $base; + $base = $class -> new($base) + unless defined(blessed($base)) && $base -> isa($class); if ($base -> is_nan() || $base -> is_one()) { - $x -> bnan(); + $x = $x -> bnan(); $done = 1; } elsif ($base -> is_inf() || $base -> is_zero()) { if ($x -> is_inf() || $x -> is_zero()) { - $x -> bnan(); + $x = $x -> bnan(); } else { - $x -> bzero(@params); + $x = $x -> bzero(@params); } $done = 1; } elsif ($base -> is_negative()) { # -inf < base < 0 if ($x -> is_one()) { # x = 1 - $x -> bzero(@params); + $x = $x -> bzero(@params); } elsif ($x == $base) { - $x -> bone('+', @params); # x = base + $x = $x -> bone('+', @params); # x = base } else { - $x -> bnan(); # otherwise + $x = $x -> bnan(); # otherwise } $done = 1; } elsif ($x == $base) { - $x -> bone('+', @params); # 0 < base && 0 < x < inf + $x = $x -> bone('+', @params); # 0 < base && 0 < x < inf $done = 1; } } @@ -2393,17 +2547,17 @@ sub blog { unless ($done) { if ($x -> is_inf()) { # x = +/-inf my $sign = defined $base && $base < 1 ? '-' : '+'; - $x -> binf($sign); + $x = $x -> binf($sign); $done = 1; } elsif ($x -> is_neg()) { # -inf < x < 0 - $x -> bnan(); + $x = $x -> bnan(); $done = 1; } elsif ($x -> is_one()) { # x = 1 - $x -> bzero(@params); + $x = $x -> bzero(@params); $done = 1; } elsif ($x -> is_zero()) { # x = 0 my $sign = defined $base && $base < 1 ? '+' : '-'; - $x -> binf($sign); + $x = $x -> binf($sign); $done = 1; } } @@ -2414,69 +2568,61 @@ sub blog { delete $x->{_a}; delete $x->{_p}; } + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x->is_int(); return $x; } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too - delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion - local $Math::BigInt::upgrade = undef; - local $Math::BigFloat::downgrade = undef; - - # upgrade $x if $x is not a Math::BigFloat (handle BigInt input) - # XXX TODO: rebless! - if (!$x->isa('Math::BigFloat')) { - $x = Math::BigFloat->new($x); - $class = ref($x); - } + delete $x->{_a}; + delete $x->{_p}; $done = 0; - # If the base is defined and an integer, try to calculate integer result - # first. This is very fast, and in case the real result was found, we can - # stop right here. - if (defined $base && $base->is_int() && $x->is_int()) { - my $xint = Math::BigInt -> new($x -> bdstr()); - my $bint = Math::BigInt -> new($base -> bdstr()); - $xint->blog($bint); - - # if we found the exact result, we're done - if ($bint -> bpow($xint) == $x) { - my $xflt = Math::BigFloat -> new($xint -> bdstr()); - $x->{sign} = $xflt->{sign}; - $x->{_m} = $xflt->{_m}; - $x->{_es} = $xflt->{_es}; - $x->{_e} = $xflt->{_e}; + # If both the invocand and the base are integers, try to calculate integer + # result first. This is very fast, and in case the real result was found, we + # can stop right here. + + if (defined($base) && $base -> is_int() && $x -> is_int()) { + my $x_lib = $LIB -> _new($x -> bdstr()); + my $b_lib = $LIB -> _new($base -> bdstr()); + ($x_lib, my $exact) = $LIB -> _log_int($x_lib, $b_lib); + if ($exact) { + $x->{_m} = $x_lib; + $x->{_e} = $LIB -> _zero(); + $x = $x -> bnorm(); $done = 1; } } - if ($done == 0) { + unless ($done) { + # First calculate the log to base e (using reduction by 10 and possibly - # also by 2): - $x->_log_10($scale); + # also by 2), and if a different base was requested, convert the result. - # and if a different base was requested, convert it + $x = $x->_log_10($scale); if (defined $base) { - $base = Math::BigFloat->new($base) - unless $base->isa('Math::BigFloat'); # log_b(x) = ln(x) / ln(b), so compute ln(b) my $base_log_e = $base->copy()->_log_10($scale); - $x->bdiv($base_log_e, $scale); + $x = $x->bdiv($base_log_e, $scale); } } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -2487,25 +2633,28 @@ sub blog { $$abr = $ab; $$pbr = $pb; - $x; + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x->is_int(); + return $x; } sub bexp { # Calculate e ** X (Euler's number to the power of X) - my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bexp'); - return $x->binf() if $x->{sign} eq '+inf'; - return $x->bzero() if $x->{sign} eq '-inf'; + return $x->bnan(@r) if $x -> is_nan(); + return $x->binf(@r) if $x->{sign} eq '+inf'; + return $x->bzero(@r) if $x->{sign} eq '-inf'; # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale, @params); - ($x, @params) = $x->_find_round_parameters($a, $p, $r); + ($x, @params) = $x->_find_round_parameters(@r); - # also takes care of the "error in _find_round_parameters?" case - return $x if $x->{sign} eq 'NaN'; + # error in _find_round_parameters? + return $x->bnan(@r) if $x->{sign} eq 'NaN'; # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -2513,7 +2662,7 @@ sub bexp { $params[0] = $class->div_scale(); # and round to it as accuracy $params[1] = undef; # P = undef $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r; # round mode by caller or undef + $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it's not @@ -2531,13 +2680,21 @@ sub bexp { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + local $Math::BigInt::upgrade = undef; local $Math::BigFloat::downgrade = undef; @@ -2600,13 +2757,15 @@ sub bexp { } else { # compute A and B so that e = A / B. - # After some terms we end up with this, so we use it as a starting point: + # After some terms we end up with this, so we use it as a starting + # point: my $A = $LIB->_new("9093339520860578540197197" . "0164779391644753259799242"); my $F = $LIB->_new(42); my $step = 42; - # Compute how many steps we need to take to get $A and $B sufficiently big + # Compute how many steps we need to take to get $A and $B sufficiently + # big my $steps = _len_to_steps($scale - 4); # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; while ($step++ <= $steps) { @@ -2616,7 +2775,9 @@ sub bexp { # increment f $F = $LIB->_inc($F); } - # compute $B as factorial of $steps (this is faster than doing it manually) + + # Compute $B as factorial of $steps (this is faster than doing it + # manually) my $B = $LIB->_fac($LIB->_new($steps)); # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n"; @@ -2631,7 +2792,8 @@ sub bexp { $x->{_e} = $LIB->_new($scale); } - # $x contains now an estimate of e, with some surplus digits, so we can round + # $x contains now an estimate of e, with some surplus digits, so we can + # round if (!$x_org->is_one()) { # Reduce size of fractional part, followup with integer power of two. my $lshift = 0; @@ -2640,10 +2802,11 @@ sub bexp { } # Raise $x to the wanted power and round it. if ($lshift == 0) { - $x->bpow($x_org, @params); + $x = $x->bpow($x_org, @params); } else { my($mul, $rescale) = (1 << $lshift, $scale+1+$lshift); - $x->bpow(scalar $x_org->bdiv($mul, $rescale), $rescale)->bpow($mul, @params); + $x = $x -> bpow(scalar $x_org->bdiv($mul, $rescale), $rescale) + -> bpow($mul, @params); } } else { # else just round the already computed result @@ -2651,9 +2814,9 @@ sub bexp { delete $x->{_p}; # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } } if ($fallback) { @@ -2665,18 +2828,19 @@ sub bexp { $$abr = $ab; $$pbr = $pb; - $x; # return modified $x + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + $x; } sub bnok { # Calculate n over k (binomial coefficient or "choose" function) as integer. # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x if $x->modify('bnok'); @@ -2686,7 +2850,10 @@ sub bnok { my $xint = Math::BigInt -> new($x -> bsstr()); my $yint = Math::BigInt -> new($y -> bsstr()); - $xint -> bnok($yint); + $xint = $xint -> bnok($yint); + + return $xint if defined $downgrade; + my $xflt = Math::BigFloat -> new($xint); $x->{_m} = $xflt->{_m}; @@ -2705,15 +2872,18 @@ sub bsin { # sin = x - --- + --- - --- + --- ... # 3! 5! 7! 9! + return $x if $x->modify('bsin'); + + return $x -> bzero(@r) if $x->is_zero(); + return $x -> bnan(@r) if $x->is_nan() || $x->is_inf(); + # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale, @params); ($x, @params) = $x->_find_round_parameters(@r); - # constant object or error in _find_round_parameters? - return $x if $x->modify('bsin') || $x->is_nan(); - return $x->bnan() if $x->is_inf(); - return $x->bzero(@r) if $x->is_zero(); + # error in _find_round_parameters? + return $x->bnan(@r) if $x->is_nan(); # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -2732,26 +2902,35 @@ sub bsin { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + local $Math::BigInt::upgrade = undef; + local $Math::BigFloat::downgrade = undef; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms - $over->bmul($x); # X ^ 3 as starting value + $over = $over->bmul($x); # X ^ 3 as starting value my $sign = 1; # start with -= - my $below = $class->new(6); my $factorial = $class->new(4); + my $below = $class->new(6); + my $factorial = $class->new(4); delete $x->{_a}; delete $x->{_p}; my $limit = $class->new("1E-". ($scale-1)); - #my $steps = 0; - while (3 < 5) { + while (1) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome # anymore, so we stop: @@ -2759,22 +2938,24 @@ sub bsin { last if $next->bacmp($limit) <= 0; if ($sign == 0) { - $x->badd($next); + $x = $x->badd($next); } else { - $x->bsub($next); + $x = $x->bsub($next); } $sign = 1-$sign; # alternate # calculate things for the next term - $over->bmul($x2); # $x*$x - $below->bmul($factorial); $factorial->binc(); # n*(n+1) - $below->bmul($factorial); $factorial->binc(); # n*(n+1) + $over = $over->bmul($x2); # $x*$x + $below = $below->bmul($factorial); # n*(n+1) + $factorial = $factorial->binc(); + $below = $below -> bmul($factorial); # n*(n+1) + $factorial = $factorial->binc(); } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -2784,6 +2965,9 @@ sub bsin { # restore globals $$abr = $ab; $$pbr = $pb; + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); $x; } @@ -2822,20 +3006,23 @@ sub bcos { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too - delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion - local $Math::BigInt::upgrade = undef; + delete $x->{_a}; + delete $x->{_p}; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms my $sign = 1; # start with -= my $below = $class->new(2); my $factorial = $class->new(3); - $x->bone(); + $x = $x->bone(); delete $x->{_a}; delete $x->{_p}; @@ -2849,22 +3036,24 @@ sub bcos { last if $next->bacmp($limit) <= 0; if ($sign == 0) { - $x->badd($next); + $x = $x->badd($next); } else { - $x->bsub($next); + $x = $x->bsub($next); } $sign = 1-$sign; # alternate # calculate things for the next term - $over->bmul($x2); # $x*$x - $below->bmul($factorial); $factorial->binc(); # n*(n+1) - $below->bmul($factorial); $factorial->binc(); # n*(n+1) + $over = $over->bmul($x2); # $x*$x + $below = $below->bmul($factorial); # n*(n+1) + $factorial = $factorial -> binc(); + $below = $below->bmul($factorial); # n*(n+1) + $factorial = $factorial -> binc(); } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -2874,48 +3063,50 @@ sub bcos { # restore globals $$abr = $ab; $$pbr = $pb; + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); $x; } sub batan { # Calculate a arcus tangens of x. - - my $self = shift; - my $selfref = ref $self; - my $class = $selfref || $self; - - my (@r) = @_; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); # taylor: x^3 x^5 x^7 x^9 # atan = x - --- + --- - --- + --- ... # 3 5 7 9 + return $x if $x->modify('batan'); + + return $x -> bnan(@r) if $x->is_nan(); + # We need to limit the accuracy to protect against overflow. my $fallback = 0; my ($scale, @params); - ($self, @params) = $self->_find_round_parameters(@r); + ($x, @params) = $x->_find_round_parameters(@r); - # Constant object or error in _find_round_parameters? + # Error in _find_round_parameters? - return $self if $self->modify('batan') || $self->is_nan(); + return $x -> bnan(@r) if $x->is_nan(); - if ($self->{sign} =~ /^[+-]inf\z/) { + if ($x->{sign} =~ /^[+-]inf\z/) { # +inf result is PI/2 # -inf result is -PI/2 # calculate PI/2 my $pi = $class->bpi(@r); - # modify $self in place - $self->{_m} = $pi->{_m}; - $self->{_e} = $pi->{_e}; - $self->{_es} = $pi->{_es}; + # modify $x in place + $x->{_m} = $pi->{_m}; + $x->{_e} = $pi->{_e}; + $x->{_es} = $pi->{_es}; # -y => -PI/2, +y => PI/2 - $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+" - $self -> {_m} = $LIB->_div($self->{_m}, $LIB->_new(2)); - return $self; + $x->{sign} = substr($x->{sign}, 0, 1); # "+inf" => "+" + $x -> {_m} = $LIB->_div($x->{_m}, $LIB->_new(2)); + return $x; } - return $self->bzero(@r) if $self->is_zero(); + return $x->bzero(@r) if $x->is_zero(); # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -2933,57 +3124,67 @@ sub batan { # 1 or -1 => PI/4 # inlined is_one() && is_one('-') - if ($LIB->_is_one($self->{_m}) && $LIB->_is_zero($self->{_e})) { + if ($LIB->_is_one($x->{_m}) && $LIB->_is_zero($x->{_e})) { my $pi = $class->bpi($scale - 3); - # modify $self in place - $self->{_m} = $pi->{_m}; - $self->{_e} = $pi->{_e}; - $self->{_es} = $pi->{_es}; - # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4) - $self->{_m} = $LIB->_div($self->{_m}, $LIB->_new(4)); - return $self; + # modify $x in place + $x->{_m} = $pi->{_m}; + $x->{_e} = $pi->{_e}; + $x->{_es} = $pi->{_es}; + # leave the sign of $x alone (+1 => +PI/4, -1 => -PI/4) + $x->{_m} = $LIB->_div($x->{_m}, $LIB->_new(4)); + return $x; } # This series is only valid if -1 < x < 1, so for other x we need to # calculate PI/2 - atan(1/x): my $pi = undef; - if ($self->bacmp($self->copy()->bone) >= 0) { + if ($x->bacmp($x->copy()->bone) >= 0) { # calculate PI/2 $pi = $class->bpi($scale - 3); $pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2)); - # calculate 1/$self: - my $self_copy = $self->copy(); - # modify $self in place - $self->bone(); - $self->bdiv($self_copy, $scale); + # calculate 1/$x: + my $x_copy = $x->copy(); + # modify $x in place + $x = $x->bone(); + $x = $x->bdiv($x_copy, $scale); } my $fmul = 1; foreach (0 .. int($scale / 20)) { $fmul *= 2; - $self->bdiv($self->copy()->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4); + $x = $x->bdiv($x->copy()->bmul($x)->binc()->bsqrt($scale + 4)->binc(), + $scale + 4); } # When user set globals, they would interfere with our calculation, so # disable them and later re-enable them. no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; - # We also need to disable any set A or P on $self (_find_round_parameters + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; + # We also need to disable any set A or P on $x (_find_round_parameters # took them already into account), since these would interfere, too - delete $self->{_a}; - delete $self->{_p}; - # Need to disable $upgrade in BigInt, to avoid deep recursion. + delete $x->{_a}; + delete $x->{_p}; + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + local $Math::BigInt::upgrade = undef; + local $Math::BigFloat::downgrade = undef; - my $over = $self * $self; # X ^ 2 - my $self2 = $over->copy(); # X ^ 2; difference between terms - $over->bmul($self); # X ^ 3 as starting value + my $over = $x * $x; # X ^ 2 + my $x2 = $over->copy(); # X ^ 2; difference between terms + $over = $over->bmul($x); # X ^ 3 as starting value my $sign = 1; # start with -= my $below = $class->new(3); my $two = $class->new(2); - delete $self->{_a}; - delete $self->{_p}; + delete $x->{_a}; + delete $x->{_p}; my $limit = $class->new("1E-". ($scale-1)); #my $steps = 0; @@ -2995,55 +3196,55 @@ sub batan { last if $next->bacmp($limit) <= 0; if ($sign == 0) { - $self->badd($next); + $x = $x->badd($next); } else { - $self->bsub($next); + $x = $x->bsub($next); } $sign = 1-$sign; # alternatex # calculate things for the next term - $over->bmul($self2); # $self*$self - $below->badd($two); # n += 2 + $over = $over->bmul($x2); # $x*$x + $below = $below->badd($two); # n += 2 } - $self->bmul($fmul); + $x = $x->bmul($fmul); if (defined $pi) { - my $self_copy = $self->copy(); - # modify $self in place - $self->{_m} = $pi->{_m}; - $self->{_e} = $pi->{_e}; - $self->{_es} = $pi->{_es}; - # PI/2 - $self - $self->bsub($self_copy); + my $x_copy = $x->copy(); + # modify $x in place + $x->{_m} = $pi->{_m}; + $x->{_e} = $pi->{_e}; + $x->{_es} = $pi->{_es}; + # PI/2 - $x + $x = $x->bsub($x_copy); } # Shortcut to not run through _find_round_parameters again. if (defined $params[0]) { - $self->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $self->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # Clear a/p after round, since user did not request it. - delete $self->{_a}; - delete $self->{_p}; + delete $x->{_a}; + delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; - $self; + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x -> is_int() || $x -> is_inf()); + $x; } sub batan2 { # $y -> batan2($x) returns the arcus tangens of $y / $x. # Set up parameters. - my ($class, $y, $x, @r) = (ref($_[0]), @_); - - # Objectify is costly, so avoid it if we can. - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $y, $x, @r) = objectify(2, @_); - } + my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); # Quick exit if $y is read-only. return $y if $y -> modify('batan2'); @@ -3073,52 +3274,52 @@ sub batan2 { $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } - if ($x -> is_inf("+")) { # x = inf - if ($y -> is_inf("+")) { # y = inf - $y -> bpi($scale) -> bmul("0.25"); # pi/4 - } elsif ($y -> is_inf("-")) { # y = -inf - $y -> bpi($scale) -> bmul("-0.25"); # -pi/4 - } else { # -inf < y < inf - return $y -> bzero(@r); # 0 + if ($x -> is_inf("+")) { # x = inf + if ($y -> is_inf("+")) { # y = inf + $y = $y -> bpi($scale) -> bmul("0.25"); # pi/4 + } elsif ($y -> is_inf("-")) { # y = -inf + $y = $y -> bpi($scale) -> bmul("-0.25"); # -pi/4 + } else { # -inf < y < inf + return $y -> bzero(@r); # 0 } - } elsif ($x -> is_inf("-")) { # x = -inf - if ($y -> is_inf("+")) { # y = inf - $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi - } elsif ($y -> is_inf("-")) { # y = -inf - $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi - } elsif ($y >= 0) { # y >= 0 - $y -> bpi($scale); # pi - } else { # y < 0 - $y -> bpi($scale) -> bneg(); # -pi + } elsif ($x -> is_inf("-")) { # x = -inf + if ($y -> is_inf("+")) { # y = inf + $y = $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi + } elsif ($y -> is_inf("-")) { # y = -inf + $y = $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi + } elsif ($y >= 0) { # y >= 0 + $y = $y -> bpi($scale); # pi + } else { # y < 0 + $y = $y -> bpi($scale) -> bneg(); # -pi } - } elsif ($x > 0) { # 0 < x < inf - if ($y -> is_inf("+")) { # y = inf - $y -> bpi($scale) -> bmul("0.5"); # pi/2 - } elsif ($y -> is_inf("-")) { # y = -inf - $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 - } else { # -inf < y < inf - $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x) + } elsif ($x > 0) { # 0 < x < inf + if ($y -> is_inf("+")) { # y = inf + $y = $y -> bpi($scale) -> bmul("0.5"); # pi/2 + } elsif ($y -> is_inf("-")) { # y = -inf + $y = $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 + } else { # -inf < y < inf + $y = $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x) } - } elsif ($x < 0) { # -inf < x < 0 + } elsif ($x < 0) { # -inf < x < 0 my $pi = $class -> bpi($scale); - if ($y >= 0) { # y >= 0 - $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi + if ($y >= 0) { # y >= 0 + $y = $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi -> badd($pi); - } else { # y < 0 - $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi + } else { # y < 0 + $y = $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi -> bsub($pi); } - } else { # x = 0 - if ($y > 0) { # y > 0 - $y -> bpi($scale) -> bmul("0.5"); # pi/2 - } elsif ($y < 0) { # y < 0 - $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 - } else { # y = 0 - return $y -> bzero(@r); # 0 + } else { # x = 0 + if ($y > 0) { # y > 0 + $y = $y -> bpi($scale) -> bmul("0.5"); # pi/2 + } elsif ($y < 0) { # y < 0 + $y = $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 + } else { # y = 0 + return $y -> bzero(@r); # 0 } } - $y -> round(@r); + $y = $y -> round(@r); if ($fallback) { delete $y->{_a}; @@ -3127,31 +3328,40 @@ sub batan2 { return $y; } -############################################################################## sub bsqrt { # calculate square root - my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bsqrt'); - return $x->bnan() if $x->{sign} !~ /^\+/; # NaN, -inf or < 0 - return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf - return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one(); + # Handle trivial cases. + + return $x -> bnan(@r) if $x->is_nan(); + return $x -> binf("+", @r) if $x->{sign} eq '+inf'; + return $x -> round(@r) if $x->is_zero() || $x->is_one(); + + # We don't support complex numbers. + + if ($x -> is_neg()) { + return $upgrade -> bsqrt($x, @r) if defined($upgrade); + return $x -> bnan(@r); + } # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params, $scale); - ($x, @params) = $x->_find_round_parameters($a, $p, $r); + ($x, @params) = $x->_find_round_parameters(@r); - return $x if $x->is_nan(); # error in _find_round_parameters? + # error in _find_round_parameters? + return $x -> bnan(@r) if $x->is_nan(); # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $class->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r; # round mode by caller or undef + $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not @@ -3162,14 +3372,23 @@ sub bsqrt { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion - local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + + local $Math::BigInt::upgrade = undef; + local $Math::BigFloat::downgrade = undef; my $i = $LIB->_copy($x->{_m}); $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e}); @@ -3186,12 +3405,12 @@ sub bsqrt { $x->{_m} = $gs->{value}; $x->{_e} = $LIB->_zero(); $x->{_es} = '+'; - $x->bnorm(); + $x = $x->bnorm(); # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -3204,9 +3423,10 @@ sub bsqrt { return $x; } - # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy - # of the result by multiplying the input by 100 and then divide the integer - # result of sqrt(input) by 10. Rounding afterwards returns the real result. + # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the + # accuracy of the result by multiplying the input by 100 and then divide the + # integer result of sqrt(input) by 10. Rounding afterwards returns the real + # result. # The following steps will transform 123.456 (in $x) into 123456 (in $y1) my $y1 = $LIB->_copy($x->{_m}); @@ -3266,13 +3486,13 @@ sub bsqrt { $x->{_es} = '+'; } $x->{_m} = $y1; - $x->bnorm(); + $x = $x->bnorm(); # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -3282,6 +3502,9 @@ sub bsqrt { # restore globals $$abr = $ab; $$pbr = $pb; + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x -> is_int() || $x -> is_inf()); $x; } @@ -3289,14 +3512,24 @@ sub broot { # calculate $y'th root of $x # set up parameters - my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $a, $p, $r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('broot'); + # Handle trivial cases. + + return $x -> bnan(@r) if $x->is_nan() || $y->is_nan(); + + if ($x -> is_neg()) { + # -27 ** (1/3) = -3 + return $x -> broot($y -> copy() -> bneg(), @r) -> bneg() + if $x -> is_int() && $y -> is_int() && $y -> is_neg(); + return $upgrade -> broot($x, $y, @r) if defined $upgrade; + return $x -> bnan(@r); + } + # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || $y->{sign} !~ /^\+$/; @@ -3306,7 +3539,7 @@ sub broot { # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params, $scale); - ($x, @params) = $x->_find_round_parameters($a, $p, $r); + ($x, @params) = $x->_find_round_parameters(@r); return $x if $x->is_nan(); # error in _find_round_parameters? @@ -3315,7 +3548,7 @@ sub broot { # simulate old behaviour $params[0] = $class->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r; # round mode by caller or undef + $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not @@ -3326,14 +3559,23 @@ sub broot { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion - local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + + local $Math::BigInt::upgrade = undef; + local $Math::BigFloat::downgrade = undef; # remember sign and make $x positive, since -4 ** (1/2) => -2 my $sign = 0; @@ -3342,14 +3584,15 @@ sub broot { my $is_two = 0; if ($y->isa('Math::BigFloat')) { - $is_two = ($y->{sign} eq '+' && $LIB->_is_two($y->{_m}) && $LIB->_is_zero($y->{_e})); + $is_two = $y->{sign} eq '+' && $LIB->_is_two($y->{_m}) + && $LIB->_is_zero($y->{_e}); } else { - $is_two = ($y == 2); + $is_two = $y == 2; } # normal square root if $y == 2: if ($is_two) { - $x->bsqrt($scale+4); + $x = $x->bsqrt($scale+4); } elsif ($y->is_one('-')) { # $x ** -1 => 1/$x my $u = $class->bone()->bdiv($x, $scale); @@ -3367,30 +3610,31 @@ sub broot { $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e}); my $int = Math::BigInt->bzero(); $int->{value} = $i; - $int->broot($y->as_number()); + $int = $int->broot($y->as_number()); # if ($exact) if ($int->copy()->bpow($y) == $x) { # found result, return it $x->{_m} = $int->{value}; $x->{_e} = $LIB->_zero(); $x->{_es} = '+'; - $x->bnorm(); + $x = $x->bnorm(); $done = 1; } } if ($done == 0) { my $u = $class->bone()->bdiv($y, $scale+4); - delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts - $x->bpow($u, $scale+4); # el cheapo + delete $u->{_a}; + delete $u->{_p}; + $x = $x->bpow($u, $scale+4); # el cheapo } } - $x->bneg() if $sign == 1; + $x = $x->bneg() if $sign == 1; # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -3400,6 +3644,9 @@ sub broot { # restore globals $$abr = $ab; $$pbr = $pb; + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && ($x -> is_int() || $x -> is_inf()); $x; } @@ -3408,16 +3655,19 @@ sub bfac { # compute factorial number, modifies first argument # set up parameters - my ($class, $x, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - ($class, $x, @r) = objectify(1, @_) if !ref($x); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); # inf => inf - return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; + return $x if $x->modify('bfac'); - return $x->bnan() - if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN - ($x->{_es} ne '+')); # digits after dot? + return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-"); + return $x -> binf("+", @r) if $x->is_inf("+"); + return $x -> bone(@r) if $x->is_zero() || $x->is_one(); + + if ($x -> is_neg() || !$x -> is_int()) { + return $upgrade -> bfac($x, @r) if defined($upgrade); + return $x -> bnan(@r); + } if (! $LIB->_is_zero($x->{_e})) { $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 @@ -3425,23 +3675,30 @@ sub bfac { $x->{_es} = '+'; } $x->{_m} = $LIB->_fac($x->{_m}); # calculate factorial - $x->bnorm()->round(@r); # norm again and round result + + $x = $x->bnorm()->round(@r); # norm again and round result + + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) + && ($x -> is_int() || $x -> is_inf()); + $x; } sub bdfac { # compute double factorial # set up parameters - my ($class, $x, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - ($class, $x, @r) = objectify(1, @_) if !ref($x); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - # inf => inf - return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; + return $x if $x->modify('bdfac'); + + return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-"); + return $x -> binf("+", @r) if $x->is_inf("+"); + + if ($x <= -2 || !$x -> is_int()) { + return $upgrade -> bdfac($x, @r) if defined($upgrade); + return $x -> bnan(@r); + } - return $x->bnan() if ($x->is_nan() || - $x->{_es} ne '+'); # digits after dot? - return $x->bnan() if $x <= -2; return $x->bone() if $x <= 1; croak("bdfac() requires a newer version of the $LIB library.") @@ -3453,108 +3710,137 @@ sub bdfac { $x->{_es} = '+'; } $x->{_m} = $LIB->_dfac($x->{_m}); # calculate factorial - $x->bnorm()->round(@r); # norm again and round result + + $x = $x->bnorm()->round(@r); # norm again and round result + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x; } sub btfac { # compute triple factorial # set up parameters - my ($class, $x, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - ($class, $x, @r) = objectify(1, @_) if !ref($x); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - # inf => inf - return $x if $x->modify('btfac') || $x->{sign} eq '+inf'; + return $x if $x->modify('btfac'); + + return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-"); + return $x -> binf("+", @r) if $x->is_inf("+"); - return $x->bnan() if ($x->is_nan() || - $x->{_es} ne '+'); # digits after dot? + if ($x <= -3 || !$x -> is_int()) { + return $upgrade -> btfac($x, @r) if defined($upgrade); + return $x -> bnan(@r); + } my $k = $class -> new("3"); - return $x->bnan() if $x <= -$k; + return $x->bnan(@r) if $x <= -$k; my $one = $class -> bone(); - return $x->bone() if $x <= $one; + return $x->bone(@r) if $x <= $one; my $f = $x -> copy(); while ($f -> bsub($k) > $one) { - $x -> bmul($f); + $x = $x -> bmul($f); } - $x->round(@r); + + $x = $x->round(@r); + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x; } sub bmfac { - my ($class, $x, $k, @r) = objectify(2, @_); + my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - # inf => inf - return $x if $x->modify('bmfac') || $x->{sign} eq '+inf'; + return $x if $x->modify('bmfac'); - return $x->bnan() if ($x->is_nan() || $k->is_nan() || - $k < 1 || $x <= -$k || - $x->{_es} ne '+' || $k->{_es} ne '+'); + return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-") || !$k->is_pos(); + return $x -> binf("+", @r) if $x->is_inf("+"); - return $x->bnan() if $x <= -$k; + if ($x <= -$k || !$x -> is_int() || + ($k -> is_finite() && !$k -> is_int())) + { + return $upgrade -> bmfac($x, $k, @r) if defined($upgrade); + return $x -> bnan(@r); + } my $one = $class -> bone(); - return $x->bone() if $x <= $one; + return $x->bone(@r) if $x <= $one; my $f = $x -> copy(); while ($f -> bsub($k) > $one) { - $x -> bmul($f); + $x = $x -> bmul($f); } - $x->round(@r); + + $x = $x->round(@r); + + return $downgrade -> new($x -> bdstr(), @r) + if defined($downgrade) && $x -> is_int(); + return $x; } sub blsft { # shift left by $y (multiply by $b ** $y) # set up parameters - my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_); - } + my ($class, $x, $y, $b, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('blsft'); - return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf + + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); $b = 2 if !defined $b; $b = $class -> new($b) unless ref($b) && $b -> isa($class); + return $x -> bnan(@r) if $b -> is_nan(); - return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); + # There needs to be more checking for special cases here. Fixme! # shift by a negative amount? return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; - $x -> bmul($b -> bpow($y), $a, $p, $r, $y); + $x = $x -> bmul($b -> bpow($y), $r[0], $r[1], $r[2], $y); + + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) + && ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); + return $x; } sub brsft { # shift right by $y (divide $b ** $y) # set up parameters - my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_); - } + my ($class, $x, $y, $b, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('brsft'); - return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf + + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); + + # There needs to be more checking for special cases here. Fixme! $b = 2 if !defined $b; $b = $class -> new($b) unless ref($b) && $b -> isa($class); - - return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); + return $x -> bnan(@r) if $b -> is_nan(); # shift by a negative amount? return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; - # the following call to bdiv() will return either quotient (scalar context) - # or quotient and remainder (list context). - $x -> bdiv($b -> bpow($y), $a, $p, $r, $y); + # call bdiv() + $x = $x -> bdiv($b -> bpow($y), $r[0], $r[1], $r[2], $y); + + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade) + && ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); + return $x; } ############################################################################### @@ -3562,24 +3848,20 @@ sub brsft { ############################################################################### sub band { - my $x = shift; - my $xref = ref($x); - my $class = $xref || $x; - - croak 'band() is an instance method, not a class method' unless $xref; - croak 'Not enough arguments for band()' if @_ < 1; + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return if $x -> modify('band'); - my $y = shift; - $y = $class -> new($y) unless ref($y); - - my @r = @_; + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt - $xtmp -> band($y); - $xtmp = $class -> new($xtmp); # back to Math::BigFloat + $xtmp = $xtmp -> band($y); + return $xtmp -> round(@r) if defined $downgrade; + + $xtmp = $class -> new($xtmp); # back to Math::BigFloat $x -> {sign} = $xtmp -> {sign}; $x -> {_m} = $xtmp -> {_m}; $x -> {_es} = $xtmp -> {_es}; @@ -3589,24 +3871,20 @@ sub band { } sub bior { - my $x = shift; - my $xref = ref($x); - my $class = $xref || $x; - - croak 'bior() is an instance method, not a class method' unless $xref; - croak 'Not enough arguments for bior()' if @_ < 1; + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return if $x -> modify('bior'); - my $y = shift; - $y = $class -> new($y) unless ref($y); - - my @r = @_; + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt - $xtmp -> bior($y); - $xtmp = $class -> new($xtmp); # back to Math::BigFloat + $xtmp = $xtmp -> bior($y); + + return $xtmp -> round(@r) if defined $downgrade; + $xtmp = $class -> new($xtmp); # back to Math::BigFloat $x -> {sign} = $xtmp -> {sign}; $x -> {_m} = $xtmp -> {_m}; $x -> {_es} = $xtmp -> {_es}; @@ -3616,24 +3894,20 @@ sub bior { } sub bxor { - my $x = shift; - my $xref = ref($x); - my $class = $xref || $x; - - croak 'bxor() is an instance method, not a class method' unless $xref; - croak 'Not enough arguments for bxor()' if @_ < 1; + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return if $x -> modify('bxor'); - my $y = shift; - $y = $class -> new($y) unless ref($y); - - my @r = @_; + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt - $xtmp -> bxor($y); - $xtmp = $class -> new($xtmp); # back to Math::BigFloat + $xtmp = $xtmp -> bxor($y); + + return $xtmp -> round(@r) if defined $downgrade; + $xtmp = $class -> new($xtmp); # back to Math::BigFloat $x -> {sign} = $xtmp -> {sign}; $x -> {_m} = $xtmp -> {_m}; $x -> {_es} = $xtmp -> {_es}; @@ -3643,20 +3917,18 @@ sub bxor { } sub bnot { - my $x = shift; - my $xref = ref($x); - my $class = $xref || $x; - - croak 'bnot() is an instance method, not a class method' unless $xref; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return if $x -> modify('bnot'); - my @r = @_; + return $x -> bnan(@r) if $x -> is_nan(); my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt - $xtmp -> bnot(); - $xtmp = $class -> new($xtmp); # back to Math::BigFloat + $xtmp = $xtmp -> bnot(); + return $xtmp -> round(@r) if defined $downgrade; + + $xtmp = $class -> new($xtmp); # back to Math::BigFloat $x -> {sign} = $xtmp -> {sign}; $x -> {_m} = $xtmp -> {_m}; $x -> {_es} = $xtmp -> {_es}; @@ -3671,19 +3943,18 @@ sub bnot { sub bround { # accuracy: preserve $N digits, and overwrite the rest with 0's - my $x = shift; - my $class = ref($x) || $x; - $x = $class->new(shift) if !ref($x); - if (($_[0] || 0) < 0) { + my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + if (($a[0] || 0) < 0) { croak('bround() needs positive accuracy'); } return $x if $x->modify('bround'); - my ($scale, $mode) = $x->_scale_a(@_); + my ($scale, $mode) = $x->_scale_a(@a); if (!defined $scale) { # no-op - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3694,7 +3965,7 @@ sub bround { # round a number with A=5 to 5 digits afterwards again if (defined $x->{_a} && $x->{_a} < $scale) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3704,7 +3975,7 @@ sub bround { # never round a +-inf, NaN if ($scale <= 0 || $x->{sign} !~ /^[+-]$/) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3713,7 +3984,7 @@ sub bround { # 2: if we should keep more digits than the mantissa has, do nothing if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) { $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3721,10 +3992,10 @@ sub bround { # pass sign to bround for '+inf' and '-inf' rounding modes my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt'; - $m->bround($scale, $mode); # round mantissa - $x->{_m} = $m->{value}; # get our mantissa back - $x->{_a} = $scale; # remember rounding - delete $x->{_p}; # and clear P + $m = $m->bround($scale, $mode); # round mantissa + $x->{_m} = $m->{value}; # get our mantissa back + $x->{_a} = $scale; # remember rounding + delete $x->{_p}; # and clear P # bnorm() downgrades if necessary, so no need to check whether to downgrade. $x->bnorm(); # del trailing zeros gen. by bround() @@ -3734,15 +4005,14 @@ sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 means round to integer # expects and returns normalized numbers! - my $x = shift; - my $class = ref($x) || $x; - $x = $class->new(shift) if !ref($x); + + my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bfround'); # no-op - my ($scale, $mode) = $x->_scale_p(@_); + my ($scale, $mode) = $x->_scale_p(@p); if (!defined $scale) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3751,20 +4021,20 @@ sub bfround { if ($x->is_zero()) { $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2 - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } if ($x->{sign} !~ /^[+-]$/) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } # don't round if x already has lower precision if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3775,7 +4045,7 @@ sub bfround { # round right from the '.' if ($x->{_es} eq '+') { # e >= 0 => nothing to round - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3800,15 +4070,16 @@ sub bfround { # do not round after/right of the $dad if ($scale > $dad) { # 0.123, scale >= 3 => exit - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } # round to zero if rounding inside the $zad, but not for last zero like: - # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) + # 0.0065, scale -2, round last '0' with following '65' (scale == zad + # case) if ($scale < $zad) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x->bzero(); } @@ -3837,7 +4108,7 @@ sub bfround { $scale = 1 if $scale == 0; # shortcut if already integer if ($scale == 1 && $dbt <= $dbd) { - return $downgrade->new($x) if defined($downgrade) + return $downgrade -> new($x) if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan()); return $x; } @@ -3846,7 +4117,7 @@ sub bfround { if ($scale > $dbd) { # not enough digits before dot, so round to zero - return $downgrade->new($x) if defined($downgrade); + return $downgrade -> new($x) if defined($downgrade); return $x->bzero; } elsif ($scale == $dbd) { # maximum @@ -3858,7 +4129,7 @@ sub bfround { # pass sign to bround for rounding modes '+inf' and '-inf' my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt'; - $m->bround($scale, $mode); + $m = $m->bround($scale, $mode); $x->{_m} = $m->{value}; # get our mantissa back # bnorm() downgrades if necessary, so no need to check whether to downgrade. @@ -3871,6 +4142,8 @@ sub bfloor { return $x if $x->modify('bfloor'); + return $x -> bnan(@r) if $x -> is_nan(); + if ($x->{sign} =~ /^[+-]$/) { # if $x has digits after dot, remove them if ($x->{_es} eq '-') { @@ -3880,9 +4153,9 @@ sub bfloor { # increment if negative $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-'; } - $x->round(@r); + $x = $x->round(@r); } - return $downgrade->new($x, @r) if defined($downgrade); + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade); return $x; } @@ -3892,6 +4165,8 @@ sub bceil { return $x if $x->modify('bceil'); + return $x -> bnan(@r) if $x -> is_nan(); + # if $x has digits after dot, remove them if ($x->{sign} =~ /^[+-]$/) { if ($x->{_es} eq '-') { @@ -3904,10 +4179,10 @@ sub bceil { $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0 } } - $x->round(@r); + $x = $x->round(@r); } - return $downgrade->new($x, @r) if defined($downgrade); + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade); return $x; } @@ -3917,18 +4192,20 @@ sub bint { return $x if $x->modify('bint'); + return $x -> bnan(@r) if $x -> is_nan(); + if ($x->{sign} =~ /^[+-]$/) { # if $x has digits after the decimal point if ($x->{_es} eq '-') { - $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # remove fraction part + $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # remove frac part $x->{_e} = $LIB->_zero(); # truncate/normalize $x->{_es} = '+'; # abs e $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0 } - $x->round(@r); + $x = $x->round(@r); } - return $downgrade->new($x, @r) if defined($downgrade); + return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade); return $x; } @@ -3940,8 +4217,14 @@ sub bgcd { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object - unshift @_, __PACKAGE__ - unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i; + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } my ($class, @args) = objectify(0, @_); @@ -3961,7 +4244,11 @@ sub bgcd { last if $x -> is_one(); } - return $x -> babs(); + $x = $x -> babs(); + + return $downgrade -> new($x) + if defined $downgrade && $x->is_int(); + return $x; } sub blcm { @@ -3969,8 +4256,14 @@ sub blcm { # does not modify arguments, but returns new object # Least Common Multiple - unshift @_, __PACKAGE__ - unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i; + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } my ($class, @args) = objectify(0, @_); @@ -3983,10 +4276,14 @@ sub blcm { $y = $class -> new($y) unless ref($y) && $y -> isa($class); return $x->bnan() unless $y -> is_int(); my $gcd = $x -> bgcd($y); - $x -> bdiv($gcd) -> bmul($y); + $x = $x -> bdiv($gcd) -> bmul($y); } - return $x -> babs(); + $x = $x -> babs(); + + return $downgrade -> new($x) + if defined $downgrade && $x->is_int(); + return $x; } ############################################################################### @@ -3994,9 +4291,9 @@ sub blcm { ############################################################################### sub length { - my $x = shift; - my $class = ref($x) || $x; - $x = $class->new(shift) unless ref($x); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return 1 if $LIB->_is_zero($x->{_m}); @@ -4012,7 +4309,13 @@ sub length { sub mantissa { # return a copy of the mantissa - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + # The following line causes a lot of noise in the test suits for + # the Math-BigRat and bignum distributions. Fixme! + #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + return $x -> bnan(@r) if $x -> is_nan(); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; @@ -4020,14 +4323,19 @@ sub mantissa { return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf } my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef); - $m->bneg() if $x->{sign} eq '-'; - + $m = $m->bneg() if $x->{sign} eq '-'; $m; } sub exponent { # return a copy of the exponent - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + # The following line causes a lot of noise in the test suits for + # the Math-BigRat and bignum distributions. Fixme! + #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + return $x -> bnan(@r) if $x -> is_nan(); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; @@ -4039,32 +4347,37 @@ sub exponent { sub parts { # return a copy of both the exponent and the mantissa - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^\+//; my $se = $s; $se =~ s/^-//; - return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf + # +inf => inf and -inf, +inf => inf + return ($class->new($s), $class->new($se)); } my $m = Math::BigInt->bzero(); $m->{value} = $LIB->_copy($x->{_m}); - $m->bneg() if $x->{sign} eq '-'; + $m = $m->bneg() if $x->{sign} eq '-'; ($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e}))); } +# Parts used for scientific notation with significand/mantissa and exponent as +# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4" +# (exponent). + sub sparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("sparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # Not-a-number. - if ($self -> is_nan()) { - my $mant = $self -> copy(); # mantissa + if ($x -> is_nan()) { + my $mant = $class -> bnan(); # mantissa return $mant unless wantarray; # scalar context my $expo = $class -> bnan(); # exponent return ($mant, $expo); # list context @@ -4072,8 +4385,8 @@ sub sparts { # Infinity. - if ($self -> is_inf()) { - my $mant = $self -> copy(); # mantissa + if ($x -> is_inf()) { + my $mant = $class -> binf($x->{sign}); # mantissa return $mant unless wantarray; # scalar context my $expo = $class -> binf('+'); # exponent return ($mant, $expo); # list context @@ -4081,56 +4394,46 @@ sub sparts { # Finite number. - my $mant = $self -> copy() -> bzero(); - $mant -> {sign} = $self -> {sign}; - $mant -> {_m} = $LIB->_copy($self -> {_m}); + my $mant = $x -> copy(); + $mant->{_es} = '+'; + $mant->{_e} = $LIB->_zero(); + $mant = $downgrade -> new($mant) if defined $downgrade; return $mant unless wantarray; - my $expo = $class -> bzero(); - $expo -> {sign} = $self -> {_es}; - $expo -> {_m} = $LIB->_copy($self -> {_e}); - + my $expo = bless { sign => $x -> {_es}, + _m => $LIB->_copy($x -> {_e}), + _es => '+', + _e => $LIB->_zero(), + }, $class; + $expo = $downgrade -> new($expo) if defined $downgrade; return ($mant, $expo); } -sub nparts { - my $self = shift; - my $class = ref $self; +# Parts used for normalized notation with significand/mantissa as either 0 or a +# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as +# "1.23456789" and "4". - croak("nparts() is an instance method, not a class method") - unless $class; - - # Not-a-number. +sub nparts { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - if ($self -> is_nan()) { - my $mant = $self -> copy(); # mantissa - return $mant unless wantarray; # scalar context - my $expo = $class -> bnan(); # exponent - return ($mant, $expo); # list context - } + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - # Infinity. + # Not-a-number and Infinity. - if ($self -> is_inf()) { - my $mant = $self -> copy(); # mantissa - return $mant unless wantarray; # scalar context - my $expo = $class -> binf('+'); # exponent - return ($mant, $expo); # list context - } + return $x -> sparts() if $x -> is_nan() || $x -> is_inf(); # Finite number. - my ($mant, $expo) = $self -> sparts(); + my ($mant, $expo) = $x -> sparts(); if ($mant -> bcmp(0)) { my ($ndigtot, $ndigfrac) = $mant -> length(); my $expo10adj = $ndigtot - $ndigfrac - 1; - if ($expo10adj != 0) { - my $factor = "1e" . -$expo10adj; - $mant -> bmul($factor); + if ($expo10adj > 0) { # if mantissa is not an integer + $mant = $mant -> brsft($expo10adj, 10); return $mant unless wantarray; - $expo -> badd($expo10adj); + $expo = $expo -> badd($expo10adj); return ($mant, $expo); } } @@ -4139,113 +4442,139 @@ sub nparts { return ($mant, $expo); } +# Parts used for engineering notation with significand/mantissa as either 0 or a +# number in the semi-open interval [1,1000) and the exponent is a multiple of 3. +# E.g., "12345.6789" is returned as "12.3456789" and "3". + sub eparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("eparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # Not-a-number and Infinity. - return $self -> sparts() if $self -> is_nan() || $self -> is_inf(); + return $x -> sparts() if $x -> is_nan() || $x -> is_inf(); # Finite number. - my ($mant, $expo) = $self -> nparts(); + my ($mant, $expo) = $x -> nparts(); my $c = $expo -> copy() -> bmod(3); - $mant -> blsft($c, 10); + $mant = $mant -> blsft($c, 10); return $mant unless wantarray; - $expo -> bsub($c); + $expo = $expo -> bsub($c); return ($mant, $expo); } +# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345" +# (integer part) and "0.6789" (fraction part). + sub dparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("dparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - # Not-a-number and Infinity. + # Not-a-number. - if ($self -> is_nan() || $self -> is_inf()) { - my $int = $self -> copy(); + if ($x -> is_nan()) { + my $int = $class -> bnan(); + return $int unless wantarray; + my $frc = $class -> bzero(); # or NaN? + return ($int, $frc); + } + + # Infinity. + + if ($x -> is_inf()) { + my $int = $class -> binf($x->{sign}); return $int unless wantarray; my $frc = $class -> bzero(); return ($int, $frc); } - my $int = $self -> copy(); - my $frc = $class -> bzero(); + # Finite number. + + my $int = $x -> copy(); + my $frc; + + # If the input is an integer. + + if ($int->{_es} eq '+') { + $frc = $class -> bzero(); + } - # If the input has a fraction part. + # If the input has a fraction part - if ($int->{_es} eq '-') { + else { $int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10); $int->{_e} = $LIB -> _zero(); $int->{_es} = '+'; $int->{sign} = '+' if $LIB->_is_zero($int->{_m}); # avoid -0 - return $int unless wantarray; - $frc = $self -> copy() -> bsub($int); + $frc = $x -> copy() -> bsub($int); return ($int, $frc); } + $int = $downgrade -> new($int) if defined $downgrade; return $int unless wantarray; - return ($int, $frc); + return $int, $frc; } +# Fractional parts with the numerator and denominator as integers. E.g., +# "123.4375" is returned as "1975" and "16". + sub fparts { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("fparts() is an instance method") unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - return ($class -> bnan(), - $class -> bnan()) if $x -> is_nan(); + # NaN => NaN/NaN - return ($class -> binf($x -> sign()), - $class -> bone()) if $x -> is_inf(); + if ($x -> is_nan()) { + return $class -> bnan() unless wantarray; + return $class -> bnan(), $class -> bnan(); + } - return ($class -> bzero(), - $class -> bone()) if $x -> is_zero(); + # ±Inf => ±Inf/1 - if ($x -> {_es} eq '-') { # exponent < 0 - my $numer_lib = $LIB -> _copy($x -> {_m}); - my $denom_lib = $LIB -> _1ex($x -> {_e}); - my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib); - $numer_lib = $LIB -> _div($numer_lib, $gcd_lib); - $denom_lib = $LIB -> _div($denom_lib, $gcd_lib); - return ($class -> new($x -> {sign} . $LIB -> _str($numer_lib)), - $class -> new($LIB -> _str($denom_lib))); + if ($x -> is_inf()) { + my $numer = $class -> binf($x->{sign}); + return $numer unless wantarray; + my $denom = $class -> bone(); + return $numer, $denom; } - elsif (! $LIB -> _is_zero($x -> {_e})) { # exponent > 0 - my $numer_lib = $LIB -> _copy($x -> {_m}); - $numer_lib = $LIB -> _lsft($numer_lib, $x -> {_e}, 10); - return ($class -> new($x -> {sign} . $LIB -> _str($numer_lib)), - $class -> bone()); - } + # Finite number. - else { # exponent = 0 - return ($class -> new($x -> {sign} . $LIB -> _str($x -> {_m})), - $class -> bone()); - } + # If we get here, we know that the output is an integer. + + $class = $downgrade if defined $downgrade; + + my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e}); + my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts); + my $num = $class -> new($LIB -> _str($rat_parts[1])); + my $den = $class -> new($LIB -> _str($rat_parts[2])); + $num = $num -> bneg() if $rat_parts[0] eq "-"; + return $num unless wantarray; + return $num, $den; } +# Given "123.4375", returns "1975", since "123.4375" is "1975/16". + sub numerator { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("numerator() is an instance method") unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $class -> bnan() if $x -> is_nan(); return $class -> binf($x -> sign()) if $x -> is_inf(); return $class -> bzero() if $x -> is_zero(); + # If we get here, we know that the output is an integer. + + $class = $downgrade if defined $downgrade; + if ($x -> {_es} eq '-') { # exponent < 0 my $numer_lib = $LIB -> _copy($x -> {_m}); my $denom_lib = $LIB -> _1ex($x -> {_e}); @@ -4265,14 +4594,19 @@ sub numerator { } } +# Given "123.4375", returns "16", since "123.4375" is "1975/16". + sub denominator { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("denominator() is an instance method") unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $class -> bnan() if $x -> is_nan(); + # If we get here, we know that the output is an integer. + + $class = $downgrade if defined $downgrade; + if ($x -> {_es} eq '-') { # exponent < 0 my $numer_lib = $LIB -> _copy($x -> {_m}); my $denom_lib = $LIB -> _1ex($x -> {_e}); @@ -4294,13 +4628,19 @@ sub bstr { # (ref to BFLOAT or num_str) return num_str # Convert number from internal format to (non-scientific) string format. # internal format is always normalized (no leading zeros, "-0" => "+0") - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - if ($x->{sign} !~ /^[+-]$/) { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } + # Finite number + my $es = '0'; my $len = 1; my $cad = 0; @@ -4348,91 +4688,243 @@ sub bstr { $es; } -# Decimal notation, e.g., "12345.6789". +# Decimal notation, e.g., "12345.6789" (no exponent). sub bdstr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } + # Upgrade? + + return $upgrade -> bdstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + my $mant = $LIB->_str($x->{_m}); - my $expo = $x -> exponent(); + my $esgn = $x->{_es}; + my $eabs = $LIB -> _num($x->{_e}); + + my $uintmax = ~0; my $str = $mant; - if ($expo >= 0) { - $str .= "0" x $expo; + if ($esgn eq '+') { + + croak("The absolute value of the exponent is too large") + if $eabs > $uintmax; + + $str .= "0" x $eabs; + } else { - my $mantlen = CORE::length($mant); - my $c = $mantlen + $expo; + my $mlen = CORE::length($mant); + my $c = $mlen - $eabs; + + my $intmax = ($uintmax - 1) / 2; + croak("The absolute value of the exponent is too large") + if (1 - $c) > $intmax; + $str = "0" x (1 - $c) . $str if $c <= 0; - substr($str, $expo, 0) = '.'; + substr($str, -$eabs, 0) = '.'; } - return $x->{sign} eq '-' ? "-$str" : $str; + return $x->{sign} eq '-' ? '-' . $str : $str; } -# Scientific notation with significand/mantissa as an integer, e.g., "12345.6789" -# is written as "123456789e-4". +# Scientific notation with significand/mantissa and exponent as integers, e.g., +# "12345.6789" is written as "123456789e-4". sub bsstr { - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } - my $str = $LIB->_str($x->{_m}) . 'e' . $x->{_es}. $LIB->_str($x->{_e}); - return $x->{sign} eq '-' ? "-$str" : $str; + # Upgrade? + + return $upgrade -> bsstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{_m}) + . 'e' . $x->{_es} . $LIB->_str($x->{_e}); } # Normalized notation, e.g., "12345.6789" is written as "1.23456789e+4". sub bnstr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } - my ($mant, $expo) = $x -> nparts(); + # Upgrade? + + return $upgrade -> bnstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + my $str = $x->{sign} eq '-' ? '-' : ''; + + # Get the mantissa and the length of the mantissa. + + my $mant = $LIB->_str($x->{_m}); + my $mantlen = CORE::length($mant); + + if ($mantlen == 1) { + + # Not decimal point when the mantissa has length one, i.e., return the + # number 2 as the string "2", not "2.". + + $str .= $mant . 'e' . $x->{_es} . $LIB->_str($x->{_e}); - my $esgn = $expo < 0 ? '-' : '+'; - my $eabs = $expo -> babs() -> bfround(0) -> bstr(); - #$eabs = '0' . $eabs if length($eabs) < 2; + } else { + + # Compute new exponent where the original exponent is adjusted by the + # length of the mantissa minus one (because the decimal point is after + # one digit). + + my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es}, + $LIB -> _new($mantlen - 1), "+"); + substr $mant, 1, 0, "."; + $str .= $mant . 'e' . $esgn . $LIB->_str($eabs); - return $mant . 'e' . $esgn . $eabs; + } + + return $str; } # Engineering notation, e.g., "12345.6789" is written as "12.3456789e+3". sub bestr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } - my ($mant, $expo) = $x -> eparts(); + # Upgrade? + + return $upgrade -> bestr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + my $str = $x->{sign} eq '-' ? '-' : ''; - my $esgn = $expo < 0 ? '-' : '+'; - my $eabs = $expo -> babs() -> bfround(0) -> bstr(); - #$eabs = '0' . $eabs if length($eabs) < 2; + # Get the mantissa, the length of the mantissa, and adjust the exponent by + # the length of the mantissa minus 1 (because the dot is after one digit). - return $mant . 'e' . $esgn . $eabs; + my $mant = $LIB->_str($x->{_m}); + my $mantlen = CORE::length($mant); + my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es}, + $LIB -> _new($mantlen - 1), "+"); + + my $dotpos = 1; + my $mod = $LIB -> _mod($LIB -> _copy($eabs), $LIB -> _new("3")); + unless ($LIB -> _is_zero($mod)) { + if ($esgn eq '+') { + $eabs = $LIB -> _sub($eabs, $mod); + $dotpos += $LIB -> _num($mod); + } else { + my $delta = $LIB -> _sub($LIB -> _new("3"), $mod); + $eabs = $LIB -> _add($eabs, $delta); + $dotpos += $LIB -> _num($delta); + } + } + + if ($dotpos < $mantlen) { + substr $mant, $dotpos, 0, "."; + } elsif ($dotpos > $mantlen) { + $mant .= "0" x ($dotpos - $mantlen); + } + + $str .= $mant . 'e' . $esgn . $LIB->_str($eabs); + + return $str; +} + +# Fractional notation, e.g., "123.4375" is written as "1975/16". + +sub bfstr { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> bfstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + my $str = $x->{sign} eq '-' ? '-' : ''; + + if ($x->{_es} eq '+') { + $str .= $LIB -> _str($x->{_m}) . ("0" x $LIB -> _num($x->{_e})); + } else { + my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e}); + my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts); + $str = $LIB -> _str($rat_parts[1]) . "/" . $LIB -> _str($rat_parts[2]); + $str = "-" . $str if $rat_parts[0] eq "-"; + } + + return $str; } sub to_hex { # return number as hexadecimal string (only for integers defined) + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_hex($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex? @@ -4447,10 +4939,24 @@ sub to_hex { sub to_oct { # return number as octal digit string (only for integers defined) + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_hex($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal? @@ -4465,10 +4971,24 @@ sub to_oct { sub to_bin { # return number as binary digit string (only for integers defined) + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_hex($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary? @@ -4482,9 +5002,9 @@ sub to_bin { } sub to_ieee754 { - my $x = shift; - my $format = shift; - my $class = ref $x; + my ($class, $x, $format, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; my $enc; # significand encoding (applies only to decimal) my $k; # storage width in bits @@ -4621,22 +5141,22 @@ sub to_ieee754 { $expo = $class -> new($expo_est); if ($expo_est > 0) { - $mant -> bmul($binv -> copy() -> bpow($expo)); + $mant = $mant -> bmul($binv -> copy() -> bpow($expo)); } elsif ($expo_est < 0) { my $expo_abs = $expo -> copy() -> bneg(); - $mant -> bmul($b -> copy() -> bpow($expo_abs)); + $mant = $mant -> bmul($b -> copy() -> bpow($expo_abs)); } # Final adjustment of the estimate above. while ($mant >= $b && $expo <= $emax) { - $mant -> bmul($binv); - $expo -> binc(); + $mant = $mant -> bmul($binv); + $expo = $expo -> binc(); } while ($mant < $one && $expo >= $emin) { - $mant -> bmul($b); - $expo -> bdec(); + $mant = $mant -> bmul($b); + $expo = $expo -> bdec(); } # This is when the magnitude is larger than what can be represented @@ -4664,15 +5184,15 @@ sub to_ieee754 { # Scale up the mantissa (significand), and round to integer. my $const = $class -> new($b) -> bpow($t - 1); - $mant -> bmul($const); - $mant -> bfround(0); + $mant = $mant -> bmul($const); + $mant = $mant -> bfround(0); # If the mantissa overflowed, encode as the smallest normal # number. if ($mant == $const -> bmul($b)) { - $mant -> bzero(); - $expo -> binc(); + $mant = $mant -> bzero(); + $expo = $expo -> binc(); } } @@ -4684,22 +5204,22 @@ sub to_ieee754 { # Remove implicit leading bit, scale up the mantissa # (significand) to an integer, and round. - $mant -> bdec(); + $mant = $mant -> bdec(); my $const = $class -> new($b) -> bpow($t); - $mant -> bmul($const) -> bfround(0); + $mant = $mant -> bmul($const) -> bfround(0); # If the mantissa overflowed, encode as the next larger value. # This works correctly also when the next larger value is # infinity. if ($mant == $const) { - $mant -> bzero(); - $expo -> binc(); + $mant = $mant -> bzero(); + $expo = $expo -> binc(); } } } - $expo -> badd($bias); # add bias + $expo = $expo -> badd($bias); # add bias my $signbit = "$sign"; @@ -4719,7 +5239,9 @@ sub to_ieee754 { sub as_hex { # return number as hexadecimal string (only for integers defined) - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0x0' if $x->is_zero(); @@ -4737,7 +5259,9 @@ sub as_hex { sub as_oct { # return number as octal digit string (only for integers defined) - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '00' if $x->is_zero(); @@ -4755,7 +5279,9 @@ sub as_oct { sub as_bin { # return number as binary digit string (only for integers defined) - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0b0' if $x->is_zero(); @@ -4772,7 +5298,10 @@ sub as_bin { sub numify { # Make a Perl scalar number from a Math::BigFloat object. - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + + my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; if ($x -> is_nan()) { require Math::Complex; @@ -4787,6 +5316,7 @@ sub numify { } # Create a string and let Perl's atoi()/atof() handle the rest. + return 0 + $x -> bnstr(); } @@ -4904,17 +5434,20 @@ sub _len_to_steps { my $l = 40; my $r = $d; - # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :( + # Otherwise this does not work under -Mbignum and we do not yet have "no + # bignum;" :( $l = $l->numify if ref($l); $r = $r->numify if ref($r); $lg2 = $lg2->numify if ref($lg2); $lg10 = $lg10->numify if ref($lg10); - # binary search for the right value (could this be written as the reverse of lg(n!)?) + # binary search for the right value (could this be written as the reverse of + # lg(n!)?) while ($r - $l > 1) { my $n = int(($r - $l) / 2) + $l; - my $ramanujan = - int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2) / $lg10); + my $ramanujan + = int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2) + / $lg10); $ramanujan > $d ? $r = $n : $l = $n; } $l; @@ -4948,15 +5481,19 @@ sub _log { my ($limit, $v, $u, $below, $factor, $next, $over, $f); - $v = $x->copy(); $v->binc(); # v = x+1 - $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1 - $x->bdiv($v, $scale); # first term: u/v + $v = $x->copy(); + $v = $v -> binc(); # v = x+1 + $x = $x->bdec(); + $u = $x->copy(); # u = x-1; x = x-1 + $x = $x->bdiv($v, $scale); # first term: u/v $below = $v->copy(); $over = $u->copy(); - $u *= $u; $v *= $v; # u^2, v^2 - $below->bmul($v); # u^3, v^3 - $over->bmul($u); - $factor = $class->new(3); $f = $class->new(2); + $u = $u -> bmul($u); # u^2 + $v = $v -> bmul($v); # v^2 + $below = $below->bmul($v); # u^3, v^3 + $over = $over->bmul($u); + $factor = $class->new(3); + $f = $class->new(2); $limit = $class->new("1E-". ($scale-1)); @@ -4972,27 +5509,24 @@ sub _log { # round $over and $below first, we save a lot of time for the division # (not with log(1.2345), but try log (123**123) to see what I mean. This # can introduce a rounding error if the division result would be f.i. - # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but - # if we truncated $over and $below we might get 0.12345. Does this matter - # for the end result? So we give $over and $below 4 more digits to be - # on the safe side (unscientific error handling as usual... :+D + # 0.1234500000001 and we round it to 5 digits it would become 0.12346, + # but if we truncated $over and $below we might get 0.12345. Does this + # matter for the end result? So we give $over and $below 4 more digits + # to be on the safe side (unscientific error handling as usual... :+D $next = $over->copy()->bround($scale+4) ->bdiv($below->copy()->bmul($factor)->bround($scale+4), $scale); - ## old version: - ## $next = $over->copy()->bdiv($below->copy()->bmul($factor), $scale); - last if $next->bacmp($limit) <= 0; delete $next->{_a}; delete $next->{_p}; - $x->badd($next); + $x = $x->badd($next); # calculate things for the next term $over *= $u; $below *= $v; - $factor->badd($f); + $factor = $factor->badd($f); } $x->bmul($f); # $x *= 2 } @@ -5011,9 +5545,9 @@ sub _log_10 { # long, we make it faster by about a factor of 100 by dividing $x by 10. # The same observation is valid for numbers smaller than 0.1, e.g. computing - # log(1) is fastest, and the further away we get from 1, the longer it takes. - # So we also 'break' this down by multiplying $x with 10 and subtract the - # log(10) afterwards to get the correct result. + # log(1) is fastest, and the further away we get from 1, the longer it + # takes. So we also 'break' this down by multiplying $x with 10 and subtract + # the log(10) afterwards to get the correct result. # To get $x even closer to 1, we also divide by 2 and then use log(2) to # correct for this. For instance if $x is 2.4, we use the formula: @@ -5044,8 +5578,8 @@ sub _log_10 { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_10_A) { - $x->bzero(); - $x->badd($LOG_10); # modify $x in place + $x = $x->bzero(); + $x = $x->badd($LOG_10); # modify $x in place $calc = 0; # no need to calc, but round } # if we can't use the shortcut, we continue normally @@ -5057,8 +5591,8 @@ sub _log_10 { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_2_A) { - $x->bzero(); - $x->badd($LOG_2); # modify $x in place + $x = $x->bzero(); + $x = $x->badd($LOG_2); # modify $x in place $calc = 0; # no need to calc, but round } # if we can't use the shortcut, we continue normally @@ -5074,8 +5608,8 @@ sub _log_10 { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_10_A) { - $x->bzero(); - $x->bsub($LOG_10); + $x = $x->bzero(); + $x = $x->bsub($LOG_10); $calc = 0; # no need to calc, but round } } @@ -5096,8 +5630,8 @@ sub _log_10 { $LOG_10 = $class->new($LOG_10, undef, undef) unless ref $LOG_10; #print "x = $x, dbd = $dbd, calc = $calc\n"; - # got more than one digit before the dot, or more than one zero after the - # dot, so do: + # got more than one digit before the dot, or more than one zero after + # the dot, so do: # log(123) == log(1.23) + log(10) * 2 # log(0.0123) == log(1.23) - log(10) * 2 @@ -5106,7 +5640,12 @@ sub _log_10 { $l_10 = $LOG_10->copy(); # copy for mul } else { # else: slower, compute and cache result - # also disable downgrade for this code path + + # Disabling upgrading and downgrading is no longer necessary to + # avoid an infinite recursion, but it avoids unnecessary upgrading + # and downgrading in the intermediate computations. + + local $Math::BigInt::upgrade = undef; local $Math::BigFloat::downgrade = undef; # shorten the time to calculate log(10) based on the following: @@ -5121,7 +5660,7 @@ sub _log_10 { } else { # else: slower, compute and cache result $l_2 = $two->copy(); - $l_2->_log($scale); # scale+4, actually + $l_2 = $l_2->_log($scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; @@ -5129,27 +5668,25 @@ sub _log_10 { # now calculate log(1.25): $l_10 = $class->new('1.25'); - $l_10->_log($scale); # scale+4, actually + $l_10 = $l_10->_log($scale); # scale+4, actually # log(1.25) + log(2) + log(2) + log(2): - $l_10->badd($l_2); - $l_10->badd($l_2); - $l_10->badd($l_2); + $l_10 = $l_10->badd($l_2); + $l_10 = $l_10->badd($l_2); + $l_10 = $l_10->badd($l_2); $LOG_10 = $l_10->copy(); # cache the result for later # the copy() is for mul below $LOG_10_A = $scale; } $dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1 - $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1) + $l_10 = $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1) my $dbd_sign = '+'; if ($dbd < 0) { $dbd = -$dbd; $dbd_sign = '-'; } ($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); + $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign); } # Now: 0.1 <= $x < 10 (and possible correction in l_10) @@ -5162,13 +5699,13 @@ sub _log_10 { my $twos = 0; # default: none (0 times) while ($x->bacmp($HALF) <= 0) { # X <= 0.5 $twos--; - $x->bmul($two); + $x = $x->bmul($two); } while ($x->bacmp($two) >= 0) { # X >= 2 $twos++; - $x->bdiv($two, $scale+4); # keep all digits + $x = $x->bdiv($two, $scale+4); # keep all digits } - $x->bround($scale+4); + $x = $x->bround($scale+4); # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both) # So calculate correction factor based on ln(2): if ($twos != 0) { @@ -5178,70 +5715,33 @@ sub _log_10 { $l_2 = $LOG_2->copy(); # copy() for the mul below } else { # else: slower, compute and cache result - # also disable downgrade for this code path + + # Disabling upgrading and downgrading is no longer necessary to + # avoid an infinite recursion, but it avoids unnecessary upgrading + # and downgrading in the intermediate computations. + + local $Math::BigInt::upgrade = undef; local $Math::BigFloat::downgrade = undef; + $l_2 = $two->copy(); - $l_2->_log($scale); # scale+4, actually + $l_2 = $l_2->_log($scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; } - $l_2->bmul($twos); # * -2 => subtract, * 2 => add + $l_2 = $l_2->bmul($twos); # * -2 => subtract, * 2 => add } else { undef $l_2; } - $x->_log($scale); # need to do the "normal" way - $x->badd($l_10) if defined $l_10; # correct it by ln(10) - $x->badd($l_2) if defined $l_2; # and maybe by ln(2) + $x = $x->_log($scale); # need to do the "normal" way + $x = $x->badd($l_10) if defined $l_10; # correct it by ln(10) + $x = $x->badd($l_2) if defined $l_2; # and maybe by ln(2) # all done, $x contains now the result $x; } -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 _pow { # Calculate a power where $y is a non-integer, like 2 ** 0.3 my ($x, $y, @r) = @_; @@ -5284,23 +5784,32 @@ sub _pow { # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; - my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; - my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; + my $abr = "$class\::accuracy"; + my $ab = $$abr; + $$abr = undef; + my $pbr = "$class\::precision"; + my $pb = $$pbr; + $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; - # need to disable $upgrade in BigInt, to avoid deep recursion + + # Disabling upgrading and downgrading is no longer necessary to avoid an + # infinite recursion, but it avoids unnecessary upgrading and downgrading in + # the intermediate computations. + local $Math::BigInt::upgrade = undef; + local $Math::BigFloat::downgrade = undef; my ($limit, $v, $u, $below, $factor, $next, $over); $u = $x->copy()->blog(undef, $scale)->bmul($y); my $do_invert = ($u->{sign} eq '-'); - $u->bneg() if $do_invert; + $u = $u->bneg() if $do_invert; $v = $class->bone(); # 1 $factor = $class->new(2); # 2 - $x->bone(); # first term: 1 + $x = $x->bone(); # first term: 1 $below = $v->copy(); $over = $u->copy(); @@ -5312,25 +5821,25 @@ sub _pow { # anymore, so we stop: $next = $over->copy()->bdiv($below, $scale); last if $next->bacmp($limit) <= 0; - $x->badd($next); + $x = $x->badd($next); # calculate things for the next term $over *= $u; $below *= $factor; - $factor->binc(); + $factor = $factor->binc(); last if $x->{sign} !~ /^[-+]$/; } if ($do_invert) { my $x_copy = $x->copy(); - $x->bone->bdiv($x_copy, $scale); + $x = $x->bone->bdiv($x_copy, $scale); } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { - $x->bround($params[0], $params[2]); # then round accordingly + $x = $x->bround($params[0], $params[2]); # then round accordingly } else { - $x->bfround($params[1], $params[2]); # then round accordingly + $x = $x->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it @@ -5343,6 +5852,19 @@ sub _pow { $x; } +# These functions are only provided for backwards compabibility so that old +# version of Math::BigRat etc. don't complain about missing them. + +sub _e_add { + my ($x, $y, $xs, $ys) = @_; + return $LIB -> _sadd($x, $xs, $y, $ys); +} + +sub _e_sub { + my ($x, $y, $xs, $ys) = @_; + return $LIB -> _ssub($x, $xs, $y, $ys); +} + 1; __END__ @@ -5395,6 +5917,8 @@ Math::BigFloat - arbitrary size floating point math package $y = $x->copy(); # make a copy (unlike $y = $x) $y = $x->as_int(); # return as BigInt + $y = $x->as_float(); # return as a Math::BigFloat + $y = $x->as_rat(); # return as a Math::BigRat # Boolean methods (these don't modify the invocand) @@ -5516,6 +6040,8 @@ Math::BigFloat - arbitrary size floating point math package $x->bnstr(); # string in normalized notation $x->bestr(); # string in engineering notation $x->bdstr(); # string in decimal notation + $x->bfstr(); # string in fractional notation + $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b $x->as_oct(); # as signed octal string with prefixed 0 @@ -5921,10 +6447,11 @@ supplied to the operation after the I<scale>: Math::BigFloat->round_mode('zero'); $y = $x->copy()->bdiv(3,6); # will also give 0.666667 -Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >> -set the global variables, and thus B<any> newly created number will be subject -to the global rounding B<immediately>. This means that in the examples above, the -C<3> as argument to C<bdiv()> will also get an accuracy of B<5>. +Note that C<< Math::BigFloat->accuracy() >> and +C<< Math::BigFloat->precision() >> set the global variables, and thus B<any> +newly created number will be subject to the global rounding B<immediately>. This +means that in the examples above, the C<3> as argument to C<bdiv()> will also +get an accuracy of B<5>. It is less confusing to either calculate the result fully, and afterwards round it explicitly, or use the additional parameters to the math @@ -6103,7 +6630,8 @@ math library for directly storing the number parts. =head1 EXPORTS -C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> method: +C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> +method: use Math::BigFloat qw/bpi/; @@ -6178,7 +6706,8 @@ a certain number of digits: print "$z\n"; print $z->precision(),"\n"; # 4 -Replacing L</precision()> with L</accuracy()> is probably not what you want, either: +Replacing L</precision()> with L</accuracy()> is probably not what you want, +either: use Math::BigFloat; diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 489dbb6ce5..65e14467bb 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -21,9 +21,9 @@ use strict; use warnings; use Carp qw< carp croak >; -use Scalar::Util qw< blessed >; +use Scalar::Util qw< blessed refaddr >; -our $VERSION = '1.999830'; +our $VERSION = '1.999837'; $VERSION =~ tr/_//d; require Exporter; @@ -58,7 +58,6 @@ use overload '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) : $_[0] -> copy() -> bmod($_[1]); }, - '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) : $_[0] -> copy() -> bpow($_[1]); }, @@ -216,7 +215,8 @@ use overload # These vars are public, but their direct usage is not recommended, use the # accessor methods instead -our $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common' +# $round_mode is 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', or 'common'. +our $round_mode = 'even'; our $accuracy = undef; our $precision = undef; our $div_scale = 40; @@ -262,9 +262,9 @@ BEGIN { tie $rnd_mode, 'Math::BigInt'; # set up some handy alias names - *as_int = \&as_number; *is_pos = \&is_positive; *is_neg = \&is_negative; + *as_number = \&as_int; } ############################################################################### @@ -297,6 +297,7 @@ sub upgrade { # make Class->upgrade() work my $self = shift; my $class = ref($self) || $self || __PACKAGE__; + # need to set new value? if (@_ > 0) { return ${"${class}::upgrade"} = $_[0]; @@ -361,11 +362,11 @@ sub accuracy { if (ref($x)) { # Set instance variable. - $x->bround($a) if $a; # not for undef, 0 + $x = $x->bround($a) if $a; # not for undef, 0 $x->{_a} = $a; # set/overwrite, even if not rounded delete $x->{_p}; # clear P # Why return class variable here? Fixme! - $a = ${"${class}::accuracy"} unless defined $a; # proper return value + $a = ${"${class}::accuracy"} unless defined $a; } else { # Set class variable. ${"${class}::accuracy"} = $a; # set global A @@ -376,7 +377,7 @@ sub accuracy { } # Return instance variable. - return $x->{_a} if ref($x) && (defined $x->{_a} || defined $x->{_p}); + return $x->{_a} if ref($x) && (defined($x->{_a}) || defined($x->{_p})); # Return class variable. return ${"${class}::accuracy"}; @@ -403,11 +404,11 @@ sub precision { if (ref($x)) { # Set instance variable. - $x->bfround($p) if $p; # not for undef, 0 + $x = $x->bfround($p) if $p; # not for undef, 0 $x->{_p} = $p; # set/overwrite, even if not rounded delete $x->{_a}; # clear A # Why return class variable here? Fixme! - $p = ${"${class}::precision"} unless defined $p; # proper return value + $p = ${"${class}::precision"} unless defined $p; } else { # Set class variable. ${"${class}::precision"} = $p; # set global P @@ -418,7 +419,7 @@ sub precision { } # Return instance variable. - return $x->{_p} if ref($x) && (defined $x->{_a} || defined $x->{_p}); + return $x->{_p} if ref($x) && (defined($x->{_a}) || defined($x->{_p})); # Return class variable. return ${"${class}::precision"}; @@ -551,26 +552,22 @@ sub new { $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. + # Calling new() with no input arguments has been discouraged for more than + # 10 years, but people apparently still use it, so we still support it. return $class -> bzero() unless @_; my ($wanted, @r) = @_; if (!defined($wanted)) { - #if (warnings::enabled("uninitialized")) { - # warnings::warn("uninitialized", - # "Use of uninitialized value in new()"); - #} + #carp("Use of uninitialized value in new()") + # if warnings::enabled("uninitialized"); return $class -> bzero(@r); } if (!ref($wanted) && $wanted eq "") { - #if (warnings::enabled("numeric")) { - # warnings::warn("numeric", - # q|Argument "" isn't numeric in new()|); - #} + #carp(q|Argument "" isn't numeric in new()|) + # if warnings::enabled("numeric"); #return $class -> bzero(@r); return $class -> bnan(@r); } @@ -583,48 +580,60 @@ sub new { 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. + # 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]); + $self = $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 ($wanted =~ / ^ - ([+-]?) # optional sign - ([1-9][0-9]*) # non-zero significand - (\.0*)? # ... with optional zero fraction - ([Ee][+-]?0+)? # optional zero exponent - \z - /x) + if ($wanted =~ + / ^ + ( [+-]? ) # optional sign + ( [1-9] [0-9]* ) # non-zero significand + ( \.0* )? # ... with optional zero fraction + ( [Ee] [+-]? 0+ )? # optional zero exponent + \z + /x) { my $sgn = $1; my $abs = $2; $self->{sign} = $sgn || '+'; $self->{value} = $LIB->_new($abs); - $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + $self = $self->round(@r); return $self; } # Handle Infs. - if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { + if ($wanted =~ / ^ + \s* + ( [+-]? ) + inf (?: inity )? + \s* + \z + /ix) + { my $sgn = $1 || '+'; - $self = $class -> binf($sgn); - $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); - return $self; + return $class -> binf($sgn, @r); } # Handle explicit NaNs (not the ones returned due to invalid input). - if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { - $self = $class -> bnan(); - $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); - return $self; + if ($wanted =~ / ^ + \s* + ( [+-]? ) + nan + \s* + \z + /ix) + { + return $class -> bnan(@r); } my @parts; @@ -634,7 +643,7 @@ sub new { # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Xx]/ and - @parts = $class -> _hex_str_to_lib_parts($wanted) + @parts = $class -> _hex_str_to_flt_lib_parts($wanted) or @@ -642,7 +651,7 @@ sub new { # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Oo]/ and - @parts = $class -> _oct_str_to_lib_parts($wanted) + @parts = $class -> _oct_str_to_flt_lib_parts($wanted) or @@ -650,7 +659,7 @@ sub new { # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). $wanted =~ /^\s*[+-]?0?[Bb]/ and - @parts = $class -> _bin_str_to_lib_parts($wanted) + @parts = $class -> _bin_str_to_flt_lib_parts($wanted) or @@ -658,38 +667,38 @@ sub new { # 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) + @parts = $class -> _dec_str_to_flt_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., + # included because _oct_str_to_flt_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)) + @parts = $class -> _oct_str_to_flt_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]); + $self = $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. + # The value is not an integer, so upgrade if upgrading is enabled. return $upgrade -> new($wanted, @r) if defined $upgrade; - return $class -> bnan(); } # 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(); + return $class -> bnan(@r); } # Create a Math::BigInt from a decimal string. This is an equivalent to @@ -703,16 +712,16 @@ sub from_dec { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_dec'); + return $self 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; + $self = $class -> bzero(@r) unless $selfref; - if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { # The value is an integer iff the exponent is non-negative. @@ -722,6 +731,8 @@ sub from_dec { return $self -> round(@r); } + # The value is not an integer, so upgrade if upgrading is enabled. + return $upgrade -> new($str, @r) if defined $upgrade; } @@ -737,16 +748,16 @@ sub from_hex { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_hex'); + return $self 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; + $self = $class -> bzero(@r) unless $selfref; - if (my @parts = $class -> _hex_str_to_lib_parts($str)) { + if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) { # The value is an integer iff the exponent is non-negative. @@ -756,6 +767,8 @@ sub from_hex { return $self -> round(@r); } + # The value is not an integer, so upgrade if upgrading is enabled. + return $upgrade -> new($str, @r) if defined $upgrade; } @@ -771,16 +784,16 @@ sub from_oct { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_oct'); + return $self 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; + $self = $class -> bzero(@r) unless $selfref; - if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { # The value is an integer iff the exponent is non-negative. @@ -790,6 +803,8 @@ sub from_oct { return $self -> round(@r); } + # The value is not an integer, so upgrade if upgrading is enabled. + return $upgrade -> new($str, @r) if defined $upgrade; } @@ -805,16 +820,16 @@ sub from_bin { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_bin'); + return $self 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; + $self = $class -> bzero(@r) unless $selfref; - if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { # The value is an integer iff the exponent is non-negative. @@ -824,6 +839,8 @@ sub from_bin { return $self -> round(@r); } + # The value is not an integer, so upgrade if upgrading is enabled. + return $upgrade -> new($str, @r) if defined $upgrade; } @@ -839,7 +856,7 @@ sub from_bytes { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_bytes'); + return $self if $selfref && $self->modify('from_bytes'); croak("from_bytes() requires a newer version of the $LIB library.") unless $LIB->can('_from_bytes'); @@ -849,7 +866,7 @@ sub from_bytes { # If called as a class method, initialize a new object. - $self = $class -> bzero() unless $selfref; + $self = $class -> bzero(@r) unless $selfref; $self -> {sign} = '+'; $self -> {value} = $LIB -> _from_bytes($str); return $self -> round(@r); @@ -862,11 +879,10 @@ sub from_base { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_base'); + return $self if $selfref && $self->modify('from_base'); - my $str = shift; + my ($str, $base, $cs, @r) = @_; # $cs is the collation sequence - my $base = shift; $base = $class->new($base) unless ref($base); croak("the base must be a finite integer >= 2") @@ -879,14 +895,15 @@ sub from_base { # If no collating sequence is given, pass some of the conversions to # methods optimized for those cases. - if (! @_) { - return $self -> from_bin($str) if $base == 2; - return $self -> from_oct($str) if $base == 8; - return $self -> from_hex($str) if $base == 16; + unless (defined $cs) { + return $self -> from_bin($str, @r) if $base == 2; + return $self -> from_oct($str, @r) if $base == 8; + return $self -> from_hex($str, @r) if $base == 16; if ($base == 10) { - my $tmp = $class -> new($str); + my $tmp = $class -> from_dec($str, @r); $self -> {value} = $tmp -> {value}; $self -> {sign} = '+'; + return $self -> bround(@r); } } @@ -895,8 +912,8 @@ sub from_base { $self -> {sign} = '+'; $self -> {value} - = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ()); - return $self; + = $LIB->_from_base($str, $base -> {value}, defined($cs) ? $cs : ()); + return $self -> bround(@r); } sub from_base_num { @@ -906,7 +923,7 @@ sub from_base_num { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('from_base_num'); + return $self if $selfref && $self->modify('from_base_num'); # Make sure we have an array of non-negative, finite, numerical objects. @@ -929,7 +946,7 @@ sub from_base_num { # If called as a class method, initialize a new object. - $self = $class -> bzero() unless $selfref; + $self = $class -> bzero(@r) unless $selfref; croak("from_base_num() requires a newer version of the $LIB library.") unless $LIB->can('_from_base_num'); @@ -944,9 +961,12 @@ sub from_base_num { sub bzero { # create/assign '+0' - if (@_ == 0) { - #carp("Using bzero() as a function is deprecated;", - # " use bzero() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -958,7 +978,13 @@ sub bzero { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('bzero'); + return $self if $selfref && $self->modify('bzero'); + + # Get the rounding parameters, if any. + + my @r = @_; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -966,19 +992,17 @@ sub bzero { $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 + # parameters are given, and if called as a class method, initialize the new # instance with the class variables. - if (@_) { + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); $self->{_a} = $_[0]; $self->{_p} = $_[1]; - } else { - unless($selfref) { - $self->{_a} = $class -> accuracy(); - $self->{_p} = $class -> precision(); - } + } elsif (!$selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } return $self; @@ -987,9 +1011,12 @@ sub bzero { sub bone { # Create or assign '+1' (or -1 if given sign '-'). - if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - #carp("Using bone() as a function is deprecated;", - # " use bone() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -1001,33 +1028,38 @@ sub bone { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('bone'); + return $self if $selfref && $self->modify('bone'); + + my ($sign, @r) = @_; - my $sign = '+'; # default - if (@_) { - $sign = shift; - $sign = $sign =~ /^\s*-/ ? "-" : "+"; + # Get the sign. + + if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) { + $sign = $1; + shift; + } else { + $sign = '+'; } + # If called as a class method, initialize a new object. + $self = bless {}, $class unless $selfref; $self->{sign} = $sign; $self->{value} = $LIB->_one(); # 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 + # parameters are given, and if called as a class method, initialize the new # instance with the class variables. - if (@_) { + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); $self->{_a} = $_[0]; $self->{_p} = $_[1]; - } else { - unless($selfref) { - $self->{_a} = $class -> accuracy(); - $self->{_p} = $class -> precision(); - } + } elsif (!$selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } return $self; @@ -1036,11 +1068,12 @@ sub bone { sub binf { # create/assign a '+inf' or '-inf' - if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && - $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) { - #carp("Using binf() as a function is deprecated;", - # " use binf() as a method instead"); + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -1059,10 +1092,21 @@ sub binf { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('binf'); + return $self if $selfref && $self->modify('binf'); + + # Get the sign. + + my $sign = '+'; # default is to return positive infinity + if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) { + $sign = $1; + shift; + } + + # Get the rounding parameters, if any. - my $sign = shift; - $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; + my @r = @_; + + # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; @@ -1070,19 +1114,17 @@ sub binf { $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 + # parameters are given, and if called as a class method, initialize the new # instance with the class variables. - if (@_) { + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); $self->{_a} = $_[0]; $self->{_p} = $_[1]; - } else { - unless($selfref) { - $self->{_a} = $class -> accuracy(); - $self->{_p} = $class -> precision(); - } + } elsif (!$selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } return $self; @@ -1091,9 +1133,12 @@ sub binf { sub bnan { # create/assign a 'NaN' - if (@_ == 0) { - #carp("Using bnan() as a function is deprecated;", - # " use bnan() as a method instead"); + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; unshift @_, __PACKAGE__; } @@ -1112,7 +1157,11 @@ sub bnan { # Don't modify constant (read-only) objects. - return if $selfref && $self->modify('bnan'); + return $self if $selfref && $self->modify('bnan'); + + # Get the rounding parameters, if any. + + my @r = @_; $self = bless {}, $class unless $selfref; @@ -1120,19 +1169,17 @@ sub bnan { $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 + # parameters are given, and if called as a class method, initialize the new # instance with the class variables. - if (@_) { + if (@r) { croak "can't specify both accuracy and precision" - if @_ >= 2 && defined $_[0] && defined $_[1]; + if @r >= 2 && defined($r[0]) && defined($r[1]); $self->{_a} = $_[0]; $self->{_p} = $_[1]; - } else { - unless($selfref) { - $self->{_a} = $class -> accuracy(); - $self->{_p} = $class -> precision(); - } + } elsif (!$selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } return $self; @@ -1140,19 +1187,28 @@ sub bnan { sub bpi { - # 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) + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } + + # Called as Argument list + # --------- ------------- + # Math::BigFloat->bpi() ("Math::BigFloat") + # Math::BigFloat->bpi(10) ("Math::BigFloat", 10) + # $x->bpi() ($x) + # $x->bpi(10) ($x, 10) + # Math::BigFloat::bpi() () + # Math::BigFloat::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); + # $n = Math::BigFloat->new("10"); + # $x = Math::BigFloat->bpi($n); # # which gives an argument list with the single element $n, is resolved as # @@ -1161,35 +1217,12 @@ sub bpi { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; + my @r = @_; # rounding paramters - 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; - } + if ($selfref) { # bpi() called as an instance method + return $self if $self -> modify('bpi'); + } else { # bpi() called as a class method + $self = bless {}, $class; # initialize new instance } return $upgrade -> bpi(@r) if defined $upgrade; @@ -1197,34 +1230,100 @@ sub bpi { # hard-wired to "3" $self -> {sign} = '+'; $self -> {value} = $LIB -> _new("3"); - $self -> round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + $self = $self -> round(@r); return $self; } sub copy { - my $self = shift; - my $selfref = ref $self; - my $class = $selfref || $self; - - # If called as a class method, the object to copy is the next argument. + my ($x, $class); + if (ref($_[0])) { # $y = $x -> copy() + $x = shift; + $class = ref($x); + } else { # $y = Math::BigInt -> copy($y) + $class = shift; + $x = shift; + } - $self = shift() unless $selfref; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @_; my $copy = bless {}, $class; - $copy->{sign} = $self->{sign}; - $copy->{value} = $LIB->_copy($self->{value}); - $copy->{_a} = $self->{_a} if exists $self->{_a}; - $copy->{_p} = $self->{_p} if exists $self->{_p}; + $copy->{sign} = $x->{sign}; + $copy->{value} = $LIB->_copy($x->{value}); + $copy->{_a} = $x->{_a} if exists $x->{_a}; + $copy->{_p} = $x->{_p} if exists $x->{_p}; return $copy; } -sub as_number { - # An object might be asked to return itself as bigint on certain overloaded - # operations. This does exactly this, so that sub classes can simple inherit - # it or override with their own integer conversion routine. - $_[0]->copy(); +sub as_int { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # If called as an instance method, and the instance class is something we + # upgrade to, $x might not be a Math::BigInt, so don't just call copy(). + + return $x -> copy() if $x -> isa("Math::BigInt"); + + # disable upgrading and downgrading + + my $upg = Math::BigInt -> upgrade(); + my $dng = Math::BigInt -> downgrade(); + Math::BigInt -> upgrade(undef); + Math::BigInt -> downgrade(undef); + + my $y = Math::BigInt -> new($x); + + # reset upgrading and downgrading + + Math::BigInt -> upgrade($upg); + Math::BigInt -> downgrade($dng); + + return $y; +} + +sub as_float { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # disable upgrading and downgrading + + require Math::BigFloat; + my $upg = Math::BigFloat -> upgrade(); + my $dng = Math::BigFloat -> downgrade(); + Math::BigFloat -> upgrade(undef); + Math::BigFloat -> downgrade(undef); + + my $y = Math::BigFloat -> new($x); + + # reset upgrading and downgrading + + Math::BigFloat -> upgrade($upg); + Math::BigFloat -> downgrade($dng); + + return $y; +} + +sub as_rat { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # disable upgrading and downgrading + + require Math::BigRat; + my $upg = Math::BigRat -> upgrade(); + my $dng = Math::BigRat -> downgrade(); + Math::BigRat -> upgrade(undef); + Math::BigRat -> downgrade(undef); + + my $y = Math::BigRat -> new($x); + + # reset upgrading and downgrading + + Math::BigRat -> upgrade($upg); + Math::BigRat -> downgrade($dng); + + return $y; } ############################################################################### @@ -1233,7 +1332,7 @@ sub as_number { sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't $LIB->_is_zero($x->{value}); @@ -1241,22 +1340,22 @@ sub is_zero { sub is_one { # return true if arg (BINT or num_str) is +1, or -1 if sign is given - my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); - $sign = '+' if !defined $sign || $sign ne '-'; + $sign = '+' if !defined($sign) || $sign ne '-'; return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either $LIB->_is_one($x->{value}); } sub is_finite { - my $x = shift; + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return $x->{sign} eq '+' || $x->{sign} eq '-'; } sub is_inf { # return true if arg (BINT or num_str) is +-inf - my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); if (defined $sign) { $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf @@ -1268,14 +1367,14 @@ sub is_inf { sub is_nan { # return true if arg (BINT or num_str) is NaN - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); $x->{sign} eq $nan ? 1 : 0; } sub is_positive { # return true when arg (BINT or num_str) is positive (> 0) - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 1 if $x->{sign} eq '+inf'; # +inf is positive @@ -1285,14 +1384,14 @@ sub is_positive { sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not } sub is_non_negative { # Return true if argument is non-negative (>= 0). - my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 1 if $x->{sign} =~ /^\+/; return 1 if $x -> is_zero(); @@ -1301,7 +1400,7 @@ sub is_non_negative { sub is_non_positive { # Return true if argument is non-positive (<= 0). - my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 1 if $x->{sign} =~ /^\-/; return 1 if $x -> is_zero(); @@ -1310,7 +1409,7 @@ sub is_non_positive { sub is_odd { # return true when arg (BINT or num_str) is odd, false for even - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't $LIB->_is_odd($x->{value}); @@ -1318,7 +1417,7 @@ sub is_odd { sub is_even { # return true when arg (BINT or num_str) is even, false for odd - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't $LIB->_is_even($x->{value}); @@ -1326,8 +1425,7 @@ sub is_even { sub is_int { # return true when arg (BINT or num_str) is an integer - # always true for Math::BigInt, but different for Math::BigFloat objects - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't } @@ -1341,12 +1439,14 @@ sub bcmp { # (BINT or num_str, BINT or num_str) return cond_code # set up parameters - my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1]) - ? (ref($_[0]), @_) - : objectify(2, @_); + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - return $upgrade->bcmp($x, $y) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + return $upgrade->bcmp($x, $y) + if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN @@ -1357,6 +1457,7 @@ sub bcmp { return -1 if $y->{sign} eq '+inf'; return +1; } + # check sign for speed first return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 @@ -1381,12 +1482,14 @@ sub bacmp { # (BINT, BINT) return cond_code # set up parameters - my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1]) - ? (ref($_[0]), @_) - : objectify(2, @_); + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - return $upgrade->bacmp($x, $y) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + return $upgrade->bacmp($x, $y) + if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN @@ -1399,69 +1502,68 @@ sub bacmp { } sub beq { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'beq() is an instance method, not a class method' unless $selfref; - croak 'Wrong number of arguments for beq()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); - return defined($cmp) && ! $cmp; + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary + return defined($cmp) && !$cmp; } sub bne { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'bne() is an instance method, not a class method' unless $selfref; - croak 'Wrong number of arguments for bne()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); - return defined($cmp) && ! $cmp ? '' : 1; + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary + return defined($cmp) && !$cmp ? '' : 1; } sub blt { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'blt() is an instance method, not a class method' unless $selfref; - croak 'Wrong number of arguments for blt()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary return defined($cmp) && $cmp < 0; } sub ble { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'ble() is an instance method, not a class method' unless $selfref; - croak 'Wrong number of arguments for ble()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary return defined($cmp) && $cmp <= 0; } sub bgt { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'bgt() is an instance method, not a class method' unless $selfref; - croak 'Wrong number of arguments for bgt()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary return defined($cmp) && $cmp > 0; } sub bge { - my $self = shift; - my $selfref = ref $self; + my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (undef, @_) + : objectify(2, @_); - croak 'bge() is an instance method, not a class method' - unless $selfref; - croak 'Wrong number of arguments for bge()' unless @_ == 1; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $cmp = $self -> bcmp(shift); + my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary return defined($cmp) && $cmp >= 0; } @@ -1472,84 +1574,104 @@ sub bge { sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bneg'); - # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' - $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{value})); - $x; + return $upgrade -> bneg($x, @r) if defined($upgrade) && !$x->isa($class); + + # Don't negate +0 so we always have the normalized form +0. Does nothing for + # 'NaN'. + $x->{sign} =~ tr/+-/-+/ + unless $x->{sign} eq '+' && $LIB->_is_zero($x->{value}); + + $x -> round(@r); } sub babs { # (BINT or num_str) return BINT # make number absolute, or return absolute BINT from string - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('babs'); - # post-normalized abs for internal use (does nothing for NaN) + + return $upgrade -> babs($x, @r) if defined($upgrade) && !$x->isa($class); + $x->{sign} =~ s/^-/+/; - $x; + + $x -> round(@r); } sub bsgn { # Signum function. + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - my $self = shift; + return $x if $x->modify('bsgn'); + + return $upgrade -> bsgn($x, @r) if defined($upgrade) && !$x->isa($class); - return $self if $self->modify('bsgn'); + return $x -> bone("+", @r) if $x -> is_pos(); + return $x -> bone("-", @r) if $x -> is_neg(); - return $self -> bone("+") if $self -> is_pos(); - return $self -> bone("-") if $self -> is_neg(); - return $self; # zero or NaN + $x -> round(@r); } sub bnorm { # (numstr or BINT) return BINT # Normalize number -- no-op here - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + + # This method is called from the rounding methods, so if this method + # supports rounding by calling the rounding methods, we get an infinite + # recursion. + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + $x; } sub binc { # increment arg by one - my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + return $x if $x->modify('binc'); + return $x->round(@r) if $x -> is_inf() || $x -> is_nan(); + + return $upgrade -> binc($x, @r) if defined($upgrade) && !$x -> isa($class); + if ($x->{sign} eq '+') { $x->{value} = $LIB->_inc($x->{value}); - return $x->round($a, $p, $r); } elsif ($x->{sign} eq '-') { $x->{value} = $LIB->_dec($x->{value}); $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # -1 +1 => -0 => +0 - return $x->round($a, $p, $r); } - # inf, nan handling etc - $x->badd($class->bone(), $a, $p, $r); # badd does round + + return $x->round(@r); } sub bdec { # decrement arg by one my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + return $x if $x->modify('bdec'); + return $x->round(@r) if $x -> is_inf() || $x -> is_nan(); + + return $upgrade -> bdec($x, @r) if defined($upgrade) && !$x -> isa($class);; + if ($x->{sign} eq '-') { - # x already < 0 $x->{value} = $LIB->_inc($x->{value}); - } else { - return $x->badd($class->bone('-'), @r) - unless $x->{sign} eq '+'; # inf or NaN - # >= 0 - if ($LIB->_is_zero($x->{value})) { - # == 0 + } elsif ($x->{sign} eq '+') { + if ($LIB->_is_zero($x->{value})) { # +1 - 1 => +0 $x->{value} = $LIB->_one(); - $x->{sign} = '-'; # 0 => -1 + $x->{sign} = '-'; } else { - # > 0 $x->{value} = $LIB->_dec($x->{value}); } } - $x->round(@r); + + return $x->round(@r); } #sub bstrcmp { @@ -1643,56 +1765,41 @@ sub bdec { #} sub badd { - # add second arg (BINT or string) to first (BINT) (modifies first) # return result as BINT # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('badd'); - return $upgrade->badd($upgrade->new($x), $upgrade->new($y), @r) if defined $upgrade && - ((!$x->isa($class)) || (!$y->isa($class))); $r[3] = $y; # no push! - # inf and NaN handling + + return $upgrade->badd($x, $y, @r) + if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); + + # Inf and NaN handling if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { # NaN first - return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - # inf handling + return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + # Inf handling if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { - # +inf++inf or -inf+-inf => same, rest is NaN - return $x if $x->{sign} eq $y->{sign}; - return $x->bnan(); + # +Inf + +Inf or -Inf + -Inf => same, rest is NaN + return $x->round(@r) if $x->{sign} eq $y->{sign}; + return $x->bnan(@r); } - # +-inf + something => +inf - # something +-inf => +-inf - $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; - return $x; - } - - my ($sx, $sy) = ($x->{sign}, $y->{sign}); # get signs - - if ($sx eq $sy) { - $x->{value} = $LIB->_add($x->{value}, $y->{value}); # same sign, abs add - } else { - my $a = $LIB->_acmp ($y->{value}, $x->{value}); # absolute compare - if ($a > 0) { - $x->{value} = $LIB->_sub($y->{value}, $x->{value}, 1); # abs sub w/ swap - $x->{sign} = $sy; - } elsif ($a == 0) { - # speedup, if equal, set result to 0 - $x->{value} = $LIB->_zero(); - $x->{sign} = '+'; - } else # a < 0 - { - $x->{value} = $LIB->_sub($x->{value}, $y->{value}); # abs sub + # ±Inf + something => ±Inf + # something + ±Inf => ±Inf + if ($y->{sign} =~ /^[+-]inf$/) { + $x->{sign} = $y->{sign}; } + return $x -> round(@r); } + + ($x->{value}, $x->{sign}) + = $LIB -> _sadd($x->{value}, $x->{sign}, $y->{value}, $y->{sign}); $x->round(@r); } @@ -1701,17 +1808,14 @@ sub bsub { # subtract second arg from first, modify first # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('bsub'); - return $upgrade -> bsub($upgrade -> new($x), $upgrade -> new($y), @r) - if defined $upgrade && (!$x -> isa($class) || !$y -> isa($class)); + return $upgrade -> bsub($x, $y, @r) + if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); return $x -> round(@r) if $y -> is_zero(); @@ -1724,9 +1828,10 @@ sub bsub { if ($xsign ne $x -> {sign}) { # special case of $x -> bsub($x) results in 0 return $x -> bzero(@r) if $xsign =~ /^[+-]$/; - return $x -> bnan(); # NaN, -inf, +inf + return $x -> bnan(@r); # NaN, -inf, +inf } - $x -> badd($y, @r); # badd does not leave internal zeros + + $x = $x -> badd($y, @r); # badd() does not leave internal zeros $y -> {sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN) $x; # already rounded by badd() or no rounding } @@ -1736,29 +1841,27 @@ sub bmul { # (BINT or num_str, BINT or num_str) return BINT # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('bmul'); - return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { - return $x->bnan() if $x->is_zero() || $y->is_zero(); + return $x->bnan(@r) if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf - return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); - return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); - return $x->binf('-'); + return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-', @r); } - return $upgrade->bmul($x, $upgrade->new($y), @r) - if defined $upgrade && !$y->isa($class); + return $upgrade->bmul($x, $y, @r) + if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); $r[3] = $y; # no push here @@ -1775,60 +1878,143 @@ sub bmuladd { # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT # set up parameters - my ($class, $x, $y, $z, @r) = objectify(3, @_); + my ($class, $x, $y, $z, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(3, @_); return $x if $x->modify('bmuladd'); - return $x->bnan() if (($x->{sign} eq $nan) || - ($y->{sign} eq $nan) || - ($z->{sign} eq $nan)); + # x, y, and z are finite numbers - # inf handling of x and y - if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { - return $x->bnan() if $x->is_zero() || $y->is_zero(); - # result will always be +-inf: - # +inf * +/+inf => +inf, -inf * -/-inf => +inf - # +inf * -/-inf => -inf, -inf * +/+inf => -inf - return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); - return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); - return $x->binf('-'); - } - # inf handling x*y and z - if (($z->{sign} =~ /^[+-]inf$/)) { - # something +-inf => +-inf - $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/; + if ($x->{sign} =~ /^[+-]$/ && + $y->{sign} =~ /^[+-]$/ && + $z->{sign} =~ /^[+-]$/) + { + return $upgrade->bmuladd($x, $y, $z, @r) + if defined($upgrade) + && (!$x->isa($class) || !$y->isa($class) || !$z->isa($class)); + + # TODO: what if $y and $z have A or P set? + $r[3] = $z; # no push here + + my $zs = $z->{sign}; + my $zv = $z->{value}; + $zv = $LIB -> _copy($zv) if refaddr($x) eq refaddr($z); + + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + + $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math + $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 + + ($x->{value}, $x->{sign}) + = $LIB -> _sadd($x->{value}, $x->{sign}, $zv, $zs); + return $x->round(@r); } - return $upgrade->bmuladd($x, $upgrade->new($y), $upgrade->new($z), @r) - if defined $upgrade && (!$y->isa($class) || !$z->isa($class) || !$x->isa($class)); + # At least one of x, y, and z is a NaN - # TODO: what if $y and $z have A or P set? - $r[3] = $z; # no push here + return $x->bnan(@r) if (($x->{sign} eq $nan) || + ($y->{sign} eq $nan) || + ($z->{sign} eq $nan)); - $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + + # At least one of x, y, and z is an Inf - $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math - $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 + if ($x->{sign} eq "-inf") { - my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs + if ($y -> is_neg()) { # x = -inf, y < 0 + if ($z->{sign} eq "-inf") { + return $x->bnan(@r); + } else { + return $x->binf("+", @r); + } + } elsif ($y -> is_zero()) { # x = -inf, y = 0 + return $x->bnan(@r); + } else { # x = -inf, y > 0 + if ($z->{sign} eq "+inf") { + return $x->bnan(@r); + } else { + return $x->binf("-", @r); + } + } - if ($sx eq $sz) { - $x->{value} = $LIB->_add($x->{value}, $z->{value}); # same sign, abs add - } else { - my $a = $LIB->_acmp ($z->{value}, $x->{value}); # absolute compare - if ($a > 0) { - $x->{value} = $LIB->_sub($z->{value}, $x->{value}, 1); # abs sub w/ swap - $x->{sign} = $sz; - } elsif ($a == 0) { - # speedup, if equal, set result to 0 - $x->{value} = $LIB->_zero(); - $x->{sign} = '+'; - } else # a < 0 - { - $x->{value} = $LIB->_sub($x->{value}, $z->{value}); # abs sub + } elsif ($x->{sign} eq "+inf") { + + if ($y -> is_neg()) { # x = +inf, y < 0 + if ($z->{sign} eq "+inf") { + return $x->bnan(@r); + } else { + return $x->binf("-", @r); + } + } elsif ($y -> is_zero()) { # x = +inf, y = 0 + return $x->bnan(@r); + } else { # x = +inf, y > 0 + if ($z->{sign} eq "-inf") { + return $x->bnan(@r); + } else { + return $x->binf("+", @r); + } + } + + } elsif ($x -> is_neg()) { + + if ($y->{sign} eq "-inf") { # -inf < x < 0, y = -inf + if ($z->{sign} eq "-inf") { + return $x->bnan(@r); + } else { + return $x->binf("+", @r); + } + } elsif ($y->{sign} eq "+inf") { # -inf < x < 0, y = +inf + if ($z->{sign} eq "+inf") { + return $x->bnan(@r); + } else { + return $x->binf("-", @r); + } + } else { # -inf < x < 0, -inf < y < +inf + if ($z->{sign} eq "-inf") { + return $x->binf("-", @r); + } elsif ($z->{sign} eq "+inf") { + return $x->binf("+", @r); + } + } + + } elsif ($x -> is_zero()) { + + if ($y->{sign} eq "-inf") { # x = 0, y = -inf + return $x->bnan(@r); + } elsif ($y->{sign} eq "+inf") { # x = 0, y = +inf + return $x->bnan(@r); + } else { # x = 0, -inf < y < +inf + if ($z->{sign} eq "-inf") { + return $x->binf("-", @r); + } elsif ($z->{sign} eq "+inf") { + return $x->binf("+", @r); + } + } + + } elsif ($x -> is_pos()) { + + if ($y->{sign} eq "-inf") { # 0 < x < +inf, y = -inf + if ($z->{sign} eq "+inf") { + return $x->bnan(@r); + } else { + return $x->binf("-", @r); + } + } elsif ($y->{sign} eq "+inf") { # 0 < x < +inf, y = +inf + if ($z->{sign} eq "-inf") { + return $x->bnan(@r); + } else { + return $x->binf("+", @r); + } + } else { # 0 < x < +inf, -inf < y < +inf + if ($z->{sign} eq "-inf") { + return $x->binf("-", @r); + } elsif ($z->{sign} eq "+inf") { + return $x->binf("+", @r); + } } } - $x->round(@r); + + die; } sub bdiv { @@ -1837,12 +2023,9 @@ sub bdiv { # sign as the divisor. # Set up parameters. - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify() is costly, so avoid it if we can. - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('bdiv'); @@ -1852,7 +2035,8 @@ sub bdiv { # modulo/remainder. if ($x -> is_nan() || $y -> is_nan()) { - return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan(); + return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r)) + : $x -> bnan(@r); } # Divide by zero and modulo zero. @@ -1875,12 +2059,12 @@ sub bdiv { if ($y -> is_zero()) { my $rem; if ($wantarray) { - $rem = $x -> copy(); + $rem = $x -> copy() -> round(@r); } if ($x -> is_zero()) { - $x -> bnan(); + $x = $x -> bnan(@r); } else { - $x -> binf($x -> {sign}); + $x = $x -> binf($x -> {sign}, @r); } return $wantarray ? ($x, $rem) : $x; } @@ -1901,12 +2085,12 @@ sub bdiv { if ($x -> is_inf()) { my $rem; - $rem = $class -> bnan() if $wantarray; + $rem = $class -> bnan(@r) if $wantarray; if ($y -> is_inf()) { - $x -> bnan(); + $x = $x -> bnan(@r); } else { my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; - $x -> binf($sign); + $x = $x -> binf($sign, @r); } return $wantarray ? ($x, $rem) : $x; } @@ -1927,11 +2111,11 @@ sub bdiv { if ($y -> is_inf()) { my $rem; if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { - $rem = $x -> copy() if $wantarray; - $x -> bzero(); + $rem = $x -> copy() -> round(@r) if $wantarray; + $x = $x -> bzero(@r); } else { - $rem = $class -> binf($y -> {sign}) if $wantarray; - $x -> bone('-'); + $rem = $class -> binf($y -> {sign}, @r) if $wantarray; + $x = $x -> bone('-', @r); } return $wantarray ? ($x, $rem) : $x; } @@ -1939,8 +2123,10 @@ sub bdiv { # At this point, both the numerator and denominator are finite numbers, and # the denominator (divisor) is non-zero. - return $upgrade -> bdiv($upgrade -> new($x), $upgrade -> new($y), @r) - if defined $upgrade; + # Division might return a non-integer result, so upgrade unconditionally, if + # upgrading is enabled. + + return $upgrade -> bdiv($x, $y, @r) if defined $upgrade; $r[3] = $y; # no push! @@ -1959,7 +2145,7 @@ sub bdiv { $y -> {sign} = $ysign; # Re-insert the original sign. if ($same) { - $x -> bone(); + $x = $x -> bone(); } else { ($x -> {value}, $rem -> {value}) = $LIB -> _div($x -> {value}, $y -> {value}); @@ -1975,16 +2161,16 @@ sub bdiv { $x -> {sign} = '+'; } else { if ($xsign eq '+') { - $x -> badd(1); + $x = $x -> badd(1); } else { - $x -> bsub(1); + $x = $x -> bsub(1); } $x -> {sign} = '-'; } } } - $x -> round(@r); + $x = $x -> round(@r); if ($wantarray) { unless ($LIB -> _is_zero($rem -> {value})) { @@ -1995,7 +2181,7 @@ sub bdiv { } $rem -> {_a} = $x -> {_a}; $rem -> {_p} = $x -> {_p}; - $rem -> round(@r); + $rem = $rem -> round(@r); return ($x, $rem); } @@ -2010,12 +2196,9 @@ sub btdiv { # and $q * $y + $r = $x. # Set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it if we can. - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('btdiv'); @@ -2025,7 +2208,8 @@ sub btdiv { # modulo/remainder. if ($x -> is_nan() || $y -> is_nan()) { - return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan(); + return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r)) + : $x -> bnan(@r); } # Divide by zero and modulo zero. @@ -2048,12 +2232,12 @@ sub btdiv { if ($y -> is_zero()) { my $rem; if ($wantarray) { - $rem = $x -> copy(); + $rem = $x -> copy(@r); } if ($x -> is_zero()) { - $x -> bnan(); + $x = $x -> bnan(@r); } else { - $x -> binf($x -> {sign}); + $x = $x -> binf($x -> {sign}, @r); } return $wantarray ? ($x, $rem) : $x; } @@ -2074,12 +2258,12 @@ sub btdiv { if ($x -> is_inf()) { my $rem; - $rem = $class -> bnan() if $wantarray; + $rem = $class -> bnan(@r) if $wantarray; if ($y -> is_inf()) { - $x -> bnan(); + $x = $x -> bnan(@r); } else { my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; - $x -> binf($sign); + $x = $x -> binf($sign,@r ); } return $wantarray ? ($x, $rem) : $x; } @@ -2099,13 +2283,15 @@ sub btdiv { if ($y -> is_inf()) { my $rem; - $rem = $x -> copy() if $wantarray; - $x -> bzero(); + $rem = $x -> copy() -> round(@r) if $wantarray; + $x = $x -> bzero(@r); return $wantarray ? ($x, $rem) : $x; } - return $upgrade -> btdiv($upgrade -> new($x), $upgrade -> new($y), @r) - if defined $upgrade; + # Division might return a non-integer result, so upgrade unconditionally, if + # upgrading is enabled. + + return $upgrade -> btdiv($x, $y, @r) if defined $upgrade; $r[3] = $y; # no push! @@ -2124,14 +2310,14 @@ sub btdiv { $y -> {sign} = $ysign; # Re-insert the original sign. if ($same) { - $x -> bone(); + $x = $x -> bone(@r); } else { ($x -> {value}, $rem -> {value}) = $LIB -> _div($x -> {value}, $y -> {value}); $x -> {sign} = $xsign eq $ysign ? '+' : '-'; $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); - $x -> round(@r); + $x = $x -> round(@r); } if (wantarray) { @@ -2139,7 +2325,7 @@ sub btdiv { $rem -> {sign} = '+' if $LIB -> _is_zero($rem -> {value}); $rem -> {_a} = $x -> {_a}; $rem -> {_p} = $x -> {_p}; - $rem -> round(@r); + $rem = $rem -> round(@r); return ($x, $rem); } @@ -2150,44 +2336,45 @@ sub bmod { # This is the remainder after floored division. # Set up parameters. - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('bmod'); + $r[3] = $y; # no push! # At least one argument is NaN. if ($x -> is_nan() || $y -> is_nan()) { - return $x -> bnan(); + return $x -> bnan(@r); } # Modulo zero. See documentation for bdiv(). if ($y -> is_zero()) { - return $x; + return $x -> round(@r); } # Numerator (dividend) is +/-inf. if ($x -> is_inf()) { - return $x -> bnan(); + return $x -> bnan(@r); } # Denominator (divisor) is +/-inf. if ($y -> is_inf()) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { - return $x; + return $x -> round(@r); } else { - return $x -> binf($y -> sign()); + return $x -> binf($y -> sign(), @r); } } + return $upgrade -> bmod($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); + # Calc new sign and in case $y == +/- 1, return $x. $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value}); @@ -2206,41 +2393,38 @@ sub btmod { # Remainder after truncated division. # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('btmod'); # At least one argument is NaN. if ($x -> is_nan() || $y -> is_nan()) { - return $x -> bnan(); + return $x -> bnan(@r); } # Modulo zero. See documentation for btdiv(). if ($y -> is_zero()) { - return $x; + return $x -> round(@r); } # Numerator (dividend) is +/-inf. if ($x -> is_inf()) { - return $x -> bnan(); + return $x -> bnan(@r); } # Denominator (divisor) is +/-inf. if ($y -> is_inf()) { - return $x; + return $x -> round(@r); } - return $upgrade -> btmod($upgrade -> new($x), $upgrade -> new($y), @r) - if defined $upgrade; + return $upgrade -> btmod($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); $r[3] = $y; # no push! @@ -2251,7 +2435,6 @@ sub btmod { $x -> {sign} = $xsign; $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); $x -> round(@r); - return $x; } sub bmodinv { @@ -2267,28 +2450,29 @@ sub bmodinv { # If no modular multiplicative inverse exists, NaN is returned. # set up parameters - my ($class, $x, $y, @r) = (undef, @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x->modify('bmodinv'); # Return NaN if one or both arguments is +inf, -inf, or nan. - return $x->bnan() if ($y->{sign} !~ /^[+-]$/ || - $x->{sign} !~ /^[+-]$/); + return $x->bnan(@r) if ($y->{sign} !~ /^[+-]$/ || + $x->{sign} !~ /^[+-]$/); # Return NaN if $y is zero; 1 % 0 makes no sense. - return $x->bnan() if $y->is_zero(); + return $x->bnan(@r) if $y->is_zero(); # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite # integers $x. - return $x->bzero() if ($y->is_one() || - $y->is_one('-')); + return $x->bzero(@r) if ($y->is_one('+') || + $y->is_one('-')); + + return $upgrade -> bmodinv($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when # $x = 0 is when $y = 1 or $y = -1, but that was covered above. @@ -2299,14 +2483,14 @@ sub bmodinv { # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7. # The value if $x is affected only when $x and $y have opposite signs. - $x->bmod($y); - return $x->bnan() if $x->is_zero(); + $x = $x->bmod($y); + return $x->bnan(@r) if $x->is_zero(); # Compute the modular multiplicative inverse of the absolute values. We'll # correct for the signs of $x and $y later. Return NaN if no GCD is found. ($x->{value}, $x->{sign}) = $LIB->_modinv($x->{value}, $y->{value}); - return $x->bnan() if !defined $x->{value}; + return $x->bnan(@r) if !defined($x->{value}); # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions # <= 1.32 return undef rather than a "+" for the sign. @@ -2325,20 +2509,23 @@ sub bmodinv { # inverse modulo. The net effect is that we must swap the sign of the # result if $y is negative. - $x -> bneg() if $y->{sign} eq '-'; + $x = $x -> bneg() if $y->{sign} eq '-'; # Compute $x modulo $y again after correcting the sign. - $x -> bmod($y) if $x->{sign} ne $y->{sign}; + $x = $x -> bmod($y) if $x->{sign} ne $y->{sign}; - return $x; + $x -> round(@r); } sub bmodpow { - # Modular exponentiation. Raises a very large number to a very large exponent - # in a given very large modulus quickly, thanks to binary exponentiation. - # Supports negative exponents. - my ($class, $num, $exp, $mod, @r) = objectify(3, @_); + # Modular exponentiation. Raises a very large number to a very large + # exponent in a given very large modulus quickly, thanks to binary + # exponentiation. Supports negative exponents. + my ($class, $num, $exp, $mod, @r) + = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) + ? (ref($_[0]), @_) + : objectify(3, @_); return $num if $num->modify('bmodpow'); @@ -2347,25 +2534,30 @@ sub bmodpow { # # b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m) - $num->bmodinv($mod) if ($exp->{sign} eq '-'); + $num = $num -> bmodinv($mod) if ($exp->{sign} eq '-'); - # Check for valid input. All operands must be finite, and the modulus must be - # non-zero. + # Check for valid input. All operands must be finite, and the modulus must + # be non-zero. - return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf - $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf - $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf + return $num->bnan(@r) if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf + $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf + $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf # Modulo zero. See documentation for Math::BigInt's bmod() method. if ($mod -> is_zero()) { if ($num -> is_zero()) { - return $class -> bnan(); + return $class -> bnan(@r); } else { - return $num -> copy(); + return $num -> copy(@r); } } + return $upgrade -> bmodinv($num, $exp, $mod, @r) + if defined($upgrade) && (!$num -> isa($class) || + !$exp -> isa($class) || + !$mod -> ($class)); + # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting # value is zero, the output is also zero, regardless of the signs on 'a' and # 'm'. @@ -2438,62 +2630,60 @@ sub bpow { # modifies first argument # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); return $x if $x -> modify('bpow'); # $x and/or $y is a NaN - return $x -> bnan() if $x -> is_nan() || $y -> is_nan(); + return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); # $x and/or $y is a +/-Inf if ($x -> is_inf("-")) { - return $x -> bzero() if $y -> is_negative(); - return $x -> bnan() if $y -> is_zero(); - return $x if $y -> is_odd(); - return $x -> bneg(); + return $x -> bzero(@r) if $y -> is_negative(); + return $x -> bnan(@r) if $y -> is_zero(); + return $x -> round(@r) if $y -> is_odd(); + return $x -> bneg(@r); } elsif ($x -> is_inf("+")) { - return $x -> bzero() if $y -> is_negative(); - return $x -> bnan() if $y -> is_zero(); - return $x; + return $x -> bzero(@r) if $y -> is_negative(); + return $x -> bnan(@r) if $y -> is_zero(); + return $x -> round(@r); } elsif ($y -> is_inf("-")) { - return $x -> bnan() if $x -> is_one("-"); - return $x -> binf("+") if $x -> is_zero(); - return $x -> bone() if $x -> is_one("+"); - return $x -> bzero(); + return $x -> bnan(@r) if $x -> is_one("-"); + return $x -> binf("+", @r) if $x -> is_zero(); + return $x -> bone(@r) if $x -> is_one("+"); + return $x -> bzero(@r); } elsif ($y -> is_inf("+")) { - return $x -> bnan() if $x -> is_one("-"); - return $x -> bzero() if $x -> is_zero(); - return $x -> bone() if $x -> is_one("+"); - return $x -> binf("+"); + return $x -> bnan(@r) if $x -> is_one("-"); + return $x -> bzero(@r) if $x -> is_zero(); + return $x -> bone(@r) if $x -> is_one("+"); + return $x -> binf("+", @r); } if ($x -> is_zero()) { - return $x -> bone() if $y -> is_zero(); - return $x -> binf() if $y -> is_negative(); - return $x; + return $x -> bone(@r) if $y -> is_zero(); + return $x -> binf(@r) if $y -> is_negative(); + return $x -> round(@r); } if ($x -> is_one("+")) { - return $x; + return $x -> round(@r); } if ($x -> is_one("-")) { - return $x if $y -> is_odd(); - return $x -> bneg(); + return $x -> round(@r) if $y -> is_odd(); + return $x -> bneg(@r); } - # We don't support finite non-integers, so upgrade or return zero. The - # reason for returning zero, not NaN, is that all output is in the open - # interval (0,1), and truncating that to integer gives zero. + return $upgrade -> bpow($x, $y, @r) if defined $upgrade; + + # We don't support finite non-integers, so return zero. The reason for + # returning zero, not NaN, is that all output is in the open interval (0,1), + # and truncating that to integer gives zero. if ($y->{sign} eq '-' || !$y -> isa($class)) { - return $upgrade -> bpow($upgrade -> new($x), $y, @r) - if defined $upgrade; - return $x -> bzero(); + return $x -> bzero(@r); } $r[3] = $y; # no push! @@ -2513,12 +2703,12 @@ sub blog { # Don't objectify the base, since an undefined base, as in $x->blog() or # $x->blog(undef) signals that the base is Euler's number. - if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { + if (!ref($_[0]) && $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i) { # E.g., Math::BigInt->blog(256, 2) ($class, $x, $base, @r) = defined $_[2] ? objectify(2, @_) : objectify(1, @_); } else { - # E.g., Math::BigInt::blog(256, 2) or $x->blog(2) + # E.g., $x->blog(2) or the deprecated Math::BigInt::blog(256, 2) ($class, $x, $base, @r) = defined $_[1] ? objectify(2, @_) : objectify(1, @_); } @@ -2528,80 +2718,70 @@ sub blog { # Handle all exception cases and all trivial cases. I have used Wolfram # Alpha (http://www.wolframalpha.com) as the reference for these cases. - return $x -> bnan() if $x -> is_nan(); + return $x -> bnan(@r) if $x -> is_nan(); if (defined $base) { $base = $class -> new($base) unless ref $base; if ($base -> is_nan() || $base -> is_one()) { - return $x -> bnan(); + return $x -> bnan(@r); } elsif ($base -> is_inf() || $base -> is_zero()) { - return $x -> bnan() if $x -> is_inf() || $x -> is_zero(); - return $x -> bzero(); - } elsif ($base -> is_negative()) { # -inf < base < 0 - return $x -> bzero() if $x -> is_one(); # x = 1 - return $x -> bone() if $x == $base; # x = base - return $x -> bnan(); # otherwise + return $x -> bnan(@r) if $x -> is_inf() || $x -> is_zero(); + return $x -> bzero(@r); + } elsif ($base -> is_negative()) { # -inf < base < 0 + return $x -> bzero(@r) if $x -> is_one(); # x = 1 + return $x -> bone(@r) if $x == $base; # x = base + return $x -> bnan(@r); # otherwise } - return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf + return $x -> bone(@r) if $x == $base; # 0 < base && 0 < x < inf } # We now know that the base is either undefined or >= 2 and finite. - return $x -> binf('+') if $x -> is_inf(); # x = +/-inf - return $x -> bnan() if $x -> is_neg(); # -inf < x < 0 - return $x -> bzero() if $x -> is_one(); # x = 1 - return $x -> binf('-') if $x -> is_zero(); # x = 0 + return $x -> binf('+', @r) if $x -> is_inf(); # x = +/-inf + return $x -> bnan(@r) if $x -> is_neg(); # -inf < x < 0 + return $x -> bzero(@r) if $x -> is_one(); # x = 1 + return $x -> binf('-', @r) if $x -> is_zero(); # x = 0 # At this point we are done handling all exception cases and trivial cases. - return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade; + return $upgrade -> blog($x, $base, @r) if defined $upgrade; # fix for bug #24969: # the default base is e (Euler's number) which is not an integer if (!defined $base) { require Math::BigFloat; - my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int(); + my $u = Math::BigFloat->blog($x)->as_int(); # modify $x in place $x->{value} = $u->{value}; $x->{sign} = $u->{sign}; - return $x; + return $x -> round(@r); } my ($rc) = $LIB->_log_int($x->{value}, $base->{value}); - return $x->bnan() unless defined $rc; # not possible to take log? + return $x->bnan(@r) unless defined $rc; # not possible to take log? $x->{value} = $rc; - $x->round(@r); + $x = $x -> round(@r); } sub bexp { # Calculate e ** $x (Euler's number to the power of X), truncated to # an integer value. my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + return $x if $x->modify('bexp'); # inf, -inf, NaN, <0 => NaN - return $x->bnan() if $x->{sign} eq 'NaN'; - return $x->bone() if $x->is_zero(); - return $x if $x->{sign} eq '+inf'; - return $x->bzero() if $x->{sign} eq '-inf'; + return $x -> bnan(@r) if $x->{sign} eq 'NaN'; + return $x -> bone(@r) if $x->is_zero(); + return $x -> round(@r) if $x->{sign} eq '+inf'; + return $x -> bzero(@r) if $x->{sign} eq '-inf'; - my $u; - { - # run through Math::BigFloat unless told otherwise - require Math::BigFloat unless defined $upgrade; - local $upgrade = 'Math::BigFloat' unless defined $upgrade; - # calculate result, truncate it to integer - $u = $upgrade->bexp($upgrade->new($x), @r); - } + return $upgrade -> bexp($x, @r) if defined $upgrade; - if (defined $upgrade) { - $x = $u; - } else { - $u = $u->as_int(); - # modify $x in place - $x->{value} = $u->{value}; - $x->round(@r); - } + require Math::BigFloat; + my $tmp = Math::BigFloat -> bexp($x, @r) -> as_int(); + $x->{value} = $tmp->{value}; + return $x -> round(@r); } sub bnok { @@ -2609,49 +2789,51 @@ sub bnok { # integer. # Set up parameters. - my ($self, $n, $k, @r) = (ref($_[0]), @_); + my ($class, $n, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) + : objectify(2, @_); - # Objectify is costly, so avoid it. - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($self, $n, $k, @r) = objectify(2, @_); - } + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $n if $n->modify('bnok'); # All cases where at least one argument is NaN. - return $n->bnan() if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN'; + return $n->bnan(@r) if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN'; # All cases where at least one argument is +/-inf. if ($n -> is_inf()) { if ($k -> is_inf()) { # bnok(+/-inf,+/-inf) - return $n -> bnan(); + return $n -> bnan(@r); } elsif ($k -> is_neg()) { # bnok(+/-inf,k), k < 0 - return $n -> bzero(); + return $n -> bzero(@r); } elsif ($k -> is_zero()) { # bnok(+/-inf,k), k = 0 - return $n -> bone(); + return $n -> bone(@r); } else { - if ($n -> is_inf("+")) { # bnok(+inf,k), 0 < k < +inf + if ($n -> is_inf("+", @r)) { # bnok(+inf,k), 0 < k < +inf return $n -> binf("+"); } else { # bnok(-inf,k), k > 0 my $sign = $k -> is_even() ? "+" : "-"; - return $n -> binf($sign); + return $n -> binf($sign, @r); } } } elsif ($k -> is_inf()) { # bnok(n,+/-inf), -inf <= n <= inf - return $n -> bnan(); + return $n -> bnan(@r); } # At this point, both n and k are real numbers. + return $upgrade -> bnok($n, $k, @r) + if defined($upgrade) && (!$n -> isa($class) || !$k -> isa($class)); + my $sign = 1; if ($n >= 0) { if ($k < 0 || $k > $n) { - return $n -> bzero(); + return $n -> bzero(@r); } } else { @@ -2660,7 +2842,7 @@ sub bnok { # n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k) $sign = (-1) ** $k; - $n -> bneg() -> badd($k) -> bdec(); + $n = $n -> bneg() -> badd($k) -> bdec(); } elsif ($k <= $n) { @@ -2668,22 +2850,22 @@ sub bnok { $sign = (-1) ** ($n - $k); my $x0 = $n -> copy(); - $n -> bone() -> badd($k) -> bneg(); + $n = $n -> bone() -> badd($k) -> bneg(); $k = $k -> copy(); - $k -> bneg() -> badd($x0); + $k = $k -> bneg() -> badd($x0); } else { # n < 0 and n < k < 0: - return $n -> bzero(); + return $n -> bzero(@r); } } $n->{value} = $LIB->_nok($n->{value}, $k->{value}); - $n -> bneg() if $sign == -1; + $n = $n -> bneg() if $sign == -1; - $n->round(@r); + $n -> round(@r); } sub buparrow { @@ -2796,9 +2978,9 @@ sub ackermann { } elsif ($m == $three) { $n = $class -> bone() -> blsft($n + $three) -> bsub($three); } elsif ($m == $two) { - $n -> bmul($two) -> badd($three); + $n = $n -> bmul($two) -> badd($three); } elsif ($m >= 0) { - $n -> badd($m) -> binc(); + $n = $n -> badd($m) -> binc(); } else { die "negative m!"; } @@ -2807,109 +2989,102 @@ sub ackermann { } sub bsin { - # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the + # Calculate sin(x) to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bsin'); - return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN + return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN + return $x->bzero(@r) if $x->is_zero(); - return $upgrade -> bsin($upgrade -> new($x, @r)) if defined $upgrade; + return $upgrade -> bsin($x, @r) if defined $upgrade; require Math::BigFloat; # calculate the result and truncate it to integer my $t = Math::BigFloat->new($x)->bsin(@r)->as_int(); - $x->bone() if $t->is_one(); - $x->bzero() if $t->is_zero(); + $x = $x->bone(@r) if $t->is_one(); + $x = $x->bzero(@r) if $t->is_zero(); $x->round(@r); } sub bcos { - # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the + # Calculate cos(x) to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bcos'); - return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN + return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN + return $x->bone(@r) if $x->is_zero(); - return $upgrade -> bcos($upgrade -> new($x), @r) if defined $upgrade; + return $upgrade -> bcos($x, @r) if defined $upgrade; require Math::BigFloat; - # calculate the result and truncate it to integer - my $t = Math::BigFloat -> bcos(Math::BigFloat -> new($x), @r) -> as_int(); - - $x->bone() if $t->is_one(); - $x->bzero() if $t->is_zero(); - $x->round(@r); + my $tmp = Math::BigFloat -> bcos($x, @r) -> as_int(); + $x->{value} = $tmp->{value}; + return $x -> round(@r); } sub batan { - # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the - # result truncated to an integer. - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + # Calculate arctan(x) to N digits. Unless upgrading is in effect, returns + # the result truncated to an integer. + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('batan'); - return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN + return $x -> bnan(@r) if $x -> is_nan(); + return $x -> bzero(@r) if $x -> is_zero(); - return $upgrade->new($x)->batan(@r) if defined $upgrade; + return $upgrade -> batan($x, @r) if defined $upgrade; - # calculate the result and truncate it to integer - my $tmp = Math::BigFloat->new($x)->batan(@r); + return $x -> bone("+", @r) if $x -> bgt("1"); + return $x -> bone("-", @r) if $x -> blt("-1"); - $x->{value} = $LIB->_new($tmp->as_int()->bstr()); - $x->round(@r); + $x -> bzero(@r); } sub batan2 { # calculate arcus tangens of ($y/$x) - # set up parameters - my ($class, $y, $x, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $y, $x, @r) = objectify(2, @_); - } + my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); return $y if $y->modify('batan2'); return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan); + return $upgrade->batan2($y, $x, @r) if defined $upgrade; + # Y X # != 0 -inf result is +- pi if ($x->is_inf() || $y->is_inf()) { - # upgrade to Math::BigFloat etc. - return $upgrade->new($y)->batan2($upgrade->new($x), @r) if defined $upgrade; if ($y->is_inf()) { if ($x->{sign} eq '-inf') { # calculate 3 pi/4 => 2.3.. => 2 - $y->bone(substr($y->{sign}, 0, 1)); - $y->bmul($class->new(2)); + $y = $y->bone(substr($y->{sign}, 0, 1)); + $y = $y->bmul($class->new(2)); } elsif ($x->{sign} eq '+inf') { # calculate pi/4 => 0.7 => 0 - $y->bzero(); + $y = $y->bzero(); } else { # calculate pi/2 => 1.5 => 1 - $y->bone(substr($y->{sign}, 0, 1)); + $y = $y->bone(substr($y->{sign}, 0, 1)); } } else { if ($x->{sign} eq '+inf') { # calculate pi/4 => 0.7 => 0 - $y->bzero(); + $y = $y->bzero(); } else { # PI => 3.1415.. => 3 - $y->bone(substr($y->{sign}, 0, 1)); - $y->bmul($class->new(3)); + $y = $y->bone(substr($y->{sign}, 0, 1)); + $y = $y->bmul($class->new(3)); } } return $y; } - return $upgrade->new($y)->batan2($upgrade->new($x), @r) if defined $upgrade; - require Math::BigFloat; my $r = Math::BigFloat->new($y) ->batan2(Math::BigFloat->new($x), @r) @@ -2918,17 +3093,17 @@ sub batan2 { $x->{value} = $r->{value}; $x->{sign} = $r->{sign}; - $x; + $x->round(@r); } sub bsqrt { # calculate square root of $x - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bsqrt'); - return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN - return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf + return $x->bnan(@r) if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN + return $x->round(@r) if $x->{sign} eq '+inf'; # sqrt(+inf) == inf return $upgrade->bsqrt($x, @r) if defined $upgrade; @@ -2940,25 +3115,22 @@ sub broot { # calculate $y'th root of $x # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - $y = $class->new(2) unless defined $y; + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); - # objectify is costly, so avoid it - if ((!ref($x)) || (ref($x) ne ref($y))) { - ($class, $x, $y, @r) = objectify(2, $class || $class, @_); - } + $y = $class->new(2) unless defined $y; return $x if $x->modify('broot'); # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 - return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || - $y->{sign} !~ /^\+$/; + return $x->bnan(@r) if $x->{sign} !~ /^\+/ || $y->is_zero() || + $y->{sign} !~ /^\+$/; return $x->round(@r) if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); - return $upgrade->new($x)->broot($upgrade->new($y), @r) if defined $upgrade; + return $upgrade->broot($x, $y, @r) if defined $upgrade; $x->{value} = $LIB->_root($x->{value}, $y->{value}); $x->round(@r); @@ -2967,10 +3139,14 @@ sub broot { sub bfac { # (BINT or num_str, BINT or num_str) return BINT # compute factorial number from $x, modify $x in place - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf - return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 => NaN + + return $x->bnan(@r) if $x->{sign} ne '+'; # NaN, <0 => NaN + + return $upgrade -> bfac($x, @r) + if defined($upgrade) && !$x -> isa($class); $x->{value} = $LIB->_fac($x->{value}); $x->round(@r); @@ -2978,11 +3154,15 @@ sub bfac { sub bdfac { # compute double factorial, modify $x in place - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf - return $x->bnan() if $x->is_nan() || $x <= -2; - return $x->bone() if $x <= 1; + + return $x->bnan(@r) if $x->is_nan() || $x <= -2; + return $x->bone(@r) if $x <= 1; + + return $upgrade -> bdfac($x, @r) + if defined($upgrade) && !$x -> isa($class); croak("bdfac() requires a newer version of the $LIB library.") unless $LIB->can('_dfac'); @@ -2993,57 +3173,67 @@ sub bdfac { sub btfac { # compute triple factorial, modify $x in place - my ($class, $x, @r) = objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('btfac') || $x->{sign} eq '+inf'; # inf => inf - return $x->bnan() if $x->is_nan(); + return $x->bnan(@r) if $x->is_nan(); + + return $upgrade -> btfac($x, @r) if defined($upgrade) && !$x -> isa($class); my $k = $class -> new("3"); - return $x->bnan() if $x <= -$k; + return $x->bnan(@r) if $x <= -$k; my $one = $class -> bone(); - return $x->bone() if $x <= $one; + return $x->bone(@r) if $x <= $one; my $f = $x -> copy(); while ($f -> bsub($k) > $one) { - $x -> bmul($f); + $x = $x -> bmul($f); } $x->round(@r); } sub bmfac { # compute multi-factorial - my ($class, $x, $k, @r) = objectify(2, @_); + + my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); return $x if $x->modify('bmfac') || $x->{sign} eq '+inf'; - return $x->bnan() if $x->is_nan() || $k->is_nan() || $k < 1 || $x <= -$k; + return $x->bnan(@r) if $x->is_nan() || $k->is_nan() || $k < 1 || $x <= -$k; + + return $upgrade -> bmfac($x, $k, @r) + if defined($upgrade) && !$x -> isa($class); my $one = $class -> bone(); - return $x->bone() if $x <= $one; + return $x->bone(@r) if $x <= $one; my $f = $x -> copy(); while ($f -> bsub($k) > $one) { - $x -> bmul($f); + $x = $x -> bmul($f); } $x->round(@r); } sub bfib { # compute Fibonacci number(s) - my ($class, $x, @r) = objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); croak("bfib() requires a newer version of the $LIB library.") unless $LIB->can('_fib'); return $x if $x->modify('bfib'); + return $upgrade -> bfib($x, @r) + if defined($upgrade) && !$x -> isa($class); + # List context. if (wantarray) { - return () if $x -> is_nan(); + return () if $x -> is_nan(); croak("bfib() can't return an infinitely long list of numbers") - if $x -> is_inf(); + if $x -> is_inf(); # Use the backend library to compute the first $x Fibonacci numbers. @@ -3053,7 +3243,7 @@ sub bfib { # invocand. for (my $i = 0 ; $i < $#values ; ++ $i) { - my $fib = $class -> bzero(); + my $fib = $class -> bzero(); $fib -> {value} = $values[$i]; $values[$i] = $fib; } @@ -3087,13 +3277,16 @@ sub bfib { sub blucas { # compute Lucas number(s) - my ($class, $x, @r) = objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); croak("blucas() requires a newer version of the $LIB library.") unless $LIB->can('_lucas'); return $x if $x->modify('blucas'); + return $upgrade -> blucas($x, @r) + if defined($upgrade) && !$x -> isa($class); + # List context. if (wantarray) { @@ -3164,8 +3357,19 @@ sub blsft { return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ || $y -> {sign} !~ /^[+-]$/); return $x -> round(@r) if $y -> is_zero(); + return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0 - $b = defined($b) ? $b -> numify() : 2; + $b = 2 if !defined $b; + return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-'; + $b = $class -> new($b) unless defined(blessed($b)); + + #return $upgrade -> blsft($x, $y, $b, @r) + # if defined($upgrade) && (!$x -> isa($class) || + # !$y -> isa($class) || + # !$b -> isa($class)); + + # shift by a negative amount? + #return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; # While some of the libraries support an arbitrarily large base, not all of # them do, so rather than returning an incorrect result in those cases, @@ -3174,6 +3378,8 @@ sub blsft { my $uintmax = ~0; croak("Base is too large.") if $b > $uintmax; + $b = $b -> numify(); + return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-'; $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b); @@ -3184,21 +3390,48 @@ sub brsft { # (BINT or num_str, BINT or num_str) return BINT # compute x >> y, base n, y >= 0 - # set up parameters my ($class, $x, $y, $b, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $b, @r) = objectify(2, @_); + # Objectify the base only when it is defined, since an undefined base, as + # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2. + + if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { + # E.g., Math::BigInt->blog(256, 5, 2) + ($class, $x, $y, $b, @r) = + defined $_[3] ? objectify(3, @_) : objectify(2, @_); + } else { + # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2) + ($class, $x, $y, $b, @r) = + defined $_[2] ? objectify(3, @_) : objectify(2, @_); } return $x if $x -> modify('brsft'); - return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ || $y -> {sign} !~ /^[+-]$/); + return $x -> bnan(@r) if $x -> {sign} !~ /^[+-]$/ || + $y -> {sign} !~ /^[+-]$/; return $x -> round(@r) if $y -> is_zero(); return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0 $b = 2 if !defined $b; - return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-'; + return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-'; + $b = $class -> new($b) unless defined(blessed($b)); + + # Shifting right by a positive amount might lead to a non-integer result, so + # include this case in the test. + + return $upgrade -> brsft($x, $y, $b, @r) + if defined($upgrade) && (!$x -> isa($class) || + !$y -> isa($class) || + !$b -> isa($class) || + $y -> is_pos()); + + # While some of the libraries support an arbitrarily large base, not all of + # them do, so rather than returning an incorrect result in those cases, + # disallow bases that don't work with all libraries. + + my $uintmax = ~0; + croak("Base is too large.") if $b > $uintmax; + + $b = $b -> numify(); # this only works for negative numbers when shifting in base 2 if (($x -> {sign} eq '-') && ($b == 2)) { @@ -3209,7 +3442,7 @@ sub brsft { # shift... # if $y != 1, we must simulate it by doing: # convert to bin, flip all bits, shift, and be done - $x -> binc(); # -3 => -2 + $x = $x -> binc(); # -3 => -2 my $bin = $x -> as_bin(); $bin =~ s/^-0b//; # strip '-0b' prefix $bin =~ tr/10/01/; # flip bits @@ -3225,13 +3458,13 @@ sub brsft { $bin =~ tr/10/01/; # flip bits back } my $res = $class -> new('0b' . $bin); # add prefix and convert back - $res -> binc(); # remember to increment + $res = $res -> binc(); # remember to increment $x -> {value} = $res -> {value}; # take over value return $x -> round(@r); # we are done now, magic, isn't? } # x < 0, n == 2, y == 1 - $x -> bdec(); # n == 2, but $y == 1: this fixes it + $x = $x -> bdec(); # n == 2, but $y == 1: this fixes it } $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b); @@ -3246,18 +3479,18 @@ sub band { #(BINT or num_str, BINT or num_str) return BINT # compute x & y - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); return $x if $x->modify('band'); + return $upgrade -> band($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || + !$y -> isa($class)); + $r[3] = $y; # no push! - return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; if ($x->{sign} eq '+' && $y->{sign} eq '+') { $x->{value} = $LIB->_and($x->{value}, $y->{value}); @@ -3272,15 +3505,15 @@ sub bior { #(BINT or num_str, BINT or num_str) return BINT # compute x | y - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); return $x if $x->modify('bior'); + return $upgrade -> bior($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || + !$y -> isa($class)); + $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); @@ -3298,18 +3531,18 @@ sub bxor { #(BINT or num_str, BINT or num_str) return BINT # compute x ^ y - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); - } + my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); return $x if $x->modify('bxor'); + return $upgrade -> bxor($x, $y, @r) + if defined($upgrade) && (!$x -> isa($class) || + !$y -> isa($class)); + $r[3] = $y; # no push! - return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; if ($x->{sign} eq '+' && $y->{sign} eq '+') { $x->{value} = $LIB->_xor($x->{value}, $y->{value}); @@ -3323,11 +3556,14 @@ sub bxor { sub bnot { # (num_str or BINT) return BINT # represent ~x as twos-complement number - # we don't need $class, so undef instead of ref($_[0]) make it slightly faster - my ($class, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); return $x if $x->modify('bnot'); - $x->binc()->bneg(); # binc already does round + + return $upgrade -> bnot($x, @r) + if defined($upgrade) && !$x -> isa($class); + + $x -> binc() -> bneg(@r); } ############################################################################### @@ -3338,22 +3574,39 @@ sub round { # Round $self according to given parameters, or given second argument's # parameters or global defaults - # for speed reasons, _find_round_parameters is embedded here: + my ($class, $self, @args) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + # $x->round(undef, undef) signals no rounding + + if (@args >= 2 && @args <= 3 && !defined($args[0]) && !defined($args[1])) { + $self->{_a} = undef; + $self->{_p} = undef; + return $self; + } + + my ($a, $p, $r) = splice @args, 0, 3; - my ($self, $a, $p, $r, @args) = @_; # $a accuracy, if given by caller # $p precision, if given by caller # $r round_mode, if given by caller # @args all 'other' arguments (0 for unary, 1 for binary ops) - my $class = ref($self); # find out class of argument(s) - no strict 'refs'; + if (defined $a) { + croak "accuracy must be a number, not '$a'" + unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/; + } + + if (defined $p) { + croak "precision must be a number, not '$p'" + unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/; + } # now pick $a or $p, but only if we have got "arguments" if (!defined $a) { foreach ($self, @args) { # take the defined one, or if both defined, the one that is smaller - $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); + $a = $_->{_a} + if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); } } if (!defined $p) { @@ -3361,10 +3614,13 @@ sub round { foreach ($self, @args) { # take the defined one, or if both defined, the one that is bigger # -2 > -3, and 3 > 2 - $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); + $p = $_->{_p} + if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } } + no strict 'refs'; + # if still none defined, use globals unless (defined $a || defined $p) { $a = ${"$class\::accuracy"}; @@ -3387,9 +3643,11 @@ sub round { # now round, by calling either bround or bfround: if (defined $a) { - $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a; + $self = $self->bround(int($a), $r) + if !defined $self->{_a} || $self->{_a} >= $a; } else { # both can't be undefined due to early out - $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p; + $self = $self->bfround(int($p), $r) + if !defined $self->{_p} || $self->{_p} <= $p; } # bround() or bfround() already called bnorm() if nec. @@ -3403,9 +3661,9 @@ sub bround { # and overwrite the rest with 0's, return normalized number # do not return $x->bnorm(), but $x - my $x = shift; - $x = __PACKAGE__->new($x) unless ref $x; - my ($scale, $mode) = $x->_scale_a(@_); + my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + my ($scale, $mode) = $x->_scale_a(@a); return $x if !defined $scale || $x->modify('bround'); # no-op if ($x->is_zero() || $scale == 0) { @@ -3417,8 +3675,8 @@ sub bround { # we have fewer digits than we want to scale to my $len = $x->length(); # convert $scale to a scalar in case it is an object (put's a limit on the - # number length, but this would already limited by memory constraints), makes - # it faster + # number length, but this would already limited by memory constraints), + # makes it faster $scale = $scale->numify() if ref ($scale); # scale < 0, but > -len (not >=!) @@ -3469,7 +3727,7 @@ sub bround { $xs =~ s/^0+(\d)/$1/; # "00000" -> "0" $put_back = 1; # need to put back } elsif ($pad > $len) { - $x->bzero(); # round to '0' + $x = $x->bzero(); # round to '0' } if ($round_up) { # what gave test above? @@ -3502,16 +3760,15 @@ sub bround { sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 || $n == 1 => round to integer - my $x = shift; - my $class = ref($x) || $x; - $x = $class->new($x) unless ref $x; - my ($scale, $mode) = $x->_scale_p(@_); + my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + my ($scale, $mode) = $x->_scale_p(@p); return $x if !defined $scale || $x->modify('bfround'); # no-op # no-op for Math::BigInt objects if $n <= 0 - $x->bround($x->length()-$scale, $mode) if $scale > 0; + $x = $x->bround($x->length()-$scale, $mode) if $scale > 0; delete $x->{_a}; # delete to save memory $x->{_p} = $scale; # store new _p @@ -3528,21 +3785,30 @@ sub fround { sub bfloor { # round towards minus infinity; no-op since it's already integer - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + return $upgrade -> bfloor($x) + if defined($upgrade) && !$x -> isa($class); $x->round(@r); } sub bceil { # round towards plus infinity; no-op since it's already int - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + return $upgrade -> bceil($x) + if defined($upgrade) && !$x -> isa($class); $x->round(@r); } sub bint { # round towards zero; no-op since it's already integer - my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + return $upgrade -> bint($x) + if defined($upgrade) && !$x -> isa($class); $x->round(@r); } @@ -3556,8 +3822,30 @@ sub bgcd { # does not modify arguments, but returns new object # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff) + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } + my ($class, @args) = objectify(0, @_); + # Upgrade? + + if (defined $upgrade) { + my $do_upgrade = 0; + for my $arg (@args) { + unless ($arg -> isa($class)) { + $do_upgrade = 1; + last; + } + } + return $upgrade -> bgcd(@args) if $do_upgrade; + } + my $x = shift @args; $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); @@ -3579,8 +3867,30 @@ sub blcm { # does not modify arguments, but returns new object # Least Common Multiple + # Class::method(...) -> Class->method(...) + unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || + $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) + { + #carp "Using ", (caller(0))[3], "() as a function is deprecated;", + # " use is as a method instead"; + unshift @_, __PACKAGE__; + } + my ($class, @args) = objectify(0, @_); + # Upgrade? + + if (defined $upgrade) { + my $do_upgrade = 0; + for my $arg (@args) { + unless ($arg -> isa($class)) { + $do_upgrade = 1; + last; + } + } + return $upgrade -> blcm(@args) if $do_upgrade; + } + my $x = shift @args; $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? @@ -3601,14 +3911,18 @@ sub blcm { sub sign { # return the sign of the number: +/-/-inf/+inf/NaN - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; $x->{sign}; } sub digit { # return the nth decimal digit, negative values count backward, 0 is right - my ($class, $x, $n) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my (undef, $x, $n, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; $n = $n->numify() if ref($n); $LIB->_digit($x->{value}, $n || 0); @@ -3616,7 +3930,9 @@ sub digit { sub bdigitsum { # like digitsum(), but assigns the result to the invocand - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x if $x -> is_nan(); return $x -> bnan() if $x -> is_inf(); @@ -3628,19 +3944,22 @@ sub bdigitsum { sub digitsum { # compute sum of decimal digits and return it - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $class -> bnan() if $x -> is_nan(); return $class -> bnan() if $x -> is_inf(); my $y = $class -> bzero(); $y -> {value} = $LIB -> _digitsum($x -> {value}); - return $y; + $y -> round(@r); } sub length { - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; my $e = $LIB->_len($x->{value}); wantarray ? ($e, 0) : $e; @@ -3648,26 +3967,40 @@ sub length { sub exponent { # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Upgrade? + + return $upgrade -> exponent($x, @r) + if defined($upgrade) && !$x -> isa($class); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf, +inf => NaN or inf - return $class->new($s); + return $class->new($s, @r); } - return $class->bzero() if $x->is_zero(); + return $class->bzero(@r) if $x->is_zero(); # 12300 => 2 trailing zeros => exponent is 2 - $class->new($LIB->_zeros($x->{value})); + $class->new($LIB->_zeros($x->{value}), @r); } sub mantissa { # return the mantissa (compatible to Math::BigFloat, e.g. reduced) - my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Upgrade? + + return $upgrade -> mantissa($x, @r) + if defined($upgrade) && !$x -> isa($class); if ($x->{sign} !~ /^[+-]$/) { # for NaN, +inf, -inf: keep the sign - return $class->new($x->{sign}); + return $class->new($x->{sign}, @r); } my $m = $x->copy(); delete $m->{_p}; @@ -3675,92 +4008,100 @@ sub mantissa { # that's a bit inefficient: my $zeros = $LIB->_zeros($m->{value}); - $m->brsft($zeros, 10) if $zeros != 0; - $m; + $m = $m->brsft($zeros, 10) if $zeros != 0; + $m -> round(@r); } sub parts { # return a copy of both the exponent and the mantissa - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - ($x->mantissa(), $x->exponent()); + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Upgrade? + + return $upgrade -> parts($x, @r) + if defined($upgrade) && !$x -> isa($class); + + ($x->mantissa(@r), $x->exponent(@r)); } +# Parts used for scientific notation with significand/mantissa and exponent as +# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4" +# (exponent). + sub sparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("sparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # Not-a-number. - if ($self -> is_nan()) { - my $mant = $self -> copy(); # mantissa + if ($x -> is_nan()) { + my $mant = $class -> bnan(@r); # mantissa return $mant unless wantarray; # scalar context - my $expo = $class -> bnan(); # exponent + my $expo = $class -> bnan(@r); # exponent return ($mant, $expo); # list context } # Infinity. - if ($self -> is_inf()) { - my $mant = $self -> copy(); # mantissa - return $mant unless wantarray; # scalar context - my $expo = $class -> binf('+'); # exponent - return ($mant, $expo); # list context + if ($x -> is_inf()) { + my $mant = $class -> binf($x->{sign}, @r); # mantissa + return $mant unless wantarray; # scalar context + my $expo = $class -> binf('+', @r); # exponent + return ($mant, $expo); # list context } + # Upgrade? + + return $upgrade -> sparts($x, @r) + if defined($upgrade) && !$x -> isa($class); + # Finite number. - my $mant = $self -> copy(); + my $mant = $x -> copy(); my $nzeros = $LIB -> _zeros($mant -> {value}); - $mant -> brsft($nzeros, 10) if $nzeros != 0; + $mant -> {value} + = $LIB -> _rsft($mant -> {value}, $LIB -> _new($nzeros), 10) + if $nzeros != 0; return $mant unless wantarray; - my $expo = $class -> new($nzeros); + my $expo = $class -> new($nzeros, @r); return ($mant, $expo); } +# Parts used for normalized notation with significand/mantissa as either 0 or a +# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as +# "1.23456789" and "4". + sub nparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("nparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - # Not-a-number. + # Not-a-Number and Infinity. - if ($self -> is_nan()) { - my $mant = $self -> copy(); # mantissa - return $mant unless wantarray; # scalar context - my $expo = $class -> bnan(); # exponent - return ($mant, $expo); # list context - } + return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf(); - # Infinity. + # Upgrade? - if ($self -> is_inf()) { - my $mant = $self -> copy(); # mantissa - return $mant unless wantarray; # scalar context - my $expo = $class -> binf('+'); # exponent - return ($mant, $expo); # list context - } + return $upgrade -> nparts($x, @r) + if defined($upgrade) && !$x -> isa($class); # Finite number. - my ($mant, $expo) = $self -> sparts(); - + my ($mant, $expo) = $x -> sparts(@r); if ($mant -> bcmp(0)) { my ($ndigtot, $ndigfrac) = $mant -> length(); my $expo10adj = $ndigtot - $ndigfrac - 1; - if ($expo10adj != 0) { - return $upgrade -> new($self) -> nparts() if $upgrade; - $mant -> bnan(); + if ($expo10adj > 0) { # if mantissa is not an integer + return $upgrade -> nparts($x, @r) if defined $upgrade; + $mant = $mant -> bnan(@r); return $mant unless wantarray; - $expo -> badd($expo10adj); + $expo = $expo -> badd($expo10adj, @r); return ($mant, $expo); } } @@ -3769,85 +4110,149 @@ sub nparts { return ($mant, $expo); } +# Parts used for engineering notation with significand/mantissa as either 0 or a +# number in the semi-open interval [1,1000) and the exponent is a multiple of 3. +# E.g., "12345.6789" is returned as "12.3456789" and "3". + sub eparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("eparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; # Not-a-number and Infinity. - return $self -> sparts() if $self -> is_nan() || $self -> is_inf(); + return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf(); + + # Upgrade? + + return $upgrade -> eparts($x, @r) + if defined($upgrade) && !$x -> isa($class); # Finite number. - my ($mant, $expo) = $self -> sparts(); + my ($mant, $expo) = $x -> sparts(@r); if ($mant -> bcmp(0)) { my $ndigmant = $mant -> length(); - $expo -> badd($ndigmant); + $expo = $expo -> badd($ndigmant, @r); # $c is the number of digits that will be in the integer part of the # final mantissa. my $c = $expo -> copy() -> bdec() -> bmod(3) -> binc(); - $expo -> bsub($c); + $expo = $expo -> bsub($c); if ($ndigmant > $c) { - return $upgrade -> new($self) -> eparts() if $upgrade; - $mant -> bnan(); + return $upgrade -> eparts($x, @r) if defined $upgrade; + $mant = $mant -> bnan(@r); return $mant unless wantarray; return ($mant, $expo); } - $mant -> blsft($c - $ndigmant, 10); + $mant = $mant -> blsft($c - $ndigmant, 10, @r); } return $mant unless wantarray; return ($mant, $expo); } +# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345" +# (integer part) and "0.6789" (fraction part). + sub dparts { - my $self = shift; - my $class = ref $self; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("dparts() is an instance method, not a class method") - unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - my $int = $self -> copy(); + # Not-a-number. + + if ($x -> is_nan()) { + my $int = $class -> bnan(@r); + return $int unless wantarray; + my $frc = $class -> bzero(@r); # or NaN? + return ($int, $frc); + } + + # Infinity. + + if ($x -> is_inf()) { + my $int = $class -> binf($x->{sign}, @r); + return $int unless wantarray; + my $frc = $class -> bzero(@r); + return ($int, $frc); + } + + # Upgrade? + + return $upgrade -> dparts($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number. + + my $int = $x -> copy() -> round(@r); return $int unless wantarray; - my $frc = $class -> bzero(); + my $frc = $class -> bzero(@r); return ($int, $frc); } +# Fractional parts with the numerator and denominator as integers. E.g., +# "123.4375" is returned as "1975" and "16". + sub fparts { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - croak("fparts() is an instance method") unless $class; + # NaN => NaN/NaN - return ($x -> copy(), - $x -> is_nan() ? $class -> bnan() : $class -> bone()); + if ($x -> is_nan()) { + return $class -> bnan(@r) unless wantarray; + return $class -> bnan(@r), $class -> bnan(@r); + } + + # ±Inf => ±Inf/1 + + if ($x -> is_inf()) { + my $numer = $class -> binf($x->{sign}, @r); + return $numer unless wantarray; + my $denom = $class -> bone(@r); + return $numer, $denom; + } + + # Upgrade? + + return $upgrade -> fparts($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # N => N/1 + + my $numer = $x -> copy() -> round(@r); + return $numer unless wantarray; + my $denom = $class -> bone(@r); + return $numer, $denom; } sub numerator { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - croak("numerator() is an instance method") unless $class; + return $upgrade -> numerator($x, @r) + if defined($upgrade) && !$x -> isa($class); - return $x -> copy(); + return $x -> copy() -> round(@r); } sub denominator { - my $x = shift; - my $class = ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - croak("denominator() is an instance method") unless $class; + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - return $x -> is_nan() ? $class -> bnan() : $class -> bone(); + return $upgrade -> denominator($x, @r) + if defined($upgrade) && !$x -> isa($class); + + return $x -> is_nan() ? $class -> bnan(@r) : $class -> bone(@r); } ############################################################################### @@ -3855,12 +4260,24 @@ sub denominator { ############################################################################### sub bstr { - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } + + # Upgrade? + + return $upgrade -> bstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + my $str = $LIB->_str($x->{value}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -3869,125 +4286,223 @@ sub bstr { # written as "1.2345e+4". sub bsstr { - my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } - my ($m, $e) = $x -> parts(); - my $str = $LIB->_str($m->{value}) . 'e+' . $LIB->_str($e->{value}); - return $x->{sign} eq '-' ? "-$str" : $str; + + # Upgrade? + + return $upgrade -> bsstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + my $expo = $LIB -> _zeros($x->{value}); + my $mant = $LIB -> _str($x->{value}); + $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros + + ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; } -# Normalized notation, e.g., "12345" is written as "12345e+0". +# Normalized notation, e.g., "12345" is written as "1.2345e+4". sub bnstr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } - return $x -> bstr() if $x -> is_nan() || $x -> is_inf(); + # Upgrade? - my ($mant, $expo) = $x -> parts(); + return $upgrade -> bnstr($x, @r) + if defined($upgrade) && !$x -> isa($class); - # The "fraction posision" is the position (offset) for the decimal point - # relative to the end of the digit string. + # Finite number - my $fracpos = $mant -> length() - 1; - if ($fracpos == 0) { - my $str = $LIB->_str($mant->{value}) . "e+" . $LIB->_str($expo->{value}); - return $x->{sign} eq '-' ? "-$str" : $str; - } + my $expo = $LIB -> _zeros($x->{value}); + my $mant = $LIB -> _str($x->{value}); + $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros - $expo += $fracpos; - my $mantstr = $LIB->_str($mant -> {value}); - substr($mantstr, -$fracpos, 0) = '.'; + my $mantlen = CORE::length($mant); + if ($mantlen > 1) { + $expo += $mantlen - 1; # adjust exponent + substr $mant, 1, 0, "."; # insert decimal point + } - my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value}); - return $x->{sign} eq '-' ? "-$str" : $str; + ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; } # Engineering notation, e.g., "12345" is written as "12.345e+3". sub bestr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } - my ($mant, $expo) = $x -> parts(); + # Upgrade? - my $sign = $mant -> sign(); - $mant -> babs(); + return $upgrade -> bestr($x, @r) + if defined($upgrade) && !$x -> isa($class); - my $mantstr = $LIB->_str($mant -> {value}); - my $mantlen = CORE::length($mantstr); + # Finite number - my $dotidx = 1; - $expo += $mantlen - 1; + my $expo = $LIB -> _zeros($x->{value}); # number of trailing zeros + my $mant = $LIB -> _str($x->{value}); # mantissa as a string + $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros + my $mantlen = CORE::length($mant); # length of mantissa + $expo += $mantlen; - my $c = $expo -> copy() -> bmod(3); - $expo -= $c; - $dotidx += $c; + my $dotpos = ($expo - 1) % 3 + 1; # offset of decimal point + $expo -= $dotpos; - if ($mantlen < $dotidx) { - $mantstr .= "0" x ($dotidx - $mantlen); - } elsif ($mantlen > $dotidx) { - substr($mantstr, $dotidx, 0) = "."; + if ($dotpos < $mantlen) { + substr $mant, $dotpos, 0, "."; # insert decimal point + } elsif ($dotpos > $mantlen) { + $mant .= "0" x ($dotpos - $mantlen); # append zeros } - my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value}); - return $sign eq "-" ? "-$str" : $str; + ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; } -# Decimal notation, e.g., "12345". +# Decimal notation, e.g., "12345" (no exponent). sub bdstr { - my $x = shift; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN if ($x->{sign} ne '+' && $x->{sign} ne '-') { - return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN - return 'inf'; # +inf + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } - my $str = $LIB->_str($x->{value}); - return $x->{sign} eq '-' ? "-$str" : $str; + # Upgrade? + + return $upgrade -> bdstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value}); +} + +# Fraction notation, e.g., "123.4375" is written as "1975/16", but "123" is +# written as "123", not "123/1". + +sub bfstr { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> bfstr($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number + + ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value}); } sub to_hex { - # return as hex string, with prefixed 0x - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + # return as hex string with no prefix - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_hex($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number my $hex = $LIB->_to_hex($x->{value}); return $x->{sign} eq '-' ? "-$hex" : $hex; } sub to_oct { - # return as octal string, with prefixed 0 - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + # return as octal string with no prefix - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_oct($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number my $oct = $LIB->_to_oct($x->{value}); return $x->{sign} eq '-' ? "-$oct" : $oct; } sub to_bin { - # return as binary string, with prefixed 0b - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + # return as binary string with no prefix - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; + + # Inf and NaN + + if ($x->{sign} ne '+' && $x->{sign} ne '-') { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } + + # Upgrade? + + return $upgrade -> to_bin($x, @r) + if defined($upgrade) && !$x -> isa($class); + + # Finite number my $bin = $LIB->_to_bin($x->{value}); return $x->{sign} eq '-' ? "-$bin" : $bin; @@ -3995,12 +4510,17 @@ sub to_bin { sub to_bytes { # return a byte string - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; croak("to_bytes() requires a finite, non-negative integer") if $x -> is_neg() || ! $x -> is_int(); + return $upgrade -> to_bytes($x, @r) + if defined($upgrade) && !$x -> isa($class); + croak("to_bytes() requires a newer version of the $LIB library.") unless $LIB->can('_to_bytes'); @@ -4009,22 +4529,23 @@ sub to_bytes { sub to_base { # return a base anything string - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + + # $cs is the collation sequence + my ($class, $x, $base, $cs, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; croak("the value to convert must be a finite, non-negative integer") if $x -> is_neg() || !$x -> is_int(); - my $base = shift; - $base = __PACKAGE__->new($base) unless ref($base); - croak("the base must be a finite integer >= 2") if $base < 2 || ! $base -> is_int(); # If no collating sequence is given, pass some of the conversions to # methods optimized for those cases. - if (! @_) { + unless (defined $cs) { return $x -> to_bin() if $base == 2; return $x -> to_oct() if $base == 8; return uc $x -> to_hex() if $base == 16; @@ -4034,26 +4555,35 @@ sub to_base { croak("to_base() requires a newer version of the $LIB library.") unless $LIB->can('_to_base'); - return $LIB->_to_base($x->{value}, $base -> {value}, @_ ? shift() : ()); + return $upgrade -> to_base($x, $base, $cs, @r) + if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class)); + + return $LIB->_to_base($x->{value}, $base -> {value}, + defined($cs) ? $cs : ()); } sub to_base_num { - my $x = shift; - my $class = ref $x; + # return a base anything array ref, e.g., + # Math::BigInt -> new(255) -> to_base_num(10) returns [2, 5, 5]; + + # $cs is the collation sequence + my ($class, $x, $base, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) + ? (ref($_[0]), @_) : objectify(2, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; - # return a base anything string croak("the value to convert must be a finite non-negative integer") if $x -> is_neg() || !$x -> is_int(); - my $base = shift; - $base = $class -> new($base) unless ref $base; - croak("the base must be a finite integer >= 2") if $base < 2 || ! $base -> is_int(); croak("to_base() requires a newer version of the $LIB library.") unless $LIB->can('_to_base'); + return $upgrade -> to_base_num($x, $base, @r) + if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class)); + # Get a reference to an array of library thingies, and replace each element # with a Math::BigInt object using that thingy. @@ -4070,33 +4600,48 @@ sub to_base_num { sub as_hex { # return as hex string, with prefixed 0x - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return $upgrade -> as_hex($x, @r) + if defined($upgrade) && !$x -> isa($class); + my $hex = $LIB->_as_hex($x->{value}); return $x->{sign} eq '-' ? "-$hex" : $hex; } sub as_oct { # return as octal string, with prefixed 0 - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return $upgrade -> as_oct($x, @r) + if defined($upgrade) && !$x -> isa($class); + my $oct = $LIB->_as_oct($x->{value}); return $x->{sign} eq '-' ? "-$oct" : $oct; } sub as_bin { # return as binary string, with prefixed 0b - my $x = shift; - $x = __PACKAGE__->new($x) if !ref($x); + + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return $upgrade -> as_bin($x, @r) + if defined($upgrade) && !$x -> isa($class); + my $bin = $LIB->_as_bin($x->{value}); return $x->{sign} eq '-' ? "-$bin" : $bin; } @@ -4109,8 +4654,9 @@ sub as_bin { sub numify { # Make a Perl scalar number from a Math::BigInt object. - my $x = shift; - $x = __PACKAGE__->new($x) unless ref $x; + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; if ($x -> is_nan()) { require Math::Complex; @@ -4124,6 +4670,9 @@ sub numify { return $x -> is_negative() ? -$inf : $inf; } + return $upgrade -> numify($x, @r) + if defined($upgrade) && !$x -> isa($class); + my $num = 0 + $LIB->_num($x->{value}); return $x->{sign} eq '-' ? -$num : $num; } @@ -4481,116 +5030,6 @@ sub import { # import done } -sub _split { - # input: num_str; output: undef for invalid or - # (\$mantissa_sign, \$mantissa_value, \$mantissa_fraction, - # \$exp_sign, \$exp_value) - # Internal, take apart a string and return the pieces. - # Strip leading/trailing whitespace, leading zeros, underscore and reject - # invalid input. - my $x = shift; - - # strip white space at front, also extraneous leading zeros - $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2' - $x =~ s/^\s+//; # but this will - $x =~ s/\s+$//g; # strip white space at end - - # shortcut, if nothing to split, return early - if ($x =~ /^[+-]?[0-9]+\z/) { - $x =~ s/^([+-])0*([0-9])/$2/; - my $sign = $1 || '+'; - return (\$sign, \$x, \'', \'', \0); - } - - # invalid starting char? - return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/; - - return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/; # hex string - return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/; # binary string - - # strip underscores between digits - $x =~ s/([0-9])_([0-9])/$1$2/g; - $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3 - - # some possible inputs: - # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2 - # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999 - - my ($m, $e, $last) = split /[Ee]/, $x; - return if defined $last; # last defined => 1e2E3 or others - $e = '0' if !defined $e || $e eq ""; - - # sign, value for exponent, mantint, mantfrac - my ($es, $ev, $mis, $miv, $mfv); - # valid exponent? - if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros - { - $es = $1; - $ev = $2; - # valid mantissa? - return if $m eq '.' || $m eq ''; - my ($mi, $mf, $lastf) = split /\./, $m; - return if defined $lastf; # lastf defined => 1.2.3 or others - $mi = '0' if !defined $mi; - $mi .= '0' if $mi =~ /^[\-\+]?$/; - $mf = '0' if !defined $mf || $mf eq ''; - if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros - { - $mis = $1 || '+'; - $miv = $2; - return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros - $mfv = $1; - # handle the 0e999 case here - $ev = 0 if $miv eq '0' && $mfv eq ''; - return (\$mis, \$miv, \$mfv, \$es, \$ev); - } - } - 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; @@ -4643,7 +5082,8 @@ sub _find_round_parameters { if (!defined $a) { foreach ($self, @args) { # take the defined one, or if both defined, the one that is smaller - $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); + $a = $_->{_a} + if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); } } if (!defined $p) { @@ -4651,7 +5091,8 @@ sub _find_round_parameters { foreach ($self, @args) { # take the defined one, or if both defined, the one that is bigger # -2 > -3, and 3 > 2 - $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); + $p = $_->{_p} + if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } } @@ -4679,13 +5120,29 @@ sub _find_round_parameters { ($self, $a, $p, $r); } +# Return true if the input is numeric and false if it is a string. + +sub _is_numeric { + shift; # class name + my $value = shift; + no warnings 'numeric'; + # detect numbers + # string & "" -> "" + # number & "" -> 0 (with warning) + # nan and inf can detect as numbers, so check with * 0 + return unless CORE::length((my $dummy = "") & $value); + return unless 0 + $value eq $value; + return 1 if $value * 0 == 0; + return -1; # Inf/NaN +} + # 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; + shift; # class name my $sig_sgn = shift() || '+'; my $sig_str = shift() || '0'; @@ -4703,6 +5160,7 @@ sub _trim_split_parts { $exp_str =~ tr/_//d; # "01_234" -> "01234" $exp_str =~ s/^0+//; # "01234" -> "1234" $exp_str = '0' unless CORE::length($exp_str); + $exp_sgn = '+' if $exp_str eq '0'; # "+3e-0" -> "+3e+0" return $sig_sgn, $sig_str, $exp_sgn, $exp_str; } @@ -4722,7 +5180,7 @@ sub _trim_split_parts { # # "10.01e+01" -sub _dec_str_to_str_parts { +sub _dec_str_to_dec_str_parts { my $class = shift; my $str = shift; @@ -4785,7 +5243,7 @@ sub _dec_str_to_str_parts { # "x_1_0" # "_1_0" -sub _hex_str_to_str_parts { +sub _hex_str_to_hex_str_parts { my $class = shift; my $str = shift; @@ -4839,7 +5297,7 @@ sub _hex_str_to_str_parts { # 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 { +sub _oct_str_to_oct_str_parts { my $class = shift; my $str = shift; @@ -4893,7 +5351,7 @@ sub _oct_str_to_str_parts { # 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 { +sub _bin_str_to_bin_str_parts { my $class = shift; my $str = shift; @@ -4947,8 +5405,8 @@ sub _bin_str_to_str_parts { # 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; +sub _dec_str_parts_to_flt_lib_parts { + shift; # class name my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_; @@ -4979,8 +5437,7 @@ sub _dec_parts_to_lib_parts { $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, '+'); + ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); $sig_str =~ s/^0+//; } @@ -5017,8 +5474,8 @@ sub _dec_parts_to_lib_parts { # 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; +sub _bin_str_parts_to_flt_lib_parts { + shift; # class name my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_; my $bpc_lib = $LIB -> _new($bpc); @@ -5052,8 +5509,7 @@ sub _bin_parts_to_lib_parts { $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, '+'); + ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); $sig_str =~ s/^0+//; } @@ -5135,11 +5591,11 @@ sub _bin_parts_to_lib_parts { # 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 { +sub _hex_str_to_flt_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 + if (my @parts = $class -> _hex_str_to_hex_str_parts($str)) { + return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 4); # 4 bits pr. chr } return; } @@ -5149,11 +5605,11 @@ sub _hex_str_to_lib_parts { # libray thingy, the sign of the exponent, and the absolute value of the # exponent as a library thingy. -sub _oct_str_to_lib_parts { +sub _oct_str_to_flt_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 + if (my @parts = $class -> _oct_str_to_oct_str_parts($str)) { + return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 3); # 3 bits pr. chr } return; } @@ -5163,11 +5619,11 @@ sub _oct_str_to_lib_parts { # libray thingy, the sign of the exponent, and the absolute value of the # exponent as a library thingy. -sub _bin_str_to_lib_parts { +sub _bin_str_to_flt_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 + if (my @parts = $class -> _bin_str_to_bin_str_parts($str)) { + return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 1); # 1 bit pr. chr } return; } @@ -5176,11 +5632,11 @@ sub _bin_str_to_lib_parts { # 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 { +sub _dec_str_to_flt_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); + if (my @parts = $class -> _dec_str_to_dec_str_parts($str)) { + return $class -> _dec_str_parts_to_flt_lib_parts(@parts); } return; } @@ -5190,8 +5646,8 @@ sub _dec_str_to_lib_parts { 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); + if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_flt_str(@parts); } return; } @@ -5201,8 +5657,8 @@ sub hex_str_to_dec_flt_str { 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); + if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_flt_str(@parts); } return; } @@ -5212,8 +5668,8 @@ sub oct_str_to_dec_flt_str { 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); + if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_flt_str(@parts); } return; } @@ -5223,8 +5679,8 @@ sub bin_str_to_dec_flt_str { 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); + if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_flt_str(@parts); } return; } @@ -5234,8 +5690,8 @@ sub dec_str_to_dec_flt_str { 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); + if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_dec_str(@parts); } return; } @@ -5245,8 +5701,8 @@ sub hex_str_to_dec_str { 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); + if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_dec_str(@parts); } return; } @@ -5256,8 +5712,8 @@ sub oct_str_to_dec_str { 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); + if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_dec_str(@parts); } return; } @@ -5267,20 +5723,20 @@ sub bin_str_to_dec_str { 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); + if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { + return $class -> _flt_lib_parts_to_dec_str(@parts); } return; } -sub _lib_parts_to_flt_str { +sub _flt_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 { +sub _flt_lib_parts_to_dec_str { my $class = shift; my @parts = @_; @@ -5308,6 +5764,55 @@ sub _lib_parts_to_dec_str { } } +# Takes four arguments, 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, and returns three parts: the sign +# of the rational number, the absolute value of the numerator as a libray +# thingy, and the absolute value of the denominator as a library thingy. +# +# For example, to convert data representing the value "+12e-2", then +# +# $sm = "+"; +# $m = $LIB -> _new("12"); +# $se = "-"; +# $e = $LIB -> _new("2"); +# ($sr, $n, $d) = $class -> _flt_lib_parts_to_rat_lib_parts($sm, $m, $se, $e); +# +# returns data representing the same value written as the fraction "+3/25" +# +# $sr = "+" +# $n = $LIB -> _new("3"); +# $d = $LIB -> _new("12"); + +sub _flt_lib_parts_to_rat_lib_parts { + my $self = shift; + my ($msgn, $mabs, $esgn, $eabs) = @_; + + if ($esgn eq '-') { # "12e-2" -> "12/100" -> "3/25" + my $num_lib = $LIB -> _copy($mabs); + my $den_lib = $LIB -> _1ex($LIB -> _num($eabs)); + my $gcd_lib = $LIB -> _gcd($LIB -> _copy($num_lib), $den_lib); + $num_lib = $LIB -> _div($LIB -> _copy($num_lib), $gcd_lib); + $den_lib = $LIB -> _div($den_lib, $gcd_lib); + return $msgn, $num_lib, $den_lib; + } + + elsif (!$LIB -> _is_zero($eabs)) { # "12e+2" -> "1200" -> "1200/1" + return $msgn, $LIB -> _lsft($LIB -> _copy($mabs), $eabs, 10), + $LIB -> _one(); + } + + else { # "12e+0" -> "12" -> "12/1" + return $msgn, $mabs, $LIB -> _one(); + } +} + +# Add the function _register_callback() to Math::BigInt. It is provided for +# backwards compabibility so that old version of Math::BigRat etc. don't +# complain about missing it. + +sub _register_callback { } + ############################################################################### # 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 @@ -5343,10 +5848,6 @@ Math::BigInt - arbitrary size integer math package # to die if Math::BigInt::GMP cannot be found, use # use Math::BigInt only => 'GMP'; - my $str = '1234567890'; - my @values = (64, 74, 18); - my $n = 1; my $sign = '-'; - # Configuration methods (may be used as class methods and instance methods) Math::BigInt->accuracy(); # get class accuracy @@ -5378,8 +5879,10 @@ Math::BigInt - arbitrary size integer math package $x = Math::BigInt->bnan(); # create a Not-A-Number $x = Math::BigInt->bpi(); # returns pi - $y = $x->copy(); # make a copy (unlike $y = $x) - $y = $x->as_int(); # return as a Math::BigInt + $y = $x->copy(); # make a copy (unlike $y = $x) + $y = $x->as_int(); # return as a Math::BigInt + $y = $x->as_float(); # return as a Math::BigFloat + $y = $x->as_rat(); # return as a Math::BigRat # Boolean methods (these don't modify the invocand) @@ -5505,7 +6008,7 @@ Math::BigInt - arbitrary size integer math package $x->bsstr(); # string in scientific notation with integers $x->bnstr(); # string in normalized notation $x->bestr(); # string in engineering notation - $x->bdstr(); # string in decimal notation + $x->bfstr(); # string in fractional notation $x->to_hex(); # as signed hexadecimal string $x->to_bin(); # as signed binary string @@ -6008,6 +6511,14 @@ v1.22, while C<as_int()> was introduced in v1.68. In Math::BigInt, C<as_int()> has the same effect as C<copy()>. +=item as_float() + +Return the argument as a Math::BigFloat object. + +=item as_rat() + +Return the argument as a Math::BigRat object. + =back =head2 Boolean methods @@ -6895,6 +7406,17 @@ corresponds to the output from C<dparts()>. 12000 is returned as "12000" 10000 is returned as "10000" +=item bfstr() + +Returns a string representing the number using fractional notation. The output +corresponds to the output from C<fparts()>. + + 12.345 is returned as "2469/200" + 123.45 is returned as "2469/20" + 1234.5 is returned as "2469/2" + 12345 is returned as "12345" + 123450 is returned as "123450" + =item to_hex() $x->to_hex(); @@ -6918,8 +7440,8 @@ Returns an octal string representation of the number. See also from_oct(). $x = Math::BigInt->new("1667327589"); $s = $x->to_bytes(); # $s = "cafe" -Returns a byte string representation of the number using big endian byte -order. The invocand must be a non-negative, finite integer. See also from_bytes(). +Returns a byte string representation of the number using big endian byte order. +The invocand must be a non-negative, finite integer. See also from_bytes(). =item to_base() @@ -7863,11 +8385,12 @@ strings: use Test::More tests => 3; use Math::BigInt; - $x = Math::BigInt->new('1e56'); $y = 1e56; + $x = Math::BigInt->new('1e56'); + $y = 1e56; is($x,$y); # fails - is($x->bsstr(),$y); # okay + is($x->bsstr(), $y); # okay $y = Math::BigInt->new($y); - is($x,$y); # okay + is($x, $y); # okay Alternatively, simply use C<< <=> >> for comparisons, this always gets it right. There is not yet a way to get a number automatically represented as a diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index c6cb703ad7..a5429dce62 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.999830'; +our $VERSION = '1.999837'; $VERSION =~ tr/_//d; our @ISA = ('Math::BigInt::Lib'); @@ -2248,6 +2248,7 @@ sub _from_bin { # special modulus functions sub _modinv { + # modular multiplicative inverse my ($c, $x, $y) = @_; diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm index 55ba01059b..37fa9b94de 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.999830'; +our $VERSION = '1.999837'; $VERSION =~ tr/_//d; use Carp; @@ -1771,7 +1771,7 @@ sub _modinv { # modulo zero if ($class -> _is_zero($y)) { - return (undef, undef); + return; } # modulo one @@ -1801,7 +1801,7 @@ sub _modinv { } # if the gcd is not 1, there exists no modular multiplicative inverse - return (undef, undef) unless $class -> _is_one($a); + return unless $class -> _is_one($a); ($v, $sign == 1 ? '+' : '-'); } diff --git a/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t b/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t deleted file mode 100644 index 67edea9bf3..0000000000 --- a/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t +++ /dev/null @@ -1,88 +0,0 @@ -# -*- 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 deleted file mode 100644 index f8faa76fc9..0000000000 --- a/cpan/Math-BigInt/t/_bin_str_to_str_parts.t +++ /dev/null @@ -1,58 +0,0 @@ -# -*- 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 deleted file mode 100644 index dd4f4a4137..0000000000 --- a/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t +++ /dev/null @@ -1,69 +0,0 @@ -# -*- 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 deleted file mode 100644 index d94d8cd464..0000000000 --- a/cpan/Math-BigInt/t/_dec_str_to_str_parts.t +++ /dev/null @@ -1,57 +0,0 @@ -# -*- 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 deleted file mode 100644 index 3cf917bb01..0000000000 --- a/cpan/Math-BigInt/t/_e_math.t +++ /dev/null @@ -1,116 +0,0 @@ -# -*- mode: perl; -*- - -# test the helper math routines in Math::BigFloat - -use strict; -use warnings; - -use Test::More tests => 26; - -use Math::BigFloat lib => 'Calc'; - -############################################################################# -# add - -{ - my $a = Math::BigInt::Calc->_new("123"); - my $b = Math::BigInt::Calc->_new("321"); - - test_add(123, 321, '+', '+'); - test_add(123, 321, '+', '-'); - test_add(123, 321, '-', '+'); - - test_add(321, 123, '-', '+'); - test_add(321, 123, '+', '-'); - - test_add(10, 1, '+', '-'); - test_add(10, 1, '-', '+'); - test_add( 1, 10, '-', '+'); - - SKIP: { - skip q|$x -> _zero() does not (yet?) modify the first argument|, 2; - - test_add(123, 123, '-', '+'); - test_add(123, 123, '+', '-'); - } - - test_add(123, 123, '+', '+'); - test_add(123, 123, '-', '-'); - - test_add(0, 0, '-', '+'); - test_add(0, 0, '+', '-'); - test_add(0, 0, '+', '+'); - test_add(0, 0, '-', '-'); # gives "-0"! TODO: fix this! -} - -############################################################################# -# sub - -{ - my $a = Math::BigInt::Calc->_new("123"); - my $b = Math::BigInt::Calc->_new("321"); - - test_sub(123, 321, '+', '-'); - test_sub(123, 321, '-', '+'); - - test_sub(123, 123, '-', '+'); - test_sub(123, 123, '+', '-'); - - SKIP: { - skip q|$x -> _zero() does not (yet?) modify the first argument|, 2; - - test_sub(123, 123, '+', '+'); - test_sub(123, 123, '-', '-'); - } - - test_sub(0, 0, '-', '+'); # gives "-0"! TODO: fix this! - test_sub(0, 0, '+', '-'); - test_sub(0, 0, '+', '+'); - test_sub(0, 0, '-', '-'); -} - -############################################################################### - -sub test_add { - my ($a, $b, $as, $bs) = @_; - - my $aa = Math::BigInt::Calc -> _new($a); - my $bb = Math::BigInt::Calc -> _new($b); - my ($x, $xs) = Math::BigFloat::_e_add($aa, $bb, "$as", "$bs"); - my $got = $xs . Math::BigInt::Calc->_str($x); - - my $expected = sprintf("%+d", "$as$a" + "$bs$b"); - - subtest qq|Math::BigFloat::_e_add($a, $b, "$as", "$bs");| - => sub { - plan tests => 2; - - is($got, $expected, 'output has the correct value'); - is(Math::BigInt::Calc->_str($x), - Math::BigInt::Calc->_str($aa), - 'first operand to _e_add() is modified' - ); - }; -} - -sub test_sub { - my ($a, $b, $as, $bs) = @_; - - my $aa = Math::BigInt::Calc -> _new($a); - my $bb = Math::BigInt::Calc -> _new($b); - my ($x, $xs) = Math::BigFloat::_e_sub($aa, $bb, "$as", "$bs"); - my $got = $xs . Math::BigInt::Calc->_str($x); - - my $expected = sprintf("%+d", "$as$a" - "$bs$b"); - - subtest qq|Math::BigFloat::_e_sub($a, $b, "$as", "$bs");| - => sub { - plan tests => 2; - - is($got, $expected, 'output has the correct value'); - is(Math::BigInt::Calc->_str($x), - Math::BigInt::Calc->_str($aa), - 'first operand to _e_sub() is modified' - ); - }; -} diff --git a/cpan/Math-BigInt/t/_hex_str_to_str_parts.t b/cpan/Math-BigInt/t/_hex_str_to_str_parts.t deleted file mode 100644 index 02bdd1345a..0000000000 --- a/cpan/Math-BigInt/t/_hex_str_to_str_parts.t +++ /dev/null @@ -1,58 +0,0 @@ -# -*- 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 deleted file mode 100644 index c6431f261c..0000000000 --- a/cpan/Math-BigInt/t/_oct_str_to_str_parts.t +++ /dev/null @@ -1,58 +0,0 @@ -# -*- 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/backermann-mbi.t b/cpan/Math-BigInt/t/backermann-mbi.t deleted file mode 100644 index cc32dd1df0..0000000000 --- a/cpan/Math-BigInt/t/backermann-mbi.t +++ /dev/null @@ -1,507 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 858; - -my $class; - -BEGIN { - $class = 'Math::BigInt'; - use_ok($class); -} - -can_ok($class, 'backermann', 'ackermann'); - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($m, $n, $expected) = split /:/; - - # backermann() modifies the invocand. - - { - my ($x, $y); - my $test = qq|\$x = $class->new("$m"); \$y = \$x->backermann("$n");|; - - subtest $test, - sub { - plan tests => 4; - - eval $test; - is($@, "", "'$test' gives emtpy \$\@"); - - is(ref($y), $class, - "'$test' output arg is a $class"); - - is($y -> bstr(), $expected, - "'$test' output arg has the right value"); - - is($x -> bstr(), $expected, - "'$test' invocand has the right value"); - }; - } - - # ackermann() does not modify the invocand. - - { - my ($x, $y); - my $test = qq|\$x = $class->new("$m"); \$y = \$x->ackermann("$n");|; - - subtest $test, - sub { - plan tests => 4; - - eval $test; - is($@, "", "'$test' gives emtpy \$\@"); - - is(ref($y), $class, - "'$test' output arg is a $class"); - - is($y -> bstr(), $expected, - "'$test' output arg has the right value"); - - is($x -> bstr(), $m, - "'$test' invocand has the right value"); - }; - } -} - -__DATA__ - -0:0:1 -0:1:2 -0:2:3 -0:3:4 -0:4:5 -0:5:6 -0:6:7 -0:7:8 -0:8:9 -0:9:10 -0:10:11 -0:11:12 -0:12:13 -0:13:14 -0:14:15 -0:15:16 -0:16:17 -0:17:18 -0:18:19 -0:19:20 -0:20:21 -0:21:22 -0:22:23 -0:23:24 -0:24:25 -0:25:26 -0:26:27 -0:27:28 -0:28:29 -0:29:30 -0:30:31 -0:31:32 -0:32:33 -0:33:34 -0:34:35 -0:35:36 -0:36:37 -0:37:38 -0:38:39 -0:39:40 -0:40:41 -0:41:42 -0:42:43 -0:43:44 -0:44:45 -0:45:46 -0:46:47 -0:47:48 -0:48:49 -0:49:50 -0:50:51 -0:51:52 -0:52:53 -0:53:54 -0:54:55 -0:55:56 -0:56:57 -0:57:58 -0:58:59 -0:59:60 -0:60:61 -0:61:62 -0:62:63 -0:63:64 -0:64:65 -0:65:66 -0:66:67 -0:67:68 -0:68:69 -0:69:70 -0:70:71 -0:71:72 -0:72:73 -0:73:74 -0:74:75 -0:75:76 -0:76:77 -0:77:78 -0:78:79 -0:79:80 -0:80:81 -0:81:82 -0:82:83 -0:83:84 -0:84:85 -0:85:86 -0:86:87 -0:87:88 -0:88:89 -0:89:90 -0:90:91 -0:91:92 -0:92:93 -0:93:94 -0:94:95 -0:95:96 -0:96:97 -0:97:98 -0:98:99 -0:99:100 -0:100:101 -0:1000:1001 -0:100000:100001 -0:10000000:10000001 -0:10000000000:10000000001 -0:10000000000000:10000000000001 -0:10000000000000000000000000000000000:10000000000000000000000000000000001 -0:12345678987654321012345678987654321:12345678987654321012345678987654322 - -1:0:2 -1:1:3 -1:2:4 -1:3:5 -1:4:6 -1:5:7 -1:6:8 -1:7:9 -1:8:10 -1:9:11 -1:10:12 -1:11:13 -1:12:14 -1:13:15 -1:14:16 -1:15:17 -1:16:18 -1:17:19 -1:18:20 -1:19:21 -1:20:22 -1:21:23 -1:22:24 -1:23:25 -1:24:26 -1:25:27 -1:26:28 -1:27:29 -1:28:30 -1:29:31 -1:30:32 -1:31:33 -1:32:34 -1:33:35 -1:34:36 -1:35:37 -1:36:38 -1:37:39 -1:38:40 -1:39:41 -1:40:42 -1:41:43 -1:42:44 -1:43:45 -1:44:46 -1:45:47 -1:46:48 -1:47:49 -1:48:50 -1:49:51 -1:50:52 -1:51:53 -1:52:54 -1:53:55 -1:54:56 -1:55:57 -1:56:58 -1:57:59 -1:58:60 -1:59:61 -1:60:62 -1:61:63 -1:62:64 -1:63:65 -1:64:66 -1:65:67 -1:66:68 -1:67:69 -1:68:70 -1:69:71 -1:70:72 -1:71:73 -1:72:74 -1:73:75 -1:74:76 -1:75:77 -1:76:78 -1:77:79 -1:78:80 -1:79:81 -1:80:82 -1:81:83 -1:82:84 -1:83:85 -1:84:86 -1:85:87 -1:86:88 -1:87:89 -1:88:90 -1:89:91 -1:90:92 -1:91:93 -1:92:94 -1:93:95 -1:94:96 -1:95:97 -1:96:98 -1:97:99 -1:98:100 -1:99:101 -1:100:102 -1:1000:1002 -1:100000:100002 -1:10000000:10000002 -1:10000000000:10000000002 -1:10000000000000:10000000000002 -1:10000000000000000000000000000000000:10000000000000000000000000000000002 -1:12345678987654321012345678987654321:12345678987654321012345678987654323 - -2:0:3 -2:1:5 -2:2:7 -2:3:9 -2:4:11 -2:5:13 -2:6:15 -2:7:17 -2:8:19 -2:9:21 -2:10:23 -2:11:25 -2:12:27 -2:13:29 -2:14:31 -2:15:33 -2:16:35 -2:17:37 -2:18:39 -2:19:41 -2:20:43 -2:21:45 -2:22:47 -2:23:49 -2:24:51 -2:25:53 -2:26:55 -2:27:57 -2:28:59 -2:29:61 -2:30:63 -2:31:65 -2:32:67 -2:33:69 -2:34:71 -2:35:73 -2:36:75 -2:37:77 -2:38:79 -2:39:81 -2:40:83 -2:41:85 -2:42:87 -2:43:89 -2:44:91 -2:45:93 -2:46:95 -2:47:97 -2:48:99 -2:49:101 -2:50:103 -2:51:105 -2:52:107 -2:53:109 -2:54:111 -2:55:113 -2:56:115 -2:57:117 -2:58:119 -2:59:121 -2:60:123 -2:61:125 -2:62:127 -2:63:129 -2:64:131 -2:65:133 -2:66:135 -2:67:137 -2:68:139 -2:69:141 -2:70:143 -2:71:145 -2:72:147 -2:73:149 -2:74:151 -2:75:153 -2:76:155 -2:77:157 -2:78:159 -2:79:161 -2:80:163 -2:81:165 -2:82:167 -2:83:169 -2:84:171 -2:85:173 -2:86:175 -2:87:177 -2:88:179 -2:89:181 -2:90:183 -2:91:185 -2:92:187 -2:93:189 -2:94:191 -2:95:193 -2:96:195 -2:97:197 -2:98:199 -2:99:201 -2:100:203 -2:1000:2003 -2:100000:200003 -2:10000000:20000003 -2:10000000000:20000000003 -2:10000000000000:20000000000003 -2:10000000000000000000000000000000000:20000000000000000000000000000000003 -2:12345678987654321012345678987654321:24691357975308642024691357975308645 - -3:0:5 -3:1:13 -3:2:29 -3:3:61 -3:4:125 -3:5:253 -3:6:509 -3:7:1021 -3:8:2045 -3:9:4093 -3:10:8189 -3:11:16381 -3:12:32765 -3:13:65533 -3:14:131069 -3:15:262141 -3:16:524285 -3:17:1048573 -3:18:2097149 -3:19:4194301 -3:20:8388605 -3:21:16777213 -3:22:33554429 -3:23:67108861 -3:24:134217725 -3:25:268435453 -3:26:536870909 -3:27:1073741821 -3:28:2147483645 -3:29:4294967293 -3:30:8589934589 -3:31:17179869181 -3:32:34359738365 -3:33:68719476733 -3:34:137438953469 -3:35:274877906941 -3:36:549755813885 -3:37:1099511627773 -3:38:2199023255549 -3:39:4398046511101 -3:40:8796093022205 -3:41:17592186044413 -3:42:35184372088829 -3:43:70368744177661 -3:44:140737488355325 -3:45:281474976710653 -3:46:562949953421309 -3:47:1125899906842621 -3:48:2251799813685245 -3:49:4503599627370493 -3:50:9007199254740989 -3:51:18014398509481981 -3:52:36028797018963965 -3:53:72057594037927933 -3:54:144115188075855869 -3:55:288230376151711741 -3:56:576460752303423485 -3:57:1152921504606846973 -3:58:2305843009213693949 -3:59:4611686018427387901 -3:60:9223372036854775805 -3:61:18446744073709551613 -3:62:36893488147419103229 -3:63:73786976294838206461 -3:64:147573952589676412925 -3:65:295147905179352825853 -3:66:590295810358705651709 -3:67:1180591620717411303421 -3:68:2361183241434822606845 -3:69:4722366482869645213693 -3:70:9444732965739290427389 -3:71:18889465931478580854781 -3:72:37778931862957161709565 -3:73:75557863725914323419133 -3:74:151115727451828646838269 -3:75:302231454903657293676541 -3:76:604462909807314587353085 -3:77:1208925819614629174706173 -3:78:2417851639229258349412349 -3:79:4835703278458516698824701 -3:80:9671406556917033397649405 -3:81:19342813113834066795298813 -3:82:38685626227668133590597629 -3:83:77371252455336267181195261 -3:84:154742504910672534362390525 -3:85:309485009821345068724781053 -3:86:618970019642690137449562109 -3:87:1237940039285380274899124221 -3:88:2475880078570760549798248445 -3:89:4951760157141521099596496893 -3:90:9903520314283042199192993789 -3:91:19807040628566084398385987581 -3:92:39614081257132168796771975165 -3:93:79228162514264337593543950333 -3:94:158456325028528675187087900669 -3:95:316912650057057350374175801341 -3:96:633825300114114700748351602685 -3:97:1267650600228229401496703205373 -3:98:2535301200456458802993406410749 -3:99:5070602400912917605986812821501 -3:100:10141204801825835211973625643005 - -4:0:13 -4:1:65533 - -5:0:65533 diff --git a/cpan/Math-BigInt/t/bare_mbi.t b/cpan/Math-BigInt/t/bare_mbi.t index f3509cfa45..76c9069968 100644 --- a/cpan/Math-BigInt/t/bare_mbi.t +++ b/cpan/Math-BigInt/t/bare_mbi.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4280; # tests in require'd file +use Test::More tests => 4278; # tests in require'd file use lib 't'; diff --git a/cpan/Math-BigInt/t/bdigitsum-mbi.t b/cpan/Math-BigInt/t/bdigitsum-mbi.t deleted file mode 100644 index 0991191317..0000000000 --- a/cpan/Math-BigInt/t/bdigitsum-mbi.t +++ /dev/null @@ -1,113 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 48; - -use Math::BigInt; - -my $x; -my $y; - -############################################################################### -# bdigitsum() - -# Finite numbers. - -$x = Math::BigInt -> new("123"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "6"); -is($y, "6"); - -$x = Math::BigInt -> new("0"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "0"); -is($y, "0"); - -$x = Math::BigInt -> new("-123"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "6"); -is($y, "6"); - -# Infinity - -$x = Math::BigInt -> binf("+"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "NaN"); -is($y, "NaN"); - -$x = Math::BigInt -> binf("-"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "NaN"); -is($y, "NaN"); - -# NaN - -$x = Math::BigInt -> bnan(); -isa_ok($x, 'Math::BigInt'); -$y = $x -> bdigitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "NaN"); -is($y, "NaN"); - -############################################################################### -# digitsum() - -# Finite numbers. - -$x = Math::BigInt -> new("123"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "123"); -is($y, "6"); - -$x = Math::BigInt -> new("0"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "0"); -is($y, "0"); - -$x = Math::BigInt -> new("-123"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "-123"); -is($y, "6"); - -# Infinity - -$x = Math::BigInt -> binf("+"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "inf"); -is($y, "NaN"); - -$x = Math::BigInt -> binf("-"); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "-inf"); -is($y, "NaN"); - -# NaN - -$x = Math::BigInt -> bnan(); -isa_ok($x, 'Math::BigInt'); -$y = $x -> digitsum(); -isa_ok($y, 'Math::BigInt'); -is($x, "NaN"); -is($y, "NaN"); diff --git a/cpan/Math-BigInt/t/bdstr-mbf.t b/cpan/Math-BigInt/t/bdstr-mbf.t deleted file mode 100644 index 950ae6f279..0000000000 --- a/cpan/Math-BigInt/t/bdstr-mbf.t +++ /dev/null @@ -1,275 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 460; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - my $test = qq|\$x = Math::BigFloat -> new("$x_str");| - . qq| \$str = \$x -> bdstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0 - -# positive numbers - -0.000000000001:0.000000000001 -0.00000000001:0.00000000001 -0.0000000001:0.0000000001 -0.000000001:0.000000001 -0.00000001:0.00000001 -0.0000001:0.0000001 -0.000001:0.000001 -0.00001:0.00001 -0.0001:0.0001 -0.001:0.001 -0.01:0.01 -0.1:0.1 -1:1 -10:10 -100:100 -1000:1000 -10000:10000 -100000:100000 -1000000:1000000 -10000000:10000000 -100000000:100000000 -1000000000:1000000000 -10000000000:10000000000 -100000000000:100000000000 -1000000000000:1000000000000 - -0.0000000000012:0.0000000000012 -0.000000000012:0.000000000012 -0.00000000012:0.00000000012 -0.0000000012:0.0000000012 -0.000000012:0.000000012 -0.00000012:0.00000012 -0.0000012:0.0000012 -0.000012:0.000012 -0.00012:0.00012 -0.0012:0.0012 -0.012:0.012 -0.12:0.12 -1.2:1.2 -12:12 -120:120 -1200:1200 -12000:12000 -120000:120000 -1200000:1200000 -12000000:12000000 -120000000:120000000 -1200000000:1200000000 -12000000000:12000000000 -120000000000:120000000000 -1200000000000:1200000000000 - -0.00000000000123:0.00000000000123 -0.0000000000123:0.0000000000123 -0.000000000123:0.000000000123 -0.00000000123:0.00000000123 -0.0000000123:0.0000000123 -0.000000123:0.000000123 -0.00000123:0.00000123 -0.0000123:0.0000123 -0.000123:0.000123 -0.00123:0.00123 -0.0123:0.0123 -0.123:0.123 -1.23:1.23 -12.3:12.3 -123:123 -1230:1230 -12300:12300 -123000:123000 -1230000:1230000 -12300000:12300000 -123000000:123000000 -1230000000:1230000000 -12300000000:12300000000 -123000000000:123000000000 -1230000000000:1230000000000 - -0.000000000001234:0.000000000001234 -0.00000000001234:0.00000000001234 -0.0000000001234:0.0000000001234 -0.000000001234:0.000000001234 -0.00000001234:0.00000001234 -0.0000001234:0.0000001234 -0.000001234:0.000001234 -0.00001234:0.00001234 -0.0001234:0.0001234 -0.001234:0.001234 -0.01234:0.01234 -0.1234:0.1234 -1.234:1.234 -12.34:12.34 -123.4:123.4 -1234:1234 -12340:12340 -123400:123400 -1234000:1234000 -12340000:12340000 -123400000:123400000 -1234000000:1234000000 -12340000000:12340000000 -123400000000:123400000000 -1234000000000:1234000000000 - -0.000003141592:0.000003141592 -0.00003141592:0.00003141592 -0.0003141592:0.0003141592 -0.003141592:0.003141592 -0.03141592:0.03141592 -0.3141592:0.3141592 -3.141592:3.141592 -31.41592:31.41592 -314.1592:314.1592 -3141.592:3141.592 -31415.92:31415.92 -314159.2:314159.2 -3141592:3141592 - -# negative numbers - --0.000000000001:-0.000000000001 --0.00000000001:-0.00000000001 --0.0000000001:-0.0000000001 --0.000000001:-0.000000001 --0.00000001:-0.00000001 --0.0000001:-0.0000001 --0.000001:-0.000001 --0.00001:-0.00001 --0.0001:-0.0001 --0.001:-0.001 --0.01:-0.01 --0.1:-0.1 --1:-1 --10:-10 --100:-100 --1000:-1000 --10000:-10000 --100000:-100000 --1000000:-1000000 --10000000:-10000000 --100000000:-100000000 --1000000000:-1000000000 --10000000000:-10000000000 --100000000000:-100000000000 --1000000000000:-1000000000000 - --0.0000000000012:-0.0000000000012 --0.000000000012:-0.000000000012 --0.00000000012:-0.00000000012 --0.0000000012:-0.0000000012 --0.000000012:-0.000000012 --0.00000012:-0.00000012 --0.0000012:-0.0000012 --0.000012:-0.000012 --0.00012:-0.00012 --0.0012:-0.0012 --0.012:-0.012 --0.12:-0.12 --1.2:-1.2 --12:-12 --120:-120 --1200:-1200 --12000:-12000 --120000:-120000 --1200000:-1200000 --12000000:-12000000 --120000000:-120000000 --1200000000:-1200000000 --12000000000:-12000000000 --120000000000:-120000000000 --1200000000000:-1200000000000 - --0.00000000000123:-0.00000000000123 --0.0000000000123:-0.0000000000123 --0.000000000123:-0.000000000123 --0.00000000123:-0.00000000123 --0.0000000123:-0.0000000123 --0.000000123:-0.000000123 --0.00000123:-0.00000123 --0.0000123:-0.0000123 --0.000123:-0.000123 --0.00123:-0.00123 --0.0123:-0.0123 --0.123:-0.123 --1.23:-1.23 --12.3:-12.3 --123:-123 --1230:-1230 --12300:-12300 --123000:-123000 --1230000:-1230000 --12300000:-12300000 --123000000:-123000000 --1230000000:-1230000000 --12300000000:-12300000000 --123000000000:-123000000000 --1230000000000:-1230000000000 - --0.000000000001234:-0.000000000001234 --0.00000000001234:-0.00000000001234 --0.0000000001234:-0.0000000001234 --0.000000001234:-0.000000001234 --0.00000001234:-0.00000001234 --0.0000001234:-0.0000001234 --0.000001234:-0.000001234 --0.00001234:-0.00001234 --0.0001234:-0.0001234 --0.001234:-0.001234 --0.01234:-0.01234 --0.1234:-0.1234 --1.234:-1.234 --12.34:-12.34 --123.4:-123.4 --1234:-1234 --12340:-12340 --123400:-123400 --1234000:-1234000 --12340000:-12340000 --123400000:-123400000 --1234000000:-1234000000 --12340000000:-12340000000 --123400000000:-123400000000 --1234000000000:-1234000000000 - --0.000003141592:-0.000003141592 --0.00003141592:-0.00003141592 --0.0003141592:-0.0003141592 --0.003141592:-0.003141592 --0.03141592:-0.03141592 --0.3141592:-0.3141592 --3.141592:-3.141592 --31.41592:-31.41592 --314.1592:-314.1592 --3141.592:-3141.592 --31415.92:-31415.92 --314159.2:-314159.2 --3141592:-3141592 diff --git a/cpan/Math-BigInt/t/bdstr-mbi.t b/cpan/Math-BigInt/t/bdstr-mbi.t deleted file mode 100644 index 68671619cf..0000000000 --- a/cpan/Math-BigInt/t/bdstr-mbi.t +++ /dev/null @@ -1,155 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 220; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - my $test = qq|\$x = Math::BigInt -> new("$x_str");| - . qq| \$str = \$x -> bdstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0 - -# positive numbers - -1:1 -10:10 -100:100 -1000:1000 -10000:10000 -100000:100000 -1000000:1000000 -10000000:10000000 -100000000:100000000 -1000000000:1000000000 -10000000000:10000000000 -100000000000:100000000000 -1000000000000:1000000000000 - -12:12 -120:120 -1200:1200 -12000:12000 -120000:120000 -1200000:1200000 -12000000:12000000 -120000000:120000000 -1200000000:1200000000 -12000000000:12000000000 -120000000000:120000000000 -1200000000000:1200000000000 - -123:123 -1230:1230 -12300:12300 -123000:123000 -1230000:1230000 -12300000:12300000 -123000000:123000000 -1230000000:1230000000 -12300000000:12300000000 -123000000000:123000000000 -1230000000000:1230000000000 - -1234:1234 -12340:12340 -123400:123400 -1234000:1234000 -12340000:12340000 -123400000:123400000 -1234000000:1234000000 -12340000000:12340000000 -123400000000:123400000000 -1234000000000:1234000000000 - -3:3 -31:31 -314:314 -3141:3141 -31415:31415 -314159:314159 -3141592:3141592 - -# negative numbers - --1:-1 --10:-10 --100:-100 --1000:-1000 --10000:-10000 --100000:-100000 --1000000:-1000000 --10000000:-10000000 --100000000:-100000000 --1000000000:-1000000000 --10000000000:-10000000000 --100000000000:-100000000000 --1000000000000:-1000000000000 - --12:-12 --120:-120 --1200:-1200 --12000:-12000 --120000:-120000 --1200000:-1200000 --12000000:-12000000 --120000000:-120000000 --1200000000:-1200000000 --12000000000:-12000000000 --120000000000:-120000000000 --1200000000000:-1200000000000 - --123:-123 --1230:-1230 --12300:-12300 --123000:-123000 --1230000:-1230000 --12300000:-12300000 --123000000:-123000000 --1230000000:-1230000000 --12300000000:-12300000000 --123000000000:-123000000000 --1230000000000:-1230000000000 - --1234:-1234 --12340:-12340 --123400:-123400 --1234000:-1234000 --12340000:-12340000 --123400000:-123400000 --1234000000:-1234000000 --12340000000:-12340000000 --123400000000:-123400000000 --1234000000000:-1234000000000 - --3:-3 --31:-31 --314:-314 --3141:-3141 --31415:-31415 --314159:-314159 --3141592:-3141592 diff --git a/cpan/Math-BigInt/t/bestr-mbf.t b/cpan/Math-BigInt/t/bestr-mbf.t deleted file mode 100644 index 12277a5272..0000000000 --- a/cpan/Math-BigInt/t/bestr-mbf.t +++ /dev/null @@ -1,275 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 460; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - my $test = qq|\$x = Math::BigFloat -> new("$x_str");| - . qq| \$str = \$x -> bestr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -0.000000000001:1e-12 -0.00000000001:10e-12 -0.0000000001:100e-12 -0.000000001:1e-9 -0.00000001:10e-9 -0.0000001:100e-9 -0.000001:1e-6 -0.00001:10e-6 -0.0001:100e-6 -0.001:1e-3 -0.01:10e-3 -0.1:100e-3 -1:1e+0 -10:10e+0 -100:100e+0 -1000:1e+3 -10000:10e+3 -100000:100e+3 -1000000:1e+6 -10000000:10e+6 -100000000:100e+6 -1000000000:1e+9 -10000000000:10e+9 -100000000000:100e+9 -1000000000000:1e+12 - -0.0000000000012:1.2e-12 -0.000000000012:12e-12 -0.00000000012:120e-12 -0.0000000012:1.2e-9 -0.000000012:12e-9 -0.00000012:120e-9 -0.0000012:1.2e-6 -0.000012:12e-6 -0.00012:120e-6 -0.0012:1.2e-3 -0.012:12e-3 -0.12:120e-3 -1.2:1.2e+0 -12:12e+0 -120:120e+0 -1200:1.2e+3 -12000:12e+3 -120000:120e+3 -1200000:1.2e+6 -12000000:12e+6 -120000000:120e+6 -1200000000:1.2e+9 -12000000000:12e+9 -120000000000:120e+9 -1200000000000:1.2e+12 - -0.00000000000123:1.23e-12 -0.0000000000123:12.3e-12 -0.000000000123:123e-12 -0.00000000123:1.23e-9 -0.0000000123:12.3e-9 -0.000000123:123e-9 -0.00000123:1.23e-6 -0.0000123:12.3e-6 -0.000123:123e-6 -0.00123:1.23e-3 -0.0123:12.3e-3 -0.123:123e-3 -1.23:1.23e+0 -12.3:12.3e+0 -123:123e+0 -1230:1.23e+3 -12300:12.3e+3 -123000:123e+3 -1230000:1.23e+6 -12300000:12.3e+6 -123000000:123e+6 -1230000000:1.23e+9 -12300000000:12.3e+9 -123000000000:123e+9 -1230000000000:1.23e+12 - -0.000000000001234:1.234e-12 -0.00000000001234:12.34e-12 -0.0000000001234:123.4e-12 -0.000000001234:1.234e-9 -0.00000001234:12.34e-9 -0.0000001234:123.4e-9 -0.000001234:1.234e-6 -0.00001234:12.34e-6 -0.0001234:123.4e-6 -0.001234:1.234e-3 -0.01234:12.34e-3 -0.1234:123.4e-3 -1.234:1.234e+0 -12.34:12.34e+0 -123.4:123.4e+0 -1234:1.234e+3 -12340:12.34e+3 -123400:123.4e+3 -1234000:1.234e+6 -12340000:12.34e+6 -123400000:123.4e+6 -1234000000:1.234e+9 -12340000000:12.34e+9 -123400000000:123.4e+9 -1234000000000:1.234e+12 - -0.000003141592:3.141592e-6 -0.00003141592:31.41592e-6 -0.0003141592:314.1592e-6 -0.003141592:3.141592e-3 -0.03141592:31.41592e-3 -0.3141592:314.1592e-3 -3.141592:3.141592e+0 -31.41592:31.41592e+0 -314.1592:314.1592e+0 -3141.592:3.141592e+3 -31415.92:31.41592e+3 -314159.2:314.1592e+3 -3141592:3.141592e+6 - -# negative numbers - --0.000000000001:-1e-12 --0.00000000001:-10e-12 --0.0000000001:-100e-12 --0.000000001:-1e-9 --0.00000001:-10e-9 --0.0000001:-100e-9 --0.000001:-1e-6 --0.00001:-10e-6 --0.0001:-100e-6 --0.001:-1e-3 --0.01:-10e-3 --0.1:-100e-3 --1:-1e+0 --10:-10e+0 --100:-100e+0 --1000:-1e+3 --10000:-10e+3 --100000:-100e+3 --1000000:-1e+6 --10000000:-10e+6 --100000000:-100e+6 --1000000000:-1e+9 --10000000000:-10e+9 --100000000000:-100e+9 --1000000000000:-1e+12 - --0.0000000000012:-1.2e-12 --0.000000000012:-12e-12 --0.00000000012:-120e-12 --0.0000000012:-1.2e-9 --0.000000012:-12e-9 --0.00000012:-120e-9 --0.0000012:-1.2e-6 --0.000012:-12e-6 --0.00012:-120e-6 --0.0012:-1.2e-3 --0.012:-12e-3 --0.12:-120e-3 --1.2:-1.2e+0 --12:-12e+0 --120:-120e+0 --1200:-1.2e+3 --12000:-12e+3 --120000:-120e+3 --1200000:-1.2e+6 --12000000:-12e+6 --120000000:-120e+6 --1200000000:-1.2e+9 --12000000000:-12e+9 --120000000000:-120e+9 --1200000000000:-1.2e+12 - --0.00000000000123:-1.23e-12 --0.0000000000123:-12.3e-12 --0.000000000123:-123e-12 --0.00000000123:-1.23e-9 --0.0000000123:-12.3e-9 --0.000000123:-123e-9 --0.00000123:-1.23e-6 --0.0000123:-12.3e-6 --0.000123:-123e-6 --0.00123:-1.23e-3 --0.0123:-12.3e-3 --0.123:-123e-3 --1.23:-1.23e+0 --12.3:-12.3e+0 --123:-123e+0 --1230:-1.23e+3 --12300:-12.3e+3 --123000:-123e+3 --1230000:-1.23e+6 --12300000:-12.3e+6 --123000000:-123e+6 --1230000000:-1.23e+9 --12300000000:-12.3e+9 --123000000000:-123e+9 --1230000000000:-1.23e+12 - --0.000000000001234:-1.234e-12 --0.00000000001234:-12.34e-12 --0.0000000001234:-123.4e-12 --0.000000001234:-1.234e-9 --0.00000001234:-12.34e-9 --0.0000001234:-123.4e-9 --0.000001234:-1.234e-6 --0.00001234:-12.34e-6 --0.0001234:-123.4e-6 --0.001234:-1.234e-3 --0.01234:-12.34e-3 --0.1234:-123.4e-3 --1.234:-1.234e+0 --12.34:-12.34e+0 --123.4:-123.4e+0 --1234:-1.234e+3 --12340:-12.34e+3 --123400:-123.4e+3 --1234000:-1.234e+6 --12340000:-12.34e+6 --123400000:-123.4e+6 --1234000000:-1.234e+9 --12340000000:-12.34e+9 --123400000000:-123.4e+9 --1234000000000:-1.234e+12 - --0.000003141592:-3.141592e-6 --0.00003141592:-31.41592e-6 --0.0003141592:-314.1592e-6 --0.003141592:-3.141592e-3 --0.03141592:-31.41592e-3 --0.3141592:-314.1592e-3 --3.141592:-3.141592e+0 --31.41592:-31.41592e+0 --314.1592:-314.1592e+0 --3141.592:-3.141592e+3 --31415.92:-31.41592e+3 --314159.2:-314.1592e+3 --3141592:-3.141592e+6 diff --git a/cpan/Math-BigInt/t/bestr-mbi.t b/cpan/Math-BigInt/t/bestr-mbi.t deleted file mode 100644 index 8c4c0bd518..0000000000 --- a/cpan/Math-BigInt/t/bestr-mbi.t +++ /dev/null @@ -1,155 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 220; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - my $test = qq|\$x = Math::BigInt -> new("$x_str");| - . qq| \$str = \$x -> bestr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -1:1e+0 -10:10e+0 -100:100e+0 -1000:1e+3 -10000:10e+3 -100000:100e+3 -1000000:1e+6 -10000000:10e+6 -100000000:100e+6 -1000000000:1e+9 -10000000000:10e+9 -100000000000:100e+9 -1000000000000:1e+12 - -12:12e+0 -120:120e+0 -1200:1.2e+3 -12000:12e+3 -120000:120e+3 -1200000:1.2e+6 -12000000:12e+6 -120000000:120e+6 -1200000000:1.2e+9 -12000000000:12e+9 -120000000000:120e+9 -1200000000000:1.2e+12 - -123:123e+0 -1230:1.23e+3 -12300:12.3e+3 -123000:123e+3 -1230000:1.23e+6 -12300000:12.3e+6 -123000000:123e+6 -1230000000:1.23e+9 -12300000000:12.3e+9 -123000000000:123e+9 -1230000000000:1.23e+12 - -1234:1.234e+3 -12340:12.34e+3 -123400:123.4e+3 -1234000:1.234e+6 -12340000:12.34e+6 -123400000:123.4e+6 -1234000000:1.234e+9 -12340000000:12.34e+9 -123400000000:123.4e+9 -1234000000000:1.234e+12 - -3:3e+0 -31:31e+0 -314:314e+0 -3141:3.141e+3 -31415:31.415e+3 -314159:314.159e+3 -3141592:3.141592e+6 - -# negative numbers - --1:-1e+0 --10:-10e+0 --100:-100e+0 --1000:-1e+3 --10000:-10e+3 --100000:-100e+3 --1000000:-1e+6 --10000000:-10e+6 --100000000:-100e+6 --1000000000:-1e+9 --10000000000:-10e+9 --100000000000:-100e+9 --1000000000000:-1e+12 - --12:-12e+0 --120:-120e+0 --1200:-1.2e+3 --12000:-12e+3 --120000:-120e+3 --1200000:-1.2e+6 --12000000:-12e+6 --120000000:-120e+6 --1200000000:-1.2e+9 --12000000000:-12e+9 --120000000000:-120e+9 --1200000000000:-1.2e+12 - --123:-123e+0 --1230:-1.23e+3 --12300:-12.3e+3 --123000:-123e+3 --1230000:-1.23e+6 --12300000:-12.3e+6 --123000000:-123e+6 --1230000000:-1.23e+9 --12300000000:-12.3e+9 --123000000000:-123e+9 --1230000000000:-1.23e+12 - --1234:-1.234e+3 --12340:-12.34e+3 --123400:-123.4e+3 --1234000:-1.234e+6 --12340000:-12.34e+6 --123400000:-123.4e+6 --1234000000:-1.234e+9 --12340000000:-12.34e+9 --123400000000:-123.4e+9 --1234000000000:-1.234e+12 - --3:-3e+0 --31:-31e+0 --314:-314e+0 --3141:-3.141e+3 --31415:-31.415e+3 --314159:-314.159e+3 --3141592:-3.141592e+6 diff --git a/cpan/Math-BigInt/t/bfib-mbi.t b/cpan/Math-BigInt/t/bfib-mbi.t deleted file mode 100644 index 91e7aafad5..0000000000 --- a/cpan/Math-BigInt/t/bfib-mbi.t +++ /dev/null @@ -1,86 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 15; - -use Math::BigInt; - -my $x; - -############################################################################### -# Scalar context. -############################################################################### - -my $y; - -# Finite numbers. - -$x = Math::BigInt -> new("-20"); -$y = $x -> bfib(); -is($y, "-6765", "bfib(-20)"); - -$x = Math::BigInt -> new("-15"); -$y = $x -> bfib(); -is($y, "610", "bfib(-15)"); - -$x = Math::BigInt -> new("-2"); -$y = $x -> bfib(); -is($y, "-1", "bfib(-2)"); - -$x = Math::BigInt -> new("-1"); -$y = $x -> bfib(); -is($y, "1", "bfib(-1)"); - -$x = Math::BigInt -> new("0"); -$y = $x -> bfib(); -is($y, "0", "bfib(0)"); - -$x = Math::BigInt -> new("1"); -$y = $x -> bfib(); -is($y, "1", "bfib(1)"); - -$x = Math::BigInt -> new("2"); -$y = $x -> bfib(); -is($y, "1", "bfib(2)"); - -$x = Math::BigInt -> new("15"); -$y = $x -> bfib(); -is($y, "610", "bfib(15)"); - -$x = Math::BigInt -> new("20"); -$y = $x -> bfib(); -is($y, "6765", "bfib(20)"); - -$x = Math::BigInt -> new("250"); -$y = $x -> bfib(); -is($y, "7896325826131730509282738943634332893686268675876375", "bfib(250)"); - -# Infinites and NaN. - -$x = Math::BigInt -> binf("+"); -$y = $x -> bfib(); -is($y, "inf", "bfib(+inf)"); - -$x = Math::BigInt -> binf("-"); -$y = $x -> bfib(); -is($y, "NaN", "bfib(-inf)"); - -$x = Math::BigInt -> bnan(); -$y = $x -> bfib(); -is($y, "NaN", "bfib(NaN)"); - -############################################################################### -# List context. -############################################################################### - -my @y; - -$x = Math::BigInt -> new("10"); -@y = $x -> bfib(); -is_deeply(\@y, [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55], "bfib(10)"); - -$x = Math::BigInt -> new("-10"); -@y = $x -> bfib(); -is_deeply(\@y, [0, 1, -1, 2, -3, 5, -8, 13, -21, 34, -55], "bfib(-10)"); diff --git a/cpan/Math-BigInt/t/bigfltpm.inc b/cpan/Math-BigInt/t/bigfltpm.inc index 0b25505849..bd7e285e23 100644 --- a/cpan/Math-BigInt/t/bigfltpm.inc +++ b/cpan/Math-BigInt/t/bigfltpm.inc @@ -44,7 +44,8 @@ while (<DATA>) { } elsif ($f eq "binf") { $try .= qq| \$x->binf("$args[1]");|; } elsif ($f eq "bone") { - $try .= qq| \$x->bone("$args[1]");|; + $try .= length($args[1]) ? qq| \$x->bone("$args[1]");| + : qq| \$x->bone();|; } elsif ($f eq "bstr") { $try .= qq| \$x->accuracy($args[1]); \$x->precision($args[2]);|; $try .= ' $x->bstr();'; @@ -524,8 +525,8 @@ NaN:10:NaN -inf:10:NaN 1.2:10:0.3623577545 2.4:12:-0.737393715541 -0:10:1 -0:20:1 +0:10:1.000000000 +0:20:1.0000000000000000000 1:10:0.5403023059 1:12:0.540302305868 @@ -867,7 +868,7 @@ abc:NaN 0::1 -2::1 abc::1 -2:abc:1 +2::1 &bsstr +inf:inf diff --git a/cpan/Math-BigInt/t/bigintpm.inc b/cpan/Math-BigInt/t/bigintpm.inc index 3090699b5f..ae029a2a16 100644 --- a/cpan/Math-BigInt/t/bigintpm.inc +++ b/cpan/Math-BigInt/t/bigintpm.inc @@ -1415,13 +1415,12 @@ abc:NaN 2:-:-1 invalid:-:-1 invalid:+:1 -2:abc:1 3::1 &binf 1:+:inf 2:-:-inf -3:abc:inf +3:+inf:inf &is_nan 123:0 diff --git a/cpan/Math-BigInt/t/bigintpm.t b/cpan/Math-BigInt/t/bigintpm.t index 3b78f2e1af..bc234e6b06 100644 --- a/cpan/Math-BigInt/t/bigintpm.t +++ b/cpan/Math-BigInt/t/bigintpm.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4280 # tests in require'd file +use Test::More tests => 4278 # tests in require'd file + 20; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/biglog.t b/cpan/Math-BigInt/t/biglog.t index 6045a6f8c3..79d8fdfa93 100644 --- a/cpan/Math-BigInt/t/biglog.t +++ b/cpan/Math-BigInt/t/biglog.t @@ -36,7 +36,6 @@ is($class->new(2)->bexp(), '7', "$class->new(2)->bexp()"); is($class->new(3)->bexp(), '20', "$class->new(3)->bexp()"); ############################################################################### -############################################################################### # Math::BigFloat tests ############################################################################### @@ -146,7 +145,7 @@ is($class->new("10")->bpow("0.6", 10), "3.981071706", qq|$class->new("10")->bpow("0.6", 10)|); # blog should handle bigint input -is(Math::BigFloat::blog(Math::BigInt->new(100), 10), 2, "blog(100)"); +is(Math::BigFloat->blog(Math::BigInt->new(100), 10), 2, "blog(100)"); ############################################################################### # some integer results @@ -190,9 +189,9 @@ test_bpow('9.86902225', '0.5', undef, '3.1415'); test_bpow('0.2', '0.41', 10, '0.5169187652'); -is($class->new("0.01")->bpow("28.4", 40)->bsstr(), - '1584893192461113485202101373391507013269e-96', - qq|$class->new("0.01")->bpow("28.4", 40)->bsstr()|); +is($class->new("0.1")->bpow("28.4", 40)->bsstr(), + '3981071705534972507702523050877520434877e-68', + qq|$class->new("0.1")->bpow("28.4", 40)->bsstr()|); # The following test takes too long. #is($class->new("2")->bpow("-1034.5", 40)->bsstr(), @@ -231,8 +230,6 @@ is($class->new("-394.84010945715266885")->bexp(20)->bsstr(), # all done -1; - ############################################################################### sub test_bpow { diff --git a/cpan/Math-BigInt/t/blucas-mbi.t b/cpan/Math-BigInt/t/blucas-mbi.t deleted file mode 100644 index 9a9215929f..0000000000 --- a/cpan/Math-BigInt/t/blucas-mbi.t +++ /dev/null @@ -1,86 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 15; - -use Math::BigInt; - -my $x; - -############################################################################### -# Scalar context. -############################################################################### - -my $y; - -# Finite numbers. - -$x = Math::BigInt -> new("-20"); -$y = $x -> blucas(); -is($y, "-15127", "blucas(-20)"); - -$x = Math::BigInt -> new("-15"); -$y = $x -> blucas(); -is($y, "1364", "blucas(-15)"); - -$x = Math::BigInt -> new("-2"); -$y = $x -> blucas(); -is($y, "-3", "blucas(-2)"); - -$x = Math::BigInt -> new("-1"); -$y = $x -> blucas(); -is($y, "1", "blucas(-1)"); - -$x = Math::BigInt -> new("0"); -$y = $x -> blucas(); -is($y, "2", "blucas(0)"); - -$x = Math::BigInt -> new("1"); -$y = $x -> blucas(); -is($y, "1", "blucas(1)"); - -$x = Math::BigInt -> new("2"); -$y = $x -> blucas(); -is($y, "3", "blucas(2)"); - -$x = Math::BigInt -> new("15"); -$y = $x -> blucas(); -is($y, "1364", "blucas(15)"); - -$x = Math::BigInt -> new("20"); -$y = $x -> blucas(); -is($y, "15127", "blucas(20)"); - -$x = Math::BigInt -> new("250"); -$y = $x -> blucas(); -is($y, "17656721319717734662791328845675730903632844218828123", "blucas(250)"); - -# Infinites and NaN. - -$x = Math::BigInt -> binf("+"); -$y = $x -> blucas(); -is($y, "inf", "blucas(+inf)"); - -$x = Math::BigInt -> binf("-"); -$y = $x -> blucas(); -is($y, "NaN", "blucas(-inf)"); - -$x = Math::BigInt -> bnan(); -$y = $x -> blucas(); -is($y, "NaN", "blucas(NaN)"); - -############################################################################### -# List context. -############################################################################### - -my @y; - -$x = Math::BigInt -> new("10"); -@y = $x -> blucas(); -is_deeply(\@y, [2, 1, 3, 4, 7, 11, 18, 29, 47, 76, 123], "blucas(10)"); - -$x = Math::BigInt -> new("-10"); -@y = $x -> blucas(); -is_deeply(\@y, [2, 1, -3, 4, -7, 11, -18, 29, -47, 76, -123], "blucas(-10)"); diff --git a/cpan/Math-BigInt/t/bnok-mbf.t b/cpan/Math-BigInt/t/bnok-mbf.t deleted file mode 100644 index d8b915121b..0000000000 --- a/cpan/Math-BigInt/t/bnok-mbf.t +++ /dev/null @@ -1,1451 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 4957; - -my $class; - -BEGIN { - $class = 'Math::BigFloat'; - use_ok($class); -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($nval, $kval, $nokval) = split /:/; - my ($n, $k, $got, @got); - - for my $context_is_scalar (0, 1) { - for my $k_is_scalar (0, 1) { - - my $test = qq|\$n = $class -> new("$nval");|; - - $test .= $k_is_scalar - ? qq| \$k = "$kval";| - : qq| \$k = $class -> new("$kval");|; - - $test .= $context_is_scalar - ? qq| \$got = \$n -> bnok(\$k);| - : qq| \@got = \$n -> bnok(\$k);|; - - my $desc = "bnok() in "; - $desc .= $context_is_scalar ? "scalar context" : "list context"; - $desc .= $k_is_scalar ? " with k as scalar" : " with k 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(), $nokval, - "'$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(), $nokval, - "'$test' output arg has the right value"); - } - - # Check the invocand. - - is(ref($n), $class, - "'$test' invocand is still a $class"); - - is($n -> bstr(), $nokval, - "'$test' invocand has the right value"); - - # Check the input argument. - - if ($k_is_scalar) { - - is(ref($k), '', - "'$test' second input arg is still a scalar"); - - is($k, $kval, - "'$test' second input arg is unmodified"); - - } else { - - is(ref($k), $class, - "'$test' second input arg is still a $class"); - - is($k -> bstr(), $kval, - "'$test' second input arg is unmodified"); - } - }; - } - } -} - -__DATA__ - -# n and/or k is NaN - -NaN:NaN:NaN -NaN:0:NaN -NaN:3:NaN -3:NaN:NaN -NaN:-3:NaN --3:NaN:NaN - -# n = inf - -inf:-inf:NaN -inf:-3:0 -inf:-2:0 -inf:-1:0 -inf:0:1 -inf:1:inf -inf:2:inf -inf:3:inf -inf:inf:NaN - -# n = -inf - --inf:-inf:NaN --inf:-3:0 --inf:-2:0 --inf:-1:0 --inf:0:1 --inf:1:-inf --inf:2:inf --inf:3:-inf --inf:inf:NaN - -# k = inf - --3:inf:NaN --2:inf:NaN --1:inf:NaN -0:inf:NaN -1:inf:NaN -2:inf:NaN -3:inf:NaN - -# k = -inf - --3:-inf:NaN --2:-inf:NaN --1:-inf:NaN -0:-inf:NaN -1:-inf:NaN -2:-inf:NaN -3:-inf:NaN - -# n = -15, k = n - 15 ... n + 15 - --15:-30:-77558760 --15:-29:40116600 --15:-28:-20058300 --15:-27:9657700 --15:-26:-4457400 --15:-25:1961256 --15:-24:-817190 --15:-23:319770 --15:-22:-116280 --15:-21:38760 --15:-20:-11628 --15:-19:3060 --15:-18:-680 --15:-17:120 --15:-16:-15 --15:-15:1 --15:-14:0 --15:-13:0 --15:-12:0 --15:-11:0 --15:-10:0 --15:-9:0 --15:-8:0 --15:-7:0 --15:-6:0 --15:-5:0 --15:-4:0 --15:-3:0 --15:-2:0 --15:-1:0 --15:0:1 --15:1:-15 --15:2:120 --15:3:-680 --15:4:3060 --15:5:-11628 --15:6:38760 --15:7:-116280 --15:8:319770 --15:9:-817190 --15:10:1961256 --15:11:-4457400 --15:12:9657700 --15:13:-20058300 --15:14:40116600 --15:15:-77558760 - -# n = -14, k = n - 15 ... n + 15 - --14:-29:-37442160 --14:-28:20058300 --14:-27:-10400600 --14:-26:5200300 --14:-25:-2496144 --14:-24:1144066 --14:-23:-497420 --14:-22:203490 --14:-21:-77520 --14:-20:27132 --14:-19:-8568 --14:-18:2380 --14:-17:-560 --14:-16:105 --14:-15:-14 --14:-14:1 --14:-13:0 --14:-12:0 --14:-11:0 --14:-10:0 --14:-9:0 --14:-8:0 --14:-7:0 --14:-6:0 --14:-5:0 --14:-4:0 --14:-3:0 --14:-2:0 --14:-1:0 --14:0:1 --14:1:-14 --14:2:105 --14:3:-560 --14:4:2380 --14:5:-8568 --14:6:27132 --14:7:-77520 --14:8:203490 --14:9:-497420 --14:10:1144066 --14:11:-2496144 --14:12:5200300 --14:13:-10400600 --14:14:20058300 --14:15:-37442160 - -# n = -13, k = n - 15 ... n + 15 - --13:-28:-17383860 --13:-27:9657700 --13:-26:-5200300 --13:-25:2704156 --13:-24:-1352078 --13:-23:646646 --13:-22:-293930 --13:-21:125970 --13:-20:-50388 --13:-19:18564 --13:-18:-6188 --13:-17:1820 --13:-16:-455 --13:-15:91 --13:-14:-13 --13:-13:1 --13:-12:0 --13:-11:0 --13:-10:0 --13:-9:0 --13:-8:0 --13:-7:0 --13:-6:0 --13:-5:0 --13:-4:0 --13:-3:0 --13:-2:0 --13:-1:0 --13:0:1 --13:1:-13 --13:2:91 --13:3:-455 --13:4:1820 --13:5:-6188 --13:6:18564 --13:7:-50388 --13:8:125970 --13:9:-293930 --13:10:646646 --13:11:-1352078 --13:12:2704156 --13:13:-5200300 --13:14:9657700 --13:15:-17383860 - -# n = -12, k = n - 15 ... n + 15 - --12:-27:-7726160 --12:-26:4457400 --12:-25:-2496144 --12:-24:1352078 --12:-23:-705432 --12:-22:352716 --12:-21:-167960 --12:-20:75582 --12:-19:-31824 --12:-18:12376 --12:-17:-4368 --12:-16:1365 --12:-15:-364 --12:-14:78 --12:-13:-12 --12:-12:1 --12:-11:0 --12:-10:0 --12:-9:0 --12:-8:0 --12:-7:0 --12:-6:0 --12:-5:0 --12:-4:0 --12:-3:0 --12:-2:0 --12:-1:0 --12:0:1 --12:1:-12 --12:2:78 --12:3:-364 --12:4:1365 --12:5:-4368 --12:6:12376 --12:7:-31824 --12:8:75582 --12:9:-167960 --12:10:352716 --12:11:-705432 --12:12:1352078 --12:13:-2496144 --12:14:4457400 --12:15:-7726160 - -# n = -11, k = n - 15 ... n + 15 - --11:-26:-3268760 --11:-25:1961256 --11:-24:-1144066 --11:-23:646646 --11:-22:-352716 --11:-21:184756 --11:-20:-92378 --11:-19:43758 --11:-18:-19448 --11:-17:8008 --11:-16:-3003 --11:-15:1001 --11:-14:-286 --11:-13:66 --11:-12:-11 --11:-11:1 --11:-10:0 --11:-9:0 --11:-8:0 --11:-7:0 --11:-6:0 --11:-5:0 --11:-4:0 --11:-3:0 --11:-2:0 --11:-1:0 --11:0:1 --11:1:-11 --11:2:66 --11:3:-286 --11:4:1001 --11:5:-3003 --11:6:8008 --11:7:-19448 --11:8:43758 --11:9:-92378 --11:10:184756 --11:11:-352716 --11:12:646646 --11:13:-1144066 --11:14:1961256 --11:15:-3268760 - -# n = -10, k = n - 15 ... n + 15 - --10:-25:-1307504 --10:-24:817190 --10:-23:-497420 --10:-22:293930 --10:-21:-167960 --10:-20:92378 --10:-19:-48620 --10:-18:24310 --10:-17:-11440 --10:-16:5005 --10:-15:-2002 --10:-14:715 --10:-13:-220 --10:-12:55 --10:-11:-10 --10:-10:1 --10:-9:0 --10:-8:0 --10:-7:0 --10:-6:0 --10:-5:0 --10:-4:0 --10:-3:0 --10:-2:0 --10:-1:0 --10:0:1 --10:1:-10 --10:2:55 --10:3:-220 --10:4:715 --10:5:-2002 --10:6:5005 --10:7:-11440 --10:8:24310 --10:9:-48620 --10:10:92378 --10:11:-167960 --10:12:293930 --10:13:-497420 --10:14:817190 --10:15:-1307504 - -# n = -9, k = n - 15 ... n + 15 - --9:-24:-490314 --9:-23:319770 --9:-22:-203490 --9:-21:125970 --9:-20:-75582 --9:-19:43758 --9:-18:-24310 --9:-17:12870 --9:-16:-6435 --9:-15:3003 --9:-14:-1287 --9:-13:495 --9:-12:-165 --9:-11:45 --9:-10:-9 --9:-9:1 --9:-8:0 --9:-7:0 --9:-6:0 --9:-5:0 --9:-4:0 --9:-3:0 --9:-2:0 --9:-1:0 --9:0:1 --9:1:-9 --9:2:45 --9:3:-165 --9:4:495 --9:5:-1287 --9:6:3003 --9:7:-6435 --9:8:12870 --9:9:-24310 --9:10:43758 --9:11:-75582 --9:12:125970 --9:13:-203490 --9:14:319770 --9:15:-490314 - -# n = -8, k = n - 15 ... n + 15 - --8:-23:-170544 --8:-22:116280 --8:-21:-77520 --8:-20:50388 --8:-19:-31824 --8:-18:19448 --8:-17:-11440 --8:-16:6435 --8:-15:-3432 --8:-14:1716 --8:-13:-792 --8:-12:330 --8:-11:-120 --8:-10:36 --8:-9:-8 --8:-8:1 --8:-7:0 --8:-6:0 --8:-5:0 --8:-4:0 --8:-3:0 --8:-2:0 --8:-1:0 --8:0:1 --8:1:-8 --8:2:36 --8:3:-120 --8:4:330 --8:5:-792 --8:6:1716 --8:7:-3432 --8:8:6435 --8:9:-11440 --8:10:19448 --8:11:-31824 --8:12:50388 --8:13:-77520 --8:14:116280 --8:15:-170544 - -# n = -7, k = n - 15 ... n + 15 - --7:-22:-54264 --7:-21:38760 --7:-20:-27132 --7:-19:18564 --7:-18:-12376 --7:-17:8008 --7:-16:-5005 --7:-15:3003 --7:-14:-1716 --7:-13:924 --7:-12:-462 --7:-11:210 --7:-10:-84 --7:-9:28 --7:-8:-7 --7:-7:1 --7:-6:0 --7:-5:0 --7:-4:0 --7:-3:0 --7:-2:0 --7:-1:0 --7:0:1 --7:1:-7 --7:2:28 --7:3:-84 --7:4:210 --7:5:-462 --7:6:924 --7:7:-1716 --7:8:3003 --7:9:-5005 --7:10:8008 --7:11:-12376 --7:12:18564 --7:13:-27132 --7:14:38760 --7:15:-54264 - -# n = -6, k = n - 15 ... n + 15 - --6:-21:-15504 --6:-20:11628 --6:-19:-8568 --6:-18:6188 --6:-17:-4368 --6:-16:3003 --6:-15:-2002 --6:-14:1287 --6:-13:-792 --6:-12:462 --6:-11:-252 --6:-10:126 --6:-9:-56 --6:-8:21 --6:-7:-6 --6:-6:1 --6:-5:0 --6:-4:0 --6:-3:0 --6:-2:0 --6:-1:0 --6:0:1 --6:1:-6 --6:2:21 --6:3:-56 --6:4:126 --6:5:-252 --6:6:462 --6:7:-792 --6:8:1287 --6:9:-2002 --6:10:3003 --6:11:-4368 --6:12:6188 --6:13:-8568 --6:14:11628 --6:15:-15504 - -# n = -5, k = n - 15 ... n + 15 - --5:-20:-3876 --5:-19:3060 --5:-18:-2380 --5:-17:1820 --5:-16:-1365 --5:-15:1001 --5:-14:-715 --5:-13:495 --5:-12:-330 --5:-11:210 --5:-10:-126 --5:-9:70 --5:-8:-35 --5:-7:15 --5:-6:-5 --5:-5:1 --5:-4:0 --5:-3:0 --5:-2:0 --5:-1:0 --5:0:1 --5:1:-5 --5:2:15 --5:3:-35 --5:4:70 --5:5:-126 --5:6:210 --5:7:-330 --5:8:495 --5:9:-715 --5:10:1001 --5:11:-1365 --5:12:1820 --5:13:-2380 --5:14:3060 --5:15:-3876 - -# n = -4, k = n - 15 ... n + 15 - --4:-19:-816 --4:-18:680 --4:-17:-560 --4:-16:455 --4:-15:-364 --4:-14:286 --4:-13:-220 --4:-12:165 --4:-11:-120 --4:-10:84 --4:-9:-56 --4:-8:35 --4:-7:-20 --4:-6:10 --4:-5:-4 --4:-4:1 --4:-3:0 --4:-2:0 --4:-1:0 --4:0:1 --4:1:-4 --4:2:10 --4:3:-20 --4:4:35 --4:5:-56 --4:6:84 --4:7:-120 --4:8:165 --4:9:-220 --4:10:286 --4:11:-364 --4:12:455 --4:13:-560 --4:14:680 --4:15:-816 - -# n = -3, k = n - 15 ... n + 15 - --3:-18:-136 --3:-17:120 --3:-16:-105 --3:-15:91 --3:-14:-78 --3:-13:66 --3:-12:-55 --3:-11:45 --3:-10:-36 --3:-9:28 --3:-8:-21 --3:-7:15 --3:-6:-10 --3:-5:6 --3:-4:-3 --3:-3:1 --3:-2:0 --3:-1:0 --3:0:1 --3:1:-3 --3:2:6 --3:3:-10 --3:4:15 --3:5:-21 --3:6:28 --3:7:-36 --3:8:45 --3:9:-55 --3:10:66 --3:11:-78 --3:12:91 --3:13:-105 --3:14:120 --3:15:-136 - -# n = -2, k = n - 15 ... n + 15 - --2:-17:-16 --2:-16:15 --2:-15:-14 --2:-14:13 --2:-13:-12 --2:-12:11 --2:-11:-10 --2:-10:9 --2:-9:-8 --2:-8:7 --2:-7:-6 --2:-6:5 --2:-5:-4 --2:-4:3 --2:-3:-2 --2:-2:1 --2:-1:0 --2:0:1 --2:1:-2 --2:2:3 --2:3:-4 --2:4:5 --2:5:-6 --2:6:7 --2:7:-8 --2:8:9 --2:9:-10 --2:10:11 --2:11:-12 --2:12:13 --2:13:-14 --2:14:15 --2:15:-16 - -# n = -1, k = n - 15 ... n + 15 - --1:-16:-1 --1:-15:1 --1:-14:-1 --1:-13:1 --1:-12:-1 --1:-11:1 --1:-10:-1 --1:-9:1 --1:-8:-1 --1:-7:1 --1:-6:-1 --1:-5:1 --1:-4:-1 --1:-3:1 --1:-2:-1 --1:-1:1 --1:0:1 --1:1:-1 --1:2:1 --1:3:-1 --1:4:1 --1:5:-1 --1:6:1 --1:7:-1 --1:8:1 --1:9:-1 --1:10:1 --1:11:-1 --1:12:1 --1:13:-1 --1:14:1 --1:15:-1 - -# n = 0, k = n - 15 ... n + 15 - -0:-15:0 -0:-14:0 -0:-13:0 -0:-12:0 -0:-11:0 -0:-10:0 -0:-9:0 -0:-8:0 -0:-7:0 -0:-6:0 -0:-5:0 -0:-4:0 -0:-3:0 -0:-2:0 -0:-1:0 -0:0:1 -0:1:0 -0:2:0 -0:3:0 -0:4:0 -0:5:0 -0:6:0 -0:7:0 -0:8:0 -0:9:0 -0:10:0 -0:11:0 -0:12:0 -0:13:0 -0:14:0 -0:15:0 - -# n = 1, k = n - 15 ... n + 15 - -1:-15:0 -1:-14:0 -1:-13:0 -1:-12:0 -1:-11:0 -1:-10:0 -1:-9:0 -1:-8:0 -1:-7:0 -1:-6:0 -1:-5:0 -1:-4:0 -1:-3:0 -1:-2:0 -1:-1:0 -1:0:1 -1:1:1 -1:2:0 -1:3:0 -1:4:0 -1:5:0 -1:6:0 -1:7:0 -1:8:0 -1:9:0 -1:10:0 -1:11:0 -1:12:0 -1:13:0 -1:14:0 -1:15:0 -1:16:0 - -# n = 2, k = n - 15 ... n + 15 - -2:-15:0 -2:-14:0 -2:-13:0 -2:-12:0 -2:-11:0 -2:-10:0 -2:-9:0 -2:-8:0 -2:-7:0 -2:-6:0 -2:-5:0 -2:-4:0 -2:-3:0 -2:-2:0 -2:-1:0 -2:0:1 -2:1:2 -2:2:1 -2:3:0 -2:4:0 -2:5:0 -2:6:0 -2:7:0 -2:8:0 -2:9:0 -2:10:0 -2:11:0 -2:12:0 -2:13:0 -2:14:0 -2:15:0 -2:16:0 -2:17:0 - -# n = 3, k = n - 15 ... n + 15 - -3:-15:0 -3:-14:0 -3:-13:0 -3:-12:0 -3:-11:0 -3:-10:0 -3:-9:0 -3:-8:0 -3:-7:0 -3:-6:0 -3:-5:0 -3:-4:0 -3:-3:0 -3:-2:0 -3:-1:0 -3:0:1 -3:1:3 -3:2:3 -3:3:1 -3:4:0 -3:5:0 -3:6:0 -3:7:0 -3:8:0 -3:9:0 -3:10:0 -3:11:0 -3:12:0 -3:13:0 -3:14:0 -3:15:0 -3:16:0 -3:17:0 -3:18:0 - -# n = 4, k = n - 15 ... n + 15 - -4:-15:0 -4:-14:0 -4:-13:0 -4:-12:0 -4:-11:0 -4:-10:0 -4:-9:0 -4:-8:0 -4:-7:0 -4:-6:0 -4:-5:0 -4:-4:0 -4:-3:0 -4:-2:0 -4:-1:0 -4:0:1 -4:1:4 -4:2:6 -4:3:4 -4:4:1 -4:5:0 -4:6:0 -4:7:0 -4:8:0 -4:9:0 -4:10:0 -4:11:0 -4:12:0 -4:13:0 -4:14:0 -4:15:0 -4:16:0 -4:17:0 -4:18:0 -4:19:0 - -# n = 5, k = n - 15 ... n + 15 - -5:-15:0 -5:-14:0 -5:-13:0 -5:-12:0 -5:-11:0 -5:-10:0 -5:-9:0 -5:-8:0 -5:-7:0 -5:-6:0 -5:-5:0 -5:-4:0 -5:-3:0 -5:-2:0 -5:-1:0 -5:0:1 -5:1:5 -5:2:10 -5:3:10 -5:4:5 -5:5:1 -5:6:0 -5:7:0 -5:8:0 -5:9:0 -5:10:0 -5:11:0 -5:12:0 -5:13:0 -5:14:0 -5:15:0 -5:16:0 -5:17:0 -5:18:0 -5:19:0 -5:20:0 - -# n = 6, k = n - 15 ... n + 15 - -6:-15:0 -6:-14:0 -6:-13:0 -6:-12:0 -6:-11:0 -6:-10:0 -6:-9:0 -6:-8:0 -6:-7:0 -6:-6:0 -6:-5:0 -6:-4:0 -6:-3:0 -6:-2:0 -6:-1:0 -6:0:1 -6:1:6 -6:2:15 -6:3:20 -6:4:15 -6:5:6 -6:6:1 -6:7:0 -6:8:0 -6:9:0 -6:10:0 -6:11:0 -6:12:0 -6:13:0 -6:14:0 -6:15:0 -6:16:0 -6:17:0 -6:18:0 -6:19:0 -6:20:0 -6:21:0 - -# n = 7, k = n - 15 ... n + 15 - -7:-15:0 -7:-14:0 -7:-13:0 -7:-12:0 -7:-11:0 -7:-10:0 -7:-9:0 -7:-8:0 -7:-7:0 -7:-6:0 -7:-5:0 -7:-4:0 -7:-3:0 -7:-2:0 -7:-1:0 -7:0:1 -7:1:7 -7:2:21 -7:3:35 -7:4:35 -7:5:21 -7:6:7 -7:7:1 -7:8:0 -7:9:0 -7:10:0 -7:11:0 -7:12:0 -7:13:0 -7:14:0 -7:15:0 -7:16:0 -7:17:0 -7:18:0 -7:19:0 -7:20:0 -7:21:0 -7:22:0 - -# n = 8, k = n - 15 ... n + 15 - -8:-15:0 -8:-14:0 -8:-13:0 -8:-12:0 -8:-11:0 -8:-10:0 -8:-9:0 -8:-8:0 -8:-7:0 -8:-6:0 -8:-5:0 -8:-4:0 -8:-3:0 -8:-2:0 -8:-1:0 -8:0:1 -8:1:8 -8:2:28 -8:3:56 -8:4:70 -8:5:56 -8:6:28 -8:7:8 -8:8:1 -8:9:0 -8:10:0 -8:11:0 -8:12:0 -8:13:0 -8:14:0 -8:15:0 -8:16:0 -8:17:0 -8:18:0 -8:19:0 -8:20:0 -8:21:0 -8:22:0 -8:23:0 - -# n = 9, k = n - 15 ... n + 15 - -9:-15:0 -9:-14:0 -9:-13:0 -9:-12:0 -9:-11:0 -9:-10:0 -9:-9:0 -9:-8:0 -9:-7:0 -9:-6:0 -9:-5:0 -9:-4:0 -9:-3:0 -9:-2:0 -9:-1:0 -9:0:1 -9:1:9 -9:2:36 -9:3:84 -9:4:126 -9:5:126 -9:6:84 -9:7:36 -9:8:9 -9:9:1 -9:10:0 -9:11:0 -9:12:0 -9:13:0 -9:14:0 -9:15:0 -9:16:0 -9:17:0 -9:18:0 -9:19:0 -9:20:0 -9:21:0 -9:22:0 -9:23:0 -9:24:0 - -# n = 10, k = n - 15 ... n + 15 - -10:-15:0 -10:-14:0 -10:-13:0 -10:-12:0 -10:-11:0 -10:-10:0 -10:-9:0 -10:-8:0 -10:-7:0 -10:-6:0 -10:-5:0 -10:-4:0 -10:-3:0 -10:-2:0 -10:-1:0 -10:0:1 -10:1:10 -10:2:45 -10:3:120 -10:4:210 -10:5:252 -10:6:210 -10:7:120 -10:8:45 -10:9:10 -10:10:1 -10:11:0 -10:12:0 -10:13:0 -10:14:0 -10:15:0 -10:16:0 -10:17:0 -10:18:0 -10:19:0 -10:20:0 -10:21:0 -10:22:0 -10:23:0 -10:24:0 -10:25:0 - -# n = 11, k = n - 15 ... n + 15 - -11:-15:0 -11:-14:0 -11:-13:0 -11:-12:0 -11:-11:0 -11:-10:0 -11:-9:0 -11:-8:0 -11:-7:0 -11:-6:0 -11:-5:0 -11:-4:0 -11:-3:0 -11:-2:0 -11:-1:0 -11:0:1 -11:1:11 -11:2:55 -11:3:165 -11:4:330 -11:5:462 -11:6:462 -11:7:330 -11:8:165 -11:9:55 -11:10:11 -11:11:1 -11:12:0 -11:13:0 -11:14:0 -11:15:0 -11:16:0 -11:17:0 -11:18:0 -11:19:0 -11:20:0 -11:21:0 -11:22:0 -11:23:0 -11:24:0 -11:25:0 -11:26:0 - -# n = 12, k = n - 15 ... n + 15 - -12:-15:0 -12:-14:0 -12:-13:0 -12:-12:0 -12:-11:0 -12:-10:0 -12:-9:0 -12:-8:0 -12:-7:0 -12:-6:0 -12:-5:0 -12:-4:0 -12:-3:0 -12:-2:0 -12:-1:0 -12:0:1 -12:1:12 -12:2:66 -12:3:220 -12:4:495 -12:5:792 -12:6:924 -12:7:792 -12:8:495 -12:9:220 -12:10:66 -12:11:12 -12:12:1 -12:13:0 -12:14:0 -12:15:0 -12:16:0 -12:17:0 -12:18:0 -12:19:0 -12:20:0 -12:21:0 -12:22:0 -12:23:0 -12:24:0 -12:25:0 -12:26:0 -12:27:0 - -# n = 13, k = n - 15 ... n + 15 - -13:-15:0 -13:-14:0 -13:-13:0 -13:-12:0 -13:-11:0 -13:-10:0 -13:-9:0 -13:-8:0 -13:-7:0 -13:-6:0 -13:-5:0 -13:-4:0 -13:-3:0 -13:-2:0 -13:-1:0 -13:0:1 -13:1:13 -13:2:78 -13:3:286 -13:4:715 -13:5:1287 -13:6:1716 -13:7:1716 -13:8:1287 -13:9:715 -13:10:286 -13:11:78 -13:12:13 -13:13:1 -13:14:0 -13:15:0 -13:16:0 -13:17:0 -13:18:0 -13:19:0 -13:20:0 -13:21:0 -13:22:0 -13:23:0 -13:24:0 -13:25:0 -13:26:0 -13:27:0 -13:28:0 - -# n = 14, k = n - 15 ... n + 15 - -14:-15:0 -14:-14:0 -14:-13:0 -14:-12:0 -14:-11:0 -14:-10:0 -14:-9:0 -14:-8:0 -14:-7:0 -14:-6:0 -14:-5:0 -14:-4:0 -14:-3:0 -14:-2:0 -14:-1:0 -14:0:1 -14:1:14 -14:2:91 -14:3:364 -14:4:1001 -14:5:2002 -14:6:3003 -14:7:3432 -14:8:3003 -14:9:2002 -14:10:1001 -14:11:364 -14:12:91 -14:13:14 -14:14:1 -14:15:0 -14:16:0 -14:17:0 -14:18:0 -14:19:0 -14:20:0 -14:21:0 -14:22:0 -14:23:0 -14:24:0 -14:25:0 -14:26:0 -14:27:0 -14:28:0 -14:29:0 - -# n = 15, k = n - 15 ... n + 15 - -15:-15:0 -15:-14:0 -15:-13:0 -15:-12:0 -15:-11:0 -15:-10:0 -15:-9:0 -15:-8:0 -15:-7:0 -15:-6:0 -15:-5:0 -15:-4:0 -15:-3:0 -15:-2:0 -15:-1:0 -15:0:1 -15:1:15 -15:2:105 -15:3:455 -15:4:1365 -15:5:3003 -15:6:5005 -15:7:6435 -15:8:6435 -15:9:5005 -15:10:3003 -15:11:1365 -15:12:455 -15:13:105 -15:14:15 -15:15:1 -15:16:0 -15:17:0 -15:18:0 -15:19:0 -15:20:0 -15:21:0 -15:22:0 -15:23:0 -15:24:0 -15:25:0 -15:26:0 -15:27:0 -15:28:0 -15:29:0 -15:30:0 diff --git a/cpan/Math-BigInt/t/bnok-mbi.t b/cpan/Math-BigInt/t/bnok-mbi.t deleted file mode 100644 index 26fe2ffa67..0000000000 --- a/cpan/Math-BigInt/t/bnok-mbi.t +++ /dev/null @@ -1,1451 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 4957; - -my $class; - -BEGIN { - $class = 'Math::BigInt'; - use_ok($class); -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($nval, $kval, $nokval) = split /:/; - my ($n, $k, $got, @got); - - for my $context_is_scalar (0, 1) { - for my $k_is_scalar (0, 1) { - - my $test = qq|\$n = $class -> new("$nval");|; - - $test .= $k_is_scalar - ? qq| \$k = "$kval";| - : qq| \$k = $class -> new("$kval");|; - - $test .= $context_is_scalar - ? qq| \$got = \$n -> bnok(\$k);| - : qq| \@got = \$n -> bnok(\$k);|; - - my $desc = "bnok() in "; - $desc .= $context_is_scalar ? "scalar context" : "list context"; - $desc .= $k_is_scalar ? " with k as scalar" : " with k 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(), $nokval, - "'$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(), $nokval, - "'$test' output arg has the right value"); - } - - # Check the invocand. - - is(ref($n), $class, - "'$test' invocand is still a $class"); - - is($n -> bstr(), $nokval, - "'$test' invocand has the right value"); - - # Check the input argument. - - if ($k_is_scalar) { - - is(ref($k), '', - "'$test' second input arg is still a scalar"); - - is($k, $kval, - "'$test' second input arg is unmodified"); - - } else { - - is(ref($k), $class, - "'$test' second input arg is still a $class"); - - is($k -> bstr(), $kval, - "'$test' second input arg is unmodified"); - } - }; - } - } -} - -__DATA__ - -# n and/or k is NaN - -NaN:NaN:NaN -NaN:0:NaN -NaN:3:NaN -3:NaN:NaN -NaN:-3:NaN --3:NaN:NaN - -# n = inf - -inf:-inf:NaN -inf:-3:0 -inf:-2:0 -inf:-1:0 -inf:0:1 -inf:1:inf -inf:2:inf -inf:3:inf -inf:inf:NaN - -# n = -inf - --inf:-inf:NaN --inf:-3:0 --inf:-2:0 --inf:-1:0 --inf:0:1 --inf:1:-inf --inf:2:inf --inf:3:-inf --inf:inf:NaN - -# k = inf - --3:inf:NaN --2:inf:NaN --1:inf:NaN -0:inf:NaN -1:inf:NaN -2:inf:NaN -3:inf:NaN - -# k = -inf - --3:-inf:NaN --2:-inf:NaN --1:-inf:NaN -0:-inf:NaN -1:-inf:NaN -2:-inf:NaN -3:-inf:NaN - -# n = -15, k = n - 15 ... n + 15 - --15:-30:-77558760 --15:-29:40116600 --15:-28:-20058300 --15:-27:9657700 --15:-26:-4457400 --15:-25:1961256 --15:-24:-817190 --15:-23:319770 --15:-22:-116280 --15:-21:38760 --15:-20:-11628 --15:-19:3060 --15:-18:-680 --15:-17:120 --15:-16:-15 --15:-15:1 --15:-14:0 --15:-13:0 --15:-12:0 --15:-11:0 --15:-10:0 --15:-9:0 --15:-8:0 --15:-7:0 --15:-6:0 --15:-5:0 --15:-4:0 --15:-3:0 --15:-2:0 --15:-1:0 --15:0:1 --15:1:-15 --15:2:120 --15:3:-680 --15:4:3060 --15:5:-11628 --15:6:38760 --15:7:-116280 --15:8:319770 --15:9:-817190 --15:10:1961256 --15:11:-4457400 --15:12:9657700 --15:13:-20058300 --15:14:40116600 --15:15:-77558760 - -# n = -14, k = n - 15 ... n + 15 - --14:-29:-37442160 --14:-28:20058300 --14:-27:-10400600 --14:-26:5200300 --14:-25:-2496144 --14:-24:1144066 --14:-23:-497420 --14:-22:203490 --14:-21:-77520 --14:-20:27132 --14:-19:-8568 --14:-18:2380 --14:-17:-560 --14:-16:105 --14:-15:-14 --14:-14:1 --14:-13:0 --14:-12:0 --14:-11:0 --14:-10:0 --14:-9:0 --14:-8:0 --14:-7:0 --14:-6:0 --14:-5:0 --14:-4:0 --14:-3:0 --14:-2:0 --14:-1:0 --14:0:1 --14:1:-14 --14:2:105 --14:3:-560 --14:4:2380 --14:5:-8568 --14:6:27132 --14:7:-77520 --14:8:203490 --14:9:-497420 --14:10:1144066 --14:11:-2496144 --14:12:5200300 --14:13:-10400600 --14:14:20058300 --14:15:-37442160 - -# n = -13, k = n - 15 ... n + 15 - --13:-28:-17383860 --13:-27:9657700 --13:-26:-5200300 --13:-25:2704156 --13:-24:-1352078 --13:-23:646646 --13:-22:-293930 --13:-21:125970 --13:-20:-50388 --13:-19:18564 --13:-18:-6188 --13:-17:1820 --13:-16:-455 --13:-15:91 --13:-14:-13 --13:-13:1 --13:-12:0 --13:-11:0 --13:-10:0 --13:-9:0 --13:-8:0 --13:-7:0 --13:-6:0 --13:-5:0 --13:-4:0 --13:-3:0 --13:-2:0 --13:-1:0 --13:0:1 --13:1:-13 --13:2:91 --13:3:-455 --13:4:1820 --13:5:-6188 --13:6:18564 --13:7:-50388 --13:8:125970 --13:9:-293930 --13:10:646646 --13:11:-1352078 --13:12:2704156 --13:13:-5200300 --13:14:9657700 --13:15:-17383860 - -# n = -12, k = n - 15 ... n + 15 - --12:-27:-7726160 --12:-26:4457400 --12:-25:-2496144 --12:-24:1352078 --12:-23:-705432 --12:-22:352716 --12:-21:-167960 --12:-20:75582 --12:-19:-31824 --12:-18:12376 --12:-17:-4368 --12:-16:1365 --12:-15:-364 --12:-14:78 --12:-13:-12 --12:-12:1 --12:-11:0 --12:-10:0 --12:-9:0 --12:-8:0 --12:-7:0 --12:-6:0 --12:-5:0 --12:-4:0 --12:-3:0 --12:-2:0 --12:-1:0 --12:0:1 --12:1:-12 --12:2:78 --12:3:-364 --12:4:1365 --12:5:-4368 --12:6:12376 --12:7:-31824 --12:8:75582 --12:9:-167960 --12:10:352716 --12:11:-705432 --12:12:1352078 --12:13:-2496144 --12:14:4457400 --12:15:-7726160 - -# n = -11, k = n - 15 ... n + 15 - --11:-26:-3268760 --11:-25:1961256 --11:-24:-1144066 --11:-23:646646 --11:-22:-352716 --11:-21:184756 --11:-20:-92378 --11:-19:43758 --11:-18:-19448 --11:-17:8008 --11:-16:-3003 --11:-15:1001 --11:-14:-286 --11:-13:66 --11:-12:-11 --11:-11:1 --11:-10:0 --11:-9:0 --11:-8:0 --11:-7:0 --11:-6:0 --11:-5:0 --11:-4:0 --11:-3:0 --11:-2:0 --11:-1:0 --11:0:1 --11:1:-11 --11:2:66 --11:3:-286 --11:4:1001 --11:5:-3003 --11:6:8008 --11:7:-19448 --11:8:43758 --11:9:-92378 --11:10:184756 --11:11:-352716 --11:12:646646 --11:13:-1144066 --11:14:1961256 --11:15:-3268760 - -# n = -10, k = n - 15 ... n + 15 - --10:-25:-1307504 --10:-24:817190 --10:-23:-497420 --10:-22:293930 --10:-21:-167960 --10:-20:92378 --10:-19:-48620 --10:-18:24310 --10:-17:-11440 --10:-16:5005 --10:-15:-2002 --10:-14:715 --10:-13:-220 --10:-12:55 --10:-11:-10 --10:-10:1 --10:-9:0 --10:-8:0 --10:-7:0 --10:-6:0 --10:-5:0 --10:-4:0 --10:-3:0 --10:-2:0 --10:-1:0 --10:0:1 --10:1:-10 --10:2:55 --10:3:-220 --10:4:715 --10:5:-2002 --10:6:5005 --10:7:-11440 --10:8:24310 --10:9:-48620 --10:10:92378 --10:11:-167960 --10:12:293930 --10:13:-497420 --10:14:817190 --10:15:-1307504 - -# n = -9, k = n - 15 ... n + 15 - --9:-24:-490314 --9:-23:319770 --9:-22:-203490 --9:-21:125970 --9:-20:-75582 --9:-19:43758 --9:-18:-24310 --9:-17:12870 --9:-16:-6435 --9:-15:3003 --9:-14:-1287 --9:-13:495 --9:-12:-165 --9:-11:45 --9:-10:-9 --9:-9:1 --9:-8:0 --9:-7:0 --9:-6:0 --9:-5:0 --9:-4:0 --9:-3:0 --9:-2:0 --9:-1:0 --9:0:1 --9:1:-9 --9:2:45 --9:3:-165 --9:4:495 --9:5:-1287 --9:6:3003 --9:7:-6435 --9:8:12870 --9:9:-24310 --9:10:43758 --9:11:-75582 --9:12:125970 --9:13:-203490 --9:14:319770 --9:15:-490314 - -# n = -8, k = n - 15 ... n + 15 - --8:-23:-170544 --8:-22:116280 --8:-21:-77520 --8:-20:50388 --8:-19:-31824 --8:-18:19448 --8:-17:-11440 --8:-16:6435 --8:-15:-3432 --8:-14:1716 --8:-13:-792 --8:-12:330 --8:-11:-120 --8:-10:36 --8:-9:-8 --8:-8:1 --8:-7:0 --8:-6:0 --8:-5:0 --8:-4:0 --8:-3:0 --8:-2:0 --8:-1:0 --8:0:1 --8:1:-8 --8:2:36 --8:3:-120 --8:4:330 --8:5:-792 --8:6:1716 --8:7:-3432 --8:8:6435 --8:9:-11440 --8:10:19448 --8:11:-31824 --8:12:50388 --8:13:-77520 --8:14:116280 --8:15:-170544 - -# n = -7, k = n - 15 ... n + 15 - --7:-22:-54264 --7:-21:38760 --7:-20:-27132 --7:-19:18564 --7:-18:-12376 --7:-17:8008 --7:-16:-5005 --7:-15:3003 --7:-14:-1716 --7:-13:924 --7:-12:-462 --7:-11:210 --7:-10:-84 --7:-9:28 --7:-8:-7 --7:-7:1 --7:-6:0 --7:-5:0 --7:-4:0 --7:-3:0 --7:-2:0 --7:-1:0 --7:0:1 --7:1:-7 --7:2:28 --7:3:-84 --7:4:210 --7:5:-462 --7:6:924 --7:7:-1716 --7:8:3003 --7:9:-5005 --7:10:8008 --7:11:-12376 --7:12:18564 --7:13:-27132 --7:14:38760 --7:15:-54264 - -# n = -6, k = n - 15 ... n + 15 - --6:-21:-15504 --6:-20:11628 --6:-19:-8568 --6:-18:6188 --6:-17:-4368 --6:-16:3003 --6:-15:-2002 --6:-14:1287 --6:-13:-792 --6:-12:462 --6:-11:-252 --6:-10:126 --6:-9:-56 --6:-8:21 --6:-7:-6 --6:-6:1 --6:-5:0 --6:-4:0 --6:-3:0 --6:-2:0 --6:-1:0 --6:0:1 --6:1:-6 --6:2:21 --6:3:-56 --6:4:126 --6:5:-252 --6:6:462 --6:7:-792 --6:8:1287 --6:9:-2002 --6:10:3003 --6:11:-4368 --6:12:6188 --6:13:-8568 --6:14:11628 --6:15:-15504 - -# n = -5, k = n - 15 ... n + 15 - --5:-20:-3876 --5:-19:3060 --5:-18:-2380 --5:-17:1820 --5:-16:-1365 --5:-15:1001 --5:-14:-715 --5:-13:495 --5:-12:-330 --5:-11:210 --5:-10:-126 --5:-9:70 --5:-8:-35 --5:-7:15 --5:-6:-5 --5:-5:1 --5:-4:0 --5:-3:0 --5:-2:0 --5:-1:0 --5:0:1 --5:1:-5 --5:2:15 --5:3:-35 --5:4:70 --5:5:-126 --5:6:210 --5:7:-330 --5:8:495 --5:9:-715 --5:10:1001 --5:11:-1365 --5:12:1820 --5:13:-2380 --5:14:3060 --5:15:-3876 - -# n = -4, k = n - 15 ... n + 15 - --4:-19:-816 --4:-18:680 --4:-17:-560 --4:-16:455 --4:-15:-364 --4:-14:286 --4:-13:-220 --4:-12:165 --4:-11:-120 --4:-10:84 --4:-9:-56 --4:-8:35 --4:-7:-20 --4:-6:10 --4:-5:-4 --4:-4:1 --4:-3:0 --4:-2:0 --4:-1:0 --4:0:1 --4:1:-4 --4:2:10 --4:3:-20 --4:4:35 --4:5:-56 --4:6:84 --4:7:-120 --4:8:165 --4:9:-220 --4:10:286 --4:11:-364 --4:12:455 --4:13:-560 --4:14:680 --4:15:-816 - -# n = -3, k = n - 15 ... n + 15 - --3:-18:-136 --3:-17:120 --3:-16:-105 --3:-15:91 --3:-14:-78 --3:-13:66 --3:-12:-55 --3:-11:45 --3:-10:-36 --3:-9:28 --3:-8:-21 --3:-7:15 --3:-6:-10 --3:-5:6 --3:-4:-3 --3:-3:1 --3:-2:0 --3:-1:0 --3:0:1 --3:1:-3 --3:2:6 --3:3:-10 --3:4:15 --3:5:-21 --3:6:28 --3:7:-36 --3:8:45 --3:9:-55 --3:10:66 --3:11:-78 --3:12:91 --3:13:-105 --3:14:120 --3:15:-136 - -# n = -2, k = n - 15 ... n + 15 - --2:-17:-16 --2:-16:15 --2:-15:-14 --2:-14:13 --2:-13:-12 --2:-12:11 --2:-11:-10 --2:-10:9 --2:-9:-8 --2:-8:7 --2:-7:-6 --2:-6:5 --2:-5:-4 --2:-4:3 --2:-3:-2 --2:-2:1 --2:-1:0 --2:0:1 --2:1:-2 --2:2:3 --2:3:-4 --2:4:5 --2:5:-6 --2:6:7 --2:7:-8 --2:8:9 --2:9:-10 --2:10:11 --2:11:-12 --2:12:13 --2:13:-14 --2:14:15 --2:15:-16 - -# n = -1, k = n - 15 ... n + 15 - --1:-16:-1 --1:-15:1 --1:-14:-1 --1:-13:1 --1:-12:-1 --1:-11:1 --1:-10:-1 --1:-9:1 --1:-8:-1 --1:-7:1 --1:-6:-1 --1:-5:1 --1:-4:-1 --1:-3:1 --1:-2:-1 --1:-1:1 --1:0:1 --1:1:-1 --1:2:1 --1:3:-1 --1:4:1 --1:5:-1 --1:6:1 --1:7:-1 --1:8:1 --1:9:-1 --1:10:1 --1:11:-1 --1:12:1 --1:13:-1 --1:14:1 --1:15:-1 - -# n = 0, k = n - 15 ... n + 15 - -0:-15:0 -0:-14:0 -0:-13:0 -0:-12:0 -0:-11:0 -0:-10:0 -0:-9:0 -0:-8:0 -0:-7:0 -0:-6:0 -0:-5:0 -0:-4:0 -0:-3:0 -0:-2:0 -0:-1:0 -0:0:1 -0:1:0 -0:2:0 -0:3:0 -0:4:0 -0:5:0 -0:6:0 -0:7:0 -0:8:0 -0:9:0 -0:10:0 -0:11:0 -0:12:0 -0:13:0 -0:14:0 -0:15:0 - -# n = 1, k = n - 15 ... n + 15 - -1:-15:0 -1:-14:0 -1:-13:0 -1:-12:0 -1:-11:0 -1:-10:0 -1:-9:0 -1:-8:0 -1:-7:0 -1:-6:0 -1:-5:0 -1:-4:0 -1:-3:0 -1:-2:0 -1:-1:0 -1:0:1 -1:1:1 -1:2:0 -1:3:0 -1:4:0 -1:5:0 -1:6:0 -1:7:0 -1:8:0 -1:9:0 -1:10:0 -1:11:0 -1:12:0 -1:13:0 -1:14:0 -1:15:0 -1:16:0 - -# n = 2, k = n - 15 ... n + 15 - -2:-15:0 -2:-14:0 -2:-13:0 -2:-12:0 -2:-11:0 -2:-10:0 -2:-9:0 -2:-8:0 -2:-7:0 -2:-6:0 -2:-5:0 -2:-4:0 -2:-3:0 -2:-2:0 -2:-1:0 -2:0:1 -2:1:2 -2:2:1 -2:3:0 -2:4:0 -2:5:0 -2:6:0 -2:7:0 -2:8:0 -2:9:0 -2:10:0 -2:11:0 -2:12:0 -2:13:0 -2:14:0 -2:15:0 -2:16:0 -2:17:0 - -# n = 3, k = n - 15 ... n + 15 - -3:-15:0 -3:-14:0 -3:-13:0 -3:-12:0 -3:-11:0 -3:-10:0 -3:-9:0 -3:-8:0 -3:-7:0 -3:-6:0 -3:-5:0 -3:-4:0 -3:-3:0 -3:-2:0 -3:-1:0 -3:0:1 -3:1:3 -3:2:3 -3:3:1 -3:4:0 -3:5:0 -3:6:0 -3:7:0 -3:8:0 -3:9:0 -3:10:0 -3:11:0 -3:12:0 -3:13:0 -3:14:0 -3:15:0 -3:16:0 -3:17:0 -3:18:0 - -# n = 4, k = n - 15 ... n + 15 - -4:-15:0 -4:-14:0 -4:-13:0 -4:-12:0 -4:-11:0 -4:-10:0 -4:-9:0 -4:-8:0 -4:-7:0 -4:-6:0 -4:-5:0 -4:-4:0 -4:-3:0 -4:-2:0 -4:-1:0 -4:0:1 -4:1:4 -4:2:6 -4:3:4 -4:4:1 -4:5:0 -4:6:0 -4:7:0 -4:8:0 -4:9:0 -4:10:0 -4:11:0 -4:12:0 -4:13:0 -4:14:0 -4:15:0 -4:16:0 -4:17:0 -4:18:0 -4:19:0 - -# n = 5, k = n - 15 ... n + 15 - -5:-15:0 -5:-14:0 -5:-13:0 -5:-12:0 -5:-11:0 -5:-10:0 -5:-9:0 -5:-8:0 -5:-7:0 -5:-6:0 -5:-5:0 -5:-4:0 -5:-3:0 -5:-2:0 -5:-1:0 -5:0:1 -5:1:5 -5:2:10 -5:3:10 -5:4:5 -5:5:1 -5:6:0 -5:7:0 -5:8:0 -5:9:0 -5:10:0 -5:11:0 -5:12:0 -5:13:0 -5:14:0 -5:15:0 -5:16:0 -5:17:0 -5:18:0 -5:19:0 -5:20:0 - -# n = 6, k = n - 15 ... n + 15 - -6:-15:0 -6:-14:0 -6:-13:0 -6:-12:0 -6:-11:0 -6:-10:0 -6:-9:0 -6:-8:0 -6:-7:0 -6:-6:0 -6:-5:0 -6:-4:0 -6:-3:0 -6:-2:0 -6:-1:0 -6:0:1 -6:1:6 -6:2:15 -6:3:20 -6:4:15 -6:5:6 -6:6:1 -6:7:0 -6:8:0 -6:9:0 -6:10:0 -6:11:0 -6:12:0 -6:13:0 -6:14:0 -6:15:0 -6:16:0 -6:17:0 -6:18:0 -6:19:0 -6:20:0 -6:21:0 - -# n = 7, k = n - 15 ... n + 15 - -7:-15:0 -7:-14:0 -7:-13:0 -7:-12:0 -7:-11:0 -7:-10:0 -7:-9:0 -7:-8:0 -7:-7:0 -7:-6:0 -7:-5:0 -7:-4:0 -7:-3:0 -7:-2:0 -7:-1:0 -7:0:1 -7:1:7 -7:2:21 -7:3:35 -7:4:35 -7:5:21 -7:6:7 -7:7:1 -7:8:0 -7:9:0 -7:10:0 -7:11:0 -7:12:0 -7:13:0 -7:14:0 -7:15:0 -7:16:0 -7:17:0 -7:18:0 -7:19:0 -7:20:0 -7:21:0 -7:22:0 - -# n = 8, k = n - 15 ... n + 15 - -8:-15:0 -8:-14:0 -8:-13:0 -8:-12:0 -8:-11:0 -8:-10:0 -8:-9:0 -8:-8:0 -8:-7:0 -8:-6:0 -8:-5:0 -8:-4:0 -8:-3:0 -8:-2:0 -8:-1:0 -8:0:1 -8:1:8 -8:2:28 -8:3:56 -8:4:70 -8:5:56 -8:6:28 -8:7:8 -8:8:1 -8:9:0 -8:10:0 -8:11:0 -8:12:0 -8:13:0 -8:14:0 -8:15:0 -8:16:0 -8:17:0 -8:18:0 -8:19:0 -8:20:0 -8:21:0 -8:22:0 -8:23:0 - -# n = 9, k = n - 15 ... n + 15 - -9:-15:0 -9:-14:0 -9:-13:0 -9:-12:0 -9:-11:0 -9:-10:0 -9:-9:0 -9:-8:0 -9:-7:0 -9:-6:0 -9:-5:0 -9:-4:0 -9:-3:0 -9:-2:0 -9:-1:0 -9:0:1 -9:1:9 -9:2:36 -9:3:84 -9:4:126 -9:5:126 -9:6:84 -9:7:36 -9:8:9 -9:9:1 -9:10:0 -9:11:0 -9:12:0 -9:13:0 -9:14:0 -9:15:0 -9:16:0 -9:17:0 -9:18:0 -9:19:0 -9:20:0 -9:21:0 -9:22:0 -9:23:0 -9:24:0 - -# n = 10, k = n - 15 ... n + 15 - -10:-15:0 -10:-14:0 -10:-13:0 -10:-12:0 -10:-11:0 -10:-10:0 -10:-9:0 -10:-8:0 -10:-7:0 -10:-6:0 -10:-5:0 -10:-4:0 -10:-3:0 -10:-2:0 -10:-1:0 -10:0:1 -10:1:10 -10:2:45 -10:3:120 -10:4:210 -10:5:252 -10:6:210 -10:7:120 -10:8:45 -10:9:10 -10:10:1 -10:11:0 -10:12:0 -10:13:0 -10:14:0 -10:15:0 -10:16:0 -10:17:0 -10:18:0 -10:19:0 -10:20:0 -10:21:0 -10:22:0 -10:23:0 -10:24:0 -10:25:0 - -# n = 11, k = n - 15 ... n + 15 - -11:-15:0 -11:-14:0 -11:-13:0 -11:-12:0 -11:-11:0 -11:-10:0 -11:-9:0 -11:-8:0 -11:-7:0 -11:-6:0 -11:-5:0 -11:-4:0 -11:-3:0 -11:-2:0 -11:-1:0 -11:0:1 -11:1:11 -11:2:55 -11:3:165 -11:4:330 -11:5:462 -11:6:462 -11:7:330 -11:8:165 -11:9:55 -11:10:11 -11:11:1 -11:12:0 -11:13:0 -11:14:0 -11:15:0 -11:16:0 -11:17:0 -11:18:0 -11:19:0 -11:20:0 -11:21:0 -11:22:0 -11:23:0 -11:24:0 -11:25:0 -11:26:0 - -# n = 12, k = n - 15 ... n + 15 - -12:-15:0 -12:-14:0 -12:-13:0 -12:-12:0 -12:-11:0 -12:-10:0 -12:-9:0 -12:-8:0 -12:-7:0 -12:-6:0 -12:-5:0 -12:-4:0 -12:-3:0 -12:-2:0 -12:-1:0 -12:0:1 -12:1:12 -12:2:66 -12:3:220 -12:4:495 -12:5:792 -12:6:924 -12:7:792 -12:8:495 -12:9:220 -12:10:66 -12:11:12 -12:12:1 -12:13:0 -12:14:0 -12:15:0 -12:16:0 -12:17:0 -12:18:0 -12:19:0 -12:20:0 -12:21:0 -12:22:0 -12:23:0 -12:24:0 -12:25:0 -12:26:0 -12:27:0 - -# n = 13, k = n - 15 ... n + 15 - -13:-15:0 -13:-14:0 -13:-13:0 -13:-12:0 -13:-11:0 -13:-10:0 -13:-9:0 -13:-8:0 -13:-7:0 -13:-6:0 -13:-5:0 -13:-4:0 -13:-3:0 -13:-2:0 -13:-1:0 -13:0:1 -13:1:13 -13:2:78 -13:3:286 -13:4:715 -13:5:1287 -13:6:1716 -13:7:1716 -13:8:1287 -13:9:715 -13:10:286 -13:11:78 -13:12:13 -13:13:1 -13:14:0 -13:15:0 -13:16:0 -13:17:0 -13:18:0 -13:19:0 -13:20:0 -13:21:0 -13:22:0 -13:23:0 -13:24:0 -13:25:0 -13:26:0 -13:27:0 -13:28:0 - -# n = 14, k = n - 15 ... n + 15 - -14:-15:0 -14:-14:0 -14:-13:0 -14:-12:0 -14:-11:0 -14:-10:0 -14:-9:0 -14:-8:0 -14:-7:0 -14:-6:0 -14:-5:0 -14:-4:0 -14:-3:0 -14:-2:0 -14:-1:0 -14:0:1 -14:1:14 -14:2:91 -14:3:364 -14:4:1001 -14:5:2002 -14:6:3003 -14:7:3432 -14:8:3003 -14:9:2002 -14:10:1001 -14:11:364 -14:12:91 -14:13:14 -14:14:1 -14:15:0 -14:16:0 -14:17:0 -14:18:0 -14:19:0 -14:20:0 -14:21:0 -14:22:0 -14:23:0 -14:24:0 -14:25:0 -14:26:0 -14:27:0 -14:28:0 -14:29:0 - -# n = 15, k = n - 15 ... n + 15 - -15:-15:0 -15:-14:0 -15:-13:0 -15:-12:0 -15:-11:0 -15:-10:0 -15:-9:0 -15:-8:0 -15:-7:0 -15:-6:0 -15:-5:0 -15:-4:0 -15:-3:0 -15:-2:0 -15:-1:0 -15:0:1 -15:1:15 -15:2:105 -15:3:455 -15:4:1365 -15:5:3003 -15:6:5005 -15:7:6435 -15:8:6435 -15:9:5005 -15:10:3003 -15:11:1365 -15:12:455 -15:13:105 -15:14:15 -15:15:1 -15:16:0 -15:17:0 -15:18:0 -15:19:0 -15:20:0 -15:21:0 -15:22:0 -15:23:0 -15:24:0 -15:25:0 -15:26:0 -15:27:0 -15:28:0 -15:29:0 -15:30:0 diff --git a/cpan/Math-BigInt/t/bnstr-mbf.t b/cpan/Math-BigInt/t/bnstr-mbf.t deleted file mode 100644 index 9e03a5bf48..0000000000 --- a/cpan/Math-BigInt/t/bnstr-mbf.t +++ /dev/null @@ -1,278 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 460; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - { - my $test = qq|\$x = Math::BigFloat -> new("$x_str");| - . qq| \$str = \$x -> bnstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); - } - -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -0.000000000001:1e-12 -0.00000000001:1e-11 -0.0000000001:1e-10 -0.000000001:1e-9 -0.00000001:1e-8 -0.0000001:1e-7 -0.000001:1e-6 -0.00001:1e-5 -0.0001:1e-4 -0.001:1e-3 -0.01:1e-2 -0.1:1e-1 -1:1e+0 -10:1e+1 -100:1e+2 -1000:1e+3 -10000:1e+4 -100000:1e+5 -1000000:1e+6 -10000000:1e+7 -100000000:1e+8 -1000000000:1e+9 -10000000000:1e+10 -100000000000:1e+11 -1000000000000:1e+12 - -0.0000000000012:1.2e-12 -0.000000000012:1.2e-11 -0.00000000012:1.2e-10 -0.0000000012:1.2e-9 -0.000000012:1.2e-8 -0.00000012:1.2e-7 -0.0000012:1.2e-6 -0.000012:1.2e-5 -0.00012:1.2e-4 -0.0012:1.2e-3 -0.012:1.2e-2 -0.12:1.2e-1 -1.2:1.2e+0 -12:1.2e+1 -120:1.2e+2 -1200:1.2e+3 -12000:1.2e+4 -120000:1.2e+5 -1200000:1.2e+6 -12000000:1.2e+7 -120000000:1.2e+8 -1200000000:1.2e+9 -12000000000:1.2e+10 -120000000000:1.2e+11 -1200000000000:1.2e+12 - -0.00000000000123:1.23e-12 -0.0000000000123:1.23e-11 -0.000000000123:1.23e-10 -0.00000000123:1.23e-9 -0.0000000123:1.23e-8 -0.000000123:1.23e-7 -0.00000123:1.23e-6 -0.0000123:1.23e-5 -0.000123:1.23e-4 -0.00123:1.23e-3 -0.0123:1.23e-2 -0.123:1.23e-1 -1.23:1.23e+0 -12.3:1.23e+1 -123:1.23e+2 -1230:1.23e+3 -12300:1.23e+4 -123000:1.23e+5 -1230000:1.23e+6 -12300000:1.23e+7 -123000000:1.23e+8 -1230000000:1.23e+9 -12300000000:1.23e+10 -123000000000:1.23e+11 -1230000000000:1.23e+12 - -0.000000000001234:1.234e-12 -0.00000000001234:1.234e-11 -0.0000000001234:1.234e-10 -0.000000001234:1.234e-9 -0.00000001234:1.234e-8 -0.0000001234:1.234e-7 -0.000001234:1.234e-6 -0.00001234:1.234e-5 -0.0001234:1.234e-4 -0.001234:1.234e-3 -0.01234:1.234e-2 -0.1234:1.234e-1 -1.234:1.234e+0 -12.34:1.234e+1 -123.4:1.234e+2 -1234:1.234e+3 -12340:1.234e+4 -123400:1.234e+5 -1234000:1.234e+6 -12340000:1.234e+7 -123400000:1.234e+8 -1234000000:1.234e+9 -12340000000:1.234e+10 -123400000000:1.234e+11 -1234000000000:1.234e+12 - -0.000003141592:3.141592e-6 -0.00003141592:3.141592e-5 -0.0003141592:3.141592e-4 -0.003141592:3.141592e-3 -0.03141592:3.141592e-2 -0.3141592:3.141592e-1 -3.141592:3.141592e+0 -31.41592:3.141592e+1 -314.1592:3.141592e+2 -3141.592:3.141592e+3 -31415.92:3.141592e+4 -314159.2:3.141592e+5 -3141592:3.141592e+6 - -# negative numbers - --0.000000000001:-1e-12 --0.00000000001:-1e-11 --0.0000000001:-1e-10 --0.000000001:-1e-9 --0.00000001:-1e-8 --0.0000001:-1e-7 --0.000001:-1e-6 --0.00001:-1e-5 --0.0001:-1e-4 --0.001:-1e-3 --0.01:-1e-2 --0.1:-1e-1 --1:-1e+0 --10:-1e+1 --100:-1e+2 --1000:-1e+3 --10000:-1e+4 --100000:-1e+5 --1000000:-1e+6 --10000000:-1e+7 --100000000:-1e+8 --1000000000:-1e+9 --10000000000:-1e+10 --100000000000:-1e+11 --1000000000000:-1e+12 - --0.0000000000012:-1.2e-12 --0.000000000012:-1.2e-11 --0.00000000012:-1.2e-10 --0.0000000012:-1.2e-9 --0.000000012:-1.2e-8 --0.00000012:-1.2e-7 --0.0000012:-1.2e-6 --0.000012:-1.2e-5 --0.00012:-1.2e-4 --0.0012:-1.2e-3 --0.012:-1.2e-2 --0.12:-1.2e-1 --1.2:-1.2e+0 --12:-1.2e+1 --120:-1.2e+2 --1200:-1.2e+3 --12000:-1.2e+4 --120000:-1.2e+5 --1200000:-1.2e+6 --12000000:-1.2e+7 --120000000:-1.2e+8 --1200000000:-1.2e+9 --12000000000:-1.2e+10 --120000000000:-1.2e+11 --1200000000000:-1.2e+12 - --0.00000000000123:-1.23e-12 --0.0000000000123:-1.23e-11 --0.000000000123:-1.23e-10 --0.00000000123:-1.23e-9 --0.0000000123:-1.23e-8 --0.000000123:-1.23e-7 --0.00000123:-1.23e-6 --0.0000123:-1.23e-5 --0.000123:-1.23e-4 --0.00123:-1.23e-3 --0.0123:-1.23e-2 --0.123:-1.23e-1 --1.23:-1.23e+0 --12.3:-1.23e+1 --123:-1.23e+2 --1230:-1.23e+3 --12300:-1.23e+4 --123000:-1.23e+5 --1230000:-1.23e+6 --12300000:-1.23e+7 --123000000:-1.23e+8 --1230000000:-1.23e+9 --12300000000:-1.23e+10 --123000000000:-1.23e+11 --1230000000000:-1.23e+12 - --0.000000000001234:-1.234e-12 --0.00000000001234:-1.234e-11 --0.0000000001234:-1.234e-10 --0.000000001234:-1.234e-9 --0.00000001234:-1.234e-8 --0.0000001234:-1.234e-7 --0.000001234:-1.234e-6 --0.00001234:-1.234e-5 --0.0001234:-1.234e-4 --0.001234:-1.234e-3 --0.01234:-1.234e-2 --0.1234:-1.234e-1 --1.234:-1.234e+0 --12.34:-1.234e+1 --123.4:-1.234e+2 --1234:-1.234e+3 --12340:-1.234e+4 --123400:-1.234e+5 --1234000:-1.234e+6 --12340000:-1.234e+7 --123400000:-1.234e+8 --1234000000:-1.234e+9 --12340000000:-1.234e+10 --123400000000:-1.234e+11 --1234000000000:-1.234e+12 - --0.000003141592:-3.141592e-6 --0.00003141592:-3.141592e-5 --0.0003141592:-3.141592e-4 --0.003141592:-3.141592e-3 --0.03141592:-3.141592e-2 --0.3141592:-3.141592e-1 --3.141592:-3.141592e+0 --31.41592:-3.141592e+1 --314.1592:-3.141592e+2 --3141.592:-3.141592e+3 --31415.92:-3.141592e+4 --314159.2:-3.141592e+5 --3141592:-3.141592e+6 diff --git a/cpan/Math-BigInt/t/bnstr-mbi.t b/cpan/Math-BigInt/t/bnstr-mbi.t deleted file mode 100644 index ee4eec385e..0000000000 --- a/cpan/Math-BigInt/t/bnstr-mbi.t +++ /dev/null @@ -1,158 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 220; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - { - my $test = qq|\$x = Math::BigInt -> new("$x_str");| - . qq| \$str = \$x -> bnstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); - } - -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -1:1e+0 -10:1e+1 -100:1e+2 -1000:1e+3 -10000:1e+4 -100000:1e+5 -1000000:1e+6 -10000000:1e+7 -100000000:1e+8 -1000000000:1e+9 -10000000000:1e+10 -100000000000:1e+11 -1000000000000:1e+12 - -12:1.2e+1 -120:1.2e+2 -1200:1.2e+3 -12000:1.2e+4 -120000:1.2e+5 -1200000:1.2e+6 -12000000:1.2e+7 -120000000:1.2e+8 -1200000000:1.2e+9 -12000000000:1.2e+10 -120000000000:1.2e+11 -1200000000000:1.2e+12 - -123:1.23e+2 -1230:1.23e+3 -12300:1.23e+4 -123000:1.23e+5 -1230000:1.23e+6 -12300000:1.23e+7 -123000000:1.23e+8 -1230000000:1.23e+9 -12300000000:1.23e+10 -123000000000:1.23e+11 -1230000000000:1.23e+12 - -1234:1.234e+3 -12340:1.234e+4 -123400:1.234e+5 -1234000:1.234e+6 -12340000:1.234e+7 -123400000:1.234e+8 -1234000000:1.234e+9 -12340000000:1.234e+10 -123400000000:1.234e+11 -1234000000000:1.234e+12 - -3:3e+0 -31:3.1e+1 -314:3.14e+2 -3141:3.141e+3 -31415:3.1415e+4 -314159:3.14159e+5 -3141592:3.141592e+6 - -# negative numbers - --1:-1e+0 --10:-1e+1 --100:-1e+2 --1000:-1e+3 --10000:-1e+4 --100000:-1e+5 --1000000:-1e+6 --10000000:-1e+7 --100000000:-1e+8 --1000000000:-1e+9 --10000000000:-1e+10 --100000000000:-1e+11 --1000000000000:-1e+12 - --12:-1.2e+1 --120:-1.2e+2 --1200:-1.2e+3 --12000:-1.2e+4 --120000:-1.2e+5 --1200000:-1.2e+6 --12000000:-1.2e+7 --120000000:-1.2e+8 --1200000000:-1.2e+9 --12000000000:-1.2e+10 --120000000000:-1.2e+11 --1200000000000:-1.2e+12 - --123:-1.23e+2 --1230:-1.23e+3 --12300:-1.23e+4 --123000:-1.23e+5 --1230000:-1.23e+6 --12300000:-1.23e+7 --123000000:-1.23e+8 --1230000000:-1.23e+9 --12300000000:-1.23e+10 --123000000000:-1.23e+11 --1230000000000:-1.23e+12 - --1234:-1.234e+3 --12340:-1.234e+4 --123400:-1.234e+5 --1234000:-1.234e+6 --12340000:-1.234e+7 --123400000:-1.234e+8 --1234000000:-1.234e+9 --12340000000:-1.234e+10 --123400000000:-1.234e+11 --1234000000000:-1.234e+12 - --3:-3e+0 --31:-3.1e+1 --314:-3.14e+2 --3141:-3.141e+3 --31415:-3.1415e+4 --314159:-3.14159e+5 --3141592:-3.141592e+6 diff --git a/cpan/Math-BigInt/t/bpi-mbf.t b/cpan/Math-BigInt/t/bpi-mbf.t deleted file mode 100644 index 38b9350b2d..0000000000 --- a/cpan/Math-BigInt/t/bpi-mbf.t +++ /dev/null @@ -1,53 +0,0 @@ -# -*- 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 deleted file mode 100644 index 6fa66687de..0000000000 --- a/cpan/Math-BigInt/t/bpi-mbi.t +++ /dev/null @@ -1,103 +0,0 @@ -# -*- 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/bpow-mbf.t b/cpan/Math-BigInt/t/bpow-mbf.t deleted file mode 100644 index 72ad4d9c21..0000000000 --- a/cpan/Math-BigInt/t/bpow-mbf.t +++ /dev/null @@ -1,348 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 255; - -use Math::BigFloat; - -my $class = "Math::BigFloat"; - -use Math::Complex (); - -my $inf = $Math::Complex::Inf; -my $nan = $inf - $inf; - -# The following is used to compute the data at the end of this file. - -if (0) { - my @x = (-$inf, -64, -3, -2.5, -2, -1.5, -1, -0.5, 0, - 0.5, 1, 1.5, 2, 2.5, 3, 64, $inf); - my @y = (-$inf, -3, -2.5, -2, -1.5, -1, -0.5, 0, - 0.5, 1, 1.5, 2, 2.5, 3, $inf); - for my $x (@x) { - for my $y (@y) { - - # The exceptions here are based on Wolfram Alpha, - # https://www.wolframalpha.com/ - - my $z = $x == -$inf && $y == 0 ? $nan - : $x == $inf && $y == 0 ? $nan - : $x == -1 && $y == -$inf ? $nan - : $x == -1 && $y == $inf ? $nan - : $x ** $y; - - # Unfortunately, Math::Big* uses "inf", not "Inf" as Perl. - - printf "%s\n", join ":", map { $_ == $inf ? "inf" - : $_ == -$inf ? "-inf" - : $_ } $x, $y, $z; - } - } - - exit; -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my @args = split /:/; - my $want = pop @args; - - my ($x, $y, $z); - - my $test = qq|\$x = $class -> new("$args[0]"); | - . qq|\$y = $class -> new("$args[1]"); | - . qq|\$z = \$x -> bpow(\$y)|; - - eval "$test"; - die $@ if $@; - - subtest $test => sub { - plan tests => 5; - - is(ref($x), $class, "\$x is still a $class"); - - is(ref($y), $class, "\$y is still a $class"); - is($y, $args[1], "\$y is unmodified"); - - is(ref($z), $class, "\$z is a $class"); - - # If $want is a finite non-integer and $x is finite, measure the - # relative difference. - - if ($want * 0 == 0 && $want != int $want && $x -> is_finite()) { - if (abs(($z -> numify() - $want) / $want) < 1e-8) { - pass("\$z has the right value"); - } else { - fail("\$z has the right value"); - diag(<<"EOF"); - got: '$z' - expected: '$want' -EOF - } - } else { - is($z, $want, "\$z has the right value"); - } - }; -} - -__END__ --inf:-inf:0 --inf:-3:0 --inf:-2.5:0 --inf:-2:0 --inf:-1.5:0 --inf:-1:0 --inf:-0.5:0 --inf:0:NaN --inf:0.5:inf --inf:1:-inf --inf:1.5:inf --inf:2:inf --inf:2.5:inf --inf:3:-inf --inf:inf:inf --64:-inf:0 --64:-3:-3.814697265625e-06 --64:-2.5:NaN --64:-2:0.000244140625 --64:-1.5:NaN --64:-1:-0.015625 --64:-0.5:NaN --64:0:1 --64:0.5:NaN --64:1:-64 --64:1.5:NaN --64:2:4096 --64:2.5:NaN --64:3:-262144 --64:inf:inf --3:-inf:0 --3:-3:-0.037037037037037 --3:-2.5:NaN --3:-2:0.111111111111111 --3:-1.5:NaN --3:-1:-0.333333333333333 --3:-0.5:NaN --3:0:1 --3:0.5:NaN --3:1:-3 --3:1.5:NaN --3:2:9 --3:2.5:NaN --3:3:-27 --3:inf:inf --2.5:-inf:0 --2.5:-3:-0.064 --2.5:-2.5:NaN --2.5:-2:0.16 --2.5:-1.5:NaN --2.5:-1:-0.4 --2.5:-0.5:NaN --2.5:0:1 --2.5:0.5:NaN --2.5:1:-2.5 --2.5:1.5:NaN --2.5:2:6.25 --2.5:2.5:NaN --2.5:3:-15.625 --2.5:inf:inf --2:-inf:0 --2:-3:-0.125 --2:-2.5:NaN --2:-2:0.25 --2:-1.5:NaN --2:-1:-0.5 --2:-0.5:NaN --2:0:1 --2:0.5:NaN --2:1:-2 --2:1.5:NaN --2:2:4 --2:2.5:NaN --2:3:-8 --2:inf:inf --1.5:-inf:0 --1.5:-3:-0.296296296296296 --1.5:-2.5:NaN --1.5:-2:0.444444444444444 --1.5:-1.5:NaN --1.5:-1:-0.666666666666667 --1.5:-0.5:NaN --1.5:0:1 --1.5:0.5:NaN --1.5:1:-1.5 --1.5:1.5:NaN --1.5:2:2.25 --1.5:2.5:NaN --1.5:3:-3.375 --1.5:inf:inf --1:-inf:NaN --1:-3:-1 --1:-2.5:NaN --1:-2:1 --1:-1.5:NaN --1:-1:-1 --1:-0.5:NaN --1:0:1 --1:0.5:NaN --1:1:-1 --1:1.5:NaN --1:2:1 --1:2.5:NaN --1:3:-1 --1:inf:NaN --0.5:-inf:inf --0.5:-3:-8 --0.5:-2.5:NaN --0.5:-2:4 --0.5:-1.5:NaN --0.5:-1:-2 --0.5:-0.5:NaN --0.5:0:1 --0.5:0.5:NaN --0.5:1:-0.5 --0.5:1.5:NaN --0.5:2:0.25 --0.5:2.5:NaN --0.5:3:-0.125 --0.5:inf:0 -0:-inf:inf -0:-3:inf -0:-2.5:inf -0:-2:inf -0:-1.5:inf -0:-1:inf -0:-0.5:inf -0:0:1 -0:0.5:0 -0:1:0 -0:1.5:0 -0:2:0 -0:2.5:0 -0:3:0 -0:inf:0 -0.5:-inf:inf -0.5:-3:8 -0.5:-2.5:5.65685424949238 -0.5:-2:4 -0.5:-1.5:2.82842712474619 -0.5:-1:2 -0.5:-0.5:1.4142135623731 -0.5:0:1 -0.5:0.5:0.707106781186548 -0.5:1:0.5 -0.5:1.5:0.353553390593274 -0.5:2:0.25 -0.5:2.5:0.176776695296637 -0.5:3:0.125 -0.5:inf:0 -1:-inf:1 -1:-3:1 -1:-2.5:1 -1:-2:1 -1:-1.5:1 -1:-1:1 -1:-0.5:1 -1:0:1 -1:0.5:1 -1:1:1 -1:1.5:1 -1:2:1 -1:2.5:1 -1:3:1 -1:inf:1 -1.5:-inf:0 -1.5:-3:0.296296296296296 -1.5:-2.5:0.362887369301212 -1.5:-2:0.444444444444444 -1.5:-1.5:0.544331053951817 -1.5:-1:0.666666666666667 -1.5:-0.5:0.816496580927726 -1.5:0:1 -1.5:0.5:1.22474487139159 -1.5:1:1.5 -1.5:1.5:1.83711730708738 -1.5:2:2.25 -1.5:2.5:2.75567596063108 -1.5:3:3.375 -1.5:inf:inf -2:-inf:0 -2:-3:0.125 -2:-2.5:0.176776695296637 -2:-2:0.25 -2:-1.5:0.353553390593274 -2:-1:0.5 -2:-0.5:0.707106781186548 -2:0:1 -2:0.5:1.4142135623731 -2:1:2 -2:1.5:2.82842712474619 -2:2:4 -2:2.5:5.65685424949238 -2:3:8 -2:inf:inf -2.5:-inf:0 -2.5:-3:0.064 -2.5:-2.5:0.101192885125388 -2.5:-2:0.16 -2.5:-1.5:0.25298221281347 -2.5:-1:0.4 -2.5:-0.5:0.632455532033676 -2.5:0:1 -2.5:0.5:1.58113883008419 -2.5:1:2.5 -2.5:1.5:3.95284707521047 -2.5:2:6.25 -2.5:2.5:9.88211768802619 -2.5:3:15.625 -2.5:inf:inf -3:-inf:0 -3:-3:0.037037037037037 -3:-2.5:0.0641500299099584 -3:-2:0.111111111111111 -3:-1.5:0.192450089729875 -3:-1:0.333333333333333 -3:-0.5:0.577350269189626 -3:0:1 -3:0.5:1.73205080756888 -3:1:3 -3:1.5:5.19615242270663 -3:2:9 -3:2.5:15.5884572681199 -3:3:27 -3:inf:inf -64:-inf:0 -64:-3:3.814697265625e-06 -64:-2.5:3.0517578125e-05 -64:-2:0.000244140625 -64:-1.5:0.001953125 -64:-1:0.015625 -64:-0.5:0.125 -64:0:1 -64:0.5:8 -64:1:64 -64:1.5:512 -64:2:4096 -64:2.5:32768 -64:3:262144 -64:inf:inf -inf:-inf:0 -inf:-3:0 -inf:-2.5:0 -inf:-2:0 -inf:-1.5:0 -inf:-1:0 -inf:-0.5:0 -inf:0:NaN -inf:0.5:inf -inf:1:inf -inf:1.5:inf -inf:2:inf -inf:2.5:inf -inf:3:inf -inf:inf:inf diff --git a/cpan/Math-BigInt/t/bpow-mbi.t b/cpan/Math-BigInt/t/bpow-mbi.t deleted file mode 100644 index 6fbf270821..0000000000 --- a/cpan/Math-BigInt/t/bpow-mbi.t +++ /dev/null @@ -1,172 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 99; - -use Math::BigInt; - -my $class = "Math::BigInt"; - -use Math::Complex (); - -my $inf = $Math::Complex::Inf; -my $nan = $inf - $inf; - -# The following is used to compute the data at the end of this file. - -if (0) { - for my $x (-$inf, -64, -3, -2, -1, 0, 1, 2, 3, 64, $inf) { - for my $y (-$inf, -3, -2, -1, 0, 1, 2, 3, $inf) { - - # The exceptions here are based on Wolfram Alpha, - # https://www.wolframalpha.com/ - - my $z = $x == -$inf && $y == 0 ? $nan - : $x == $inf && $y == 0 ? $nan - : $x == -1 && $y == -$inf ? $nan - : $x == -1 && $y == $inf ? $nan - : int($x ** $y); - - # Unfortunately, Math::Big* uses "inf", not "Inf" as Perl. - - printf "%s\n", join ":", map { $_ == $inf ? "inf" - : $_ == -$inf ? "-inf" - : $_ } $x, $y, $z; - } - } - - exit; -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my @args = split /:/; - my $want = pop @args; - - my ($x, $y, $z); - - my $test = qq|\$x = $class -> new("$args[0]"); | - . qq|\$y = $class -> new("$args[1]"); | - . qq|\$z = \$x -> bpow(\$y)|; - - eval "$test"; - die $@ if $@; - - subtest $test => sub { - plan tests => 5; - - is(ref($x), $class, "\$x is still a $class"); - - is(ref($y), $class, "\$y is still a $class"); - is($y, $args[1], "\$y is unmodified"); - - is(ref($z), $class, "\$z is a $class"); - is($z, $want, "\$z has the right value"); - }; -} - -__DATA__ --inf:-inf:0 --inf:-3:0 --inf:-2:0 --inf:-1:0 --inf:0:NaN --inf:1:-inf --inf:2:inf --inf:3:-inf --inf:inf:inf --64:-inf:0 --64:-3:0 --64:-2:0 --64:-1:0 --64:0:1 --64:1:-64 --64:2:4096 --64:3:-262144 --64:inf:inf --3:-inf:0 --3:-3:0 --3:-2:0 --3:-1:0 --3:0:1 --3:1:-3 --3:2:9 --3:3:-27 --3:inf:inf --2:-inf:0 --2:-3:0 --2:-2:0 --2:-1:0 --2:0:1 --2:1:-2 --2:2:4 --2:3:-8 --2:inf:inf --1:-inf:NaN --1:-3:-1 --1:-2:1 --1:-1:-1 --1:0:1 --1:1:-1 --1:2:1 --1:3:-1 --1:inf:NaN -0:-inf:inf -0:-3:inf -0:-2:inf -0:-1:inf -0:0:1 -0:1:0 -0:2:0 -0:3:0 -0:inf:0 -1:-inf:1 -1:-3:1 -1:-2:1 -1:-1:1 -1:0:1 -1:1:1 -1:2:1 -1:3:1 -1:inf:1 -2:-inf:0 -2:-3:0 -2:-2:0 -2:-1:0 -2:0:1 -2:1:2 -2:2:4 -2:3:8 -2:inf:inf -3:-inf:0 -3:-3:0 -3:-2:0 -3:-1:0 -3:0:1 -3:1:3 -3:2:9 -3:3:27 -3:inf:inf -64:-inf:0 -64:-3:0 -64:-2:0 -64:-1:0 -64:0:1 -64:1:64 -64:2:4096 -64:3:262144 -64:inf:inf -inf:-inf:0 -inf:-3:0 -inf:-2:0 -inf:-1:0 -inf:0:NaN -inf:1:inf -inf:2:inf -inf:3:inf -inf:inf:inf diff --git a/cpan/Math-BigInt/t/bsstr-mbf.t b/cpan/Math-BigInt/t/bsstr-mbf.t deleted file mode 100644 index 3c18e6c64f..0000000000 --- a/cpan/Math-BigInt/t/bsstr-mbf.t +++ /dev/null @@ -1,275 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 460; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - my $test = qq|\$x = Math::BigFloat -> new("$x_str");| - . qq| \$str = \$x -> bsstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -0.000000000001:1e-12 -0.00000000001:1e-11 -0.0000000001:1e-10 -0.000000001:1e-9 -0.00000001:1e-8 -0.0000001:1e-7 -0.000001:1e-6 -0.00001:1e-5 -0.0001:1e-4 -0.001:1e-3 -0.01:1e-2 -0.1:1e-1 -1:1e+0 -10:1e+1 -100:1e+2 -1000:1e+3 -10000:1e+4 -100000:1e+5 -1000000:1e+6 -10000000:1e+7 -100000000:1e+8 -1000000000:1e+9 -10000000000:1e+10 -100000000000:1e+11 -1000000000000:1e+12 - -0.0000000000012:12e-13 -0.000000000012:12e-12 -0.00000000012:12e-11 -0.0000000012:12e-10 -0.000000012:12e-9 -0.00000012:12e-8 -0.0000012:12e-7 -0.000012:12e-6 -0.00012:12e-5 -0.0012:12e-4 -0.012:12e-3 -0.12:12e-2 -1.2:12e-1 -12:12e+0 -120:12e+1 -1200:12e+2 -12000:12e+3 -120000:12e+4 -1200000:12e+5 -12000000:12e+6 -120000000:12e+7 -1200000000:12e+8 -12000000000:12e+9 -120000000000:12e+10 -1200000000000:12e+11 - -0.00000000000123:123e-14 -0.0000000000123:123e-13 -0.000000000123:123e-12 -0.00000000123:123e-11 -0.0000000123:123e-10 -0.000000123:123e-9 -0.00000123:123e-8 -0.0000123:123e-7 -0.000123:123e-6 -0.00123:123e-5 -0.0123:123e-4 -0.123:123e-3 -1.23:123e-2 -12.3:123e-1 -123:123e+0 -1230:123e+1 -12300:123e+2 -123000:123e+3 -1230000:123e+4 -12300000:123e+5 -123000000:123e+6 -1230000000:123e+7 -12300000000:123e+8 -123000000000:123e+9 -1230000000000:123e+10 - -0.000000000001234:1234e-15 -0.00000000001234:1234e-14 -0.0000000001234:1234e-13 -0.000000001234:1234e-12 -0.00000001234:1234e-11 -0.0000001234:1234e-10 -0.000001234:1234e-9 -0.00001234:1234e-8 -0.0001234:1234e-7 -0.001234:1234e-6 -0.01234:1234e-5 -0.1234:1234e-4 -1.234:1234e-3 -12.34:1234e-2 -123.4:1234e-1 -1234:1234e+0 -12340:1234e+1 -123400:1234e+2 -1234000:1234e+3 -12340000:1234e+4 -123400000:1234e+5 -1234000000:1234e+6 -12340000000:1234e+7 -123400000000:1234e+8 -1234000000000:1234e+9 - -0.000003141592:3141592e-12 -0.00003141592:3141592e-11 -0.0003141592:3141592e-10 -0.003141592:3141592e-9 -0.03141592:3141592e-8 -0.3141592:3141592e-7 -3.141592:3141592e-6 -31.41592:3141592e-5 -314.1592:3141592e-4 -3141.592:3141592e-3 -31415.92:3141592e-2 -314159.2:3141592e-1 -3141592:3141592e+0 - -# negative numbers - --0.000000000001:-1e-12 --0.00000000001:-1e-11 --0.0000000001:-1e-10 --0.000000001:-1e-9 --0.00000001:-1e-8 --0.0000001:-1e-7 --0.000001:-1e-6 --0.00001:-1e-5 --0.0001:-1e-4 --0.001:-1e-3 --0.01:-1e-2 --0.1:-1e-1 --1:-1e+0 --10:-1e+1 --100:-1e+2 --1000:-1e+3 --10000:-1e+4 --100000:-1e+5 --1000000:-1e+6 --10000000:-1e+7 --100000000:-1e+8 --1000000000:-1e+9 --10000000000:-1e+10 --100000000000:-1e+11 --1000000000000:-1e+12 - --0.0000000000012:-12e-13 --0.000000000012:-12e-12 --0.00000000012:-12e-11 --0.0000000012:-12e-10 --0.000000012:-12e-9 --0.00000012:-12e-8 --0.0000012:-12e-7 --0.000012:-12e-6 --0.00012:-12e-5 --0.0012:-12e-4 --0.012:-12e-3 --0.12:-12e-2 --1.2:-12e-1 --12:-12e+0 --120:-12e+1 --1200:-12e+2 --12000:-12e+3 --120000:-12e+4 --1200000:-12e+5 --12000000:-12e+6 --120000000:-12e+7 --1200000000:-12e+8 --12000000000:-12e+9 --120000000000:-12e+10 --1200000000000:-12e+11 - --0.00000000000123:-123e-14 --0.0000000000123:-123e-13 --0.000000000123:-123e-12 --0.00000000123:-123e-11 --0.0000000123:-123e-10 --0.000000123:-123e-9 --0.00000123:-123e-8 --0.0000123:-123e-7 --0.000123:-123e-6 --0.00123:-123e-5 --0.0123:-123e-4 --0.123:-123e-3 --1.23:-123e-2 --12.3:-123e-1 --123:-123e+0 --1230:-123e+1 --12300:-123e+2 --123000:-123e+3 --1230000:-123e+4 --12300000:-123e+5 --123000000:-123e+6 --1230000000:-123e+7 --12300000000:-123e+8 --123000000000:-123e+9 --1230000000000:-123e+10 - --0.000000000001234:-1234e-15 --0.00000000001234:-1234e-14 --0.0000000001234:-1234e-13 --0.000000001234:-1234e-12 --0.00000001234:-1234e-11 --0.0000001234:-1234e-10 --0.000001234:-1234e-9 --0.00001234:-1234e-8 --0.0001234:-1234e-7 --0.001234:-1234e-6 --0.01234:-1234e-5 --0.1234:-1234e-4 --1.234:-1234e-3 --12.34:-1234e-2 --123.4:-1234e-1 --1234:-1234e+0 --12340:-1234e+1 --123400:-1234e+2 --1234000:-1234e+3 --12340000:-1234e+4 --123400000:-1234e+5 --1234000000:-1234e+6 --12340000000:-1234e+7 --123400000000:-1234e+8 --1234000000000:-1234e+9 - --0.000003141592:-3141592e-12 --0.00003141592:-3141592e-11 --0.0003141592:-3141592e-10 --0.003141592:-3141592e-9 --0.03141592:-3141592e-8 --0.3141592:-3141592e-7 --3.141592:-3141592e-6 --31.41592:-3141592e-5 --314.1592:-3141592e-4 --3141.592:-3141592e-3 --31415.92:-3141592e-2 --314159.2:-3141592e-1 --3141592:-3141592e+0 diff --git a/cpan/Math-BigInt/t/bsstr-mbi.t b/cpan/Math-BigInt/t/bsstr-mbi.t deleted file mode 100644 index 1093aa2821..0000000000 --- a/cpan/Math-BigInt/t/bsstr-mbi.t +++ /dev/null @@ -1,158 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 220; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $expected) = split /:/; - my ($x, $str); - - { - my $test = qq|\$x = Math::BigInt -> new("$x_str");| - . qq| \$str = \$x -> bsstr();|; - - note "\n$test\n\n"; - eval $test; - - is($str, $expected, qq|input value is "$x_str"|); - is($x, $x_str, "input object is unmodified"); - } - -} - -__DATA__ - -NaN:NaN - -inf:inf --inf:-inf - -0:0e+0 - -# positive numbers - -1:1e+0 -10:1e+1 -100:1e+2 -1000:1e+3 -10000:1e+4 -100000:1e+5 -1000000:1e+6 -10000000:1e+7 -100000000:1e+8 -1000000000:1e+9 -10000000000:1e+10 -100000000000:1e+11 -1000000000000:1e+12 - -12:12e+0 -120:12e+1 -1200:12e+2 -12000:12e+3 -120000:12e+4 -1200000:12e+5 -12000000:12e+6 -120000000:12e+7 -1200000000:12e+8 -12000000000:12e+9 -120000000000:12e+10 -1200000000000:12e+11 - -123:123e+0 -1230:123e+1 -12300:123e+2 -123000:123e+3 -1230000:123e+4 -12300000:123e+5 -123000000:123e+6 -1230000000:123e+7 -12300000000:123e+8 -123000000000:123e+9 -1230000000000:123e+10 - -1234:1234e+0 -12340:1234e+1 -123400:1234e+2 -1234000:1234e+3 -12340000:1234e+4 -123400000:1234e+5 -1234000000:1234e+6 -12340000000:1234e+7 -123400000000:1234e+8 -1234000000000:1234e+9 - -3:3e+0 -31:31e+0 -314:314e+0 -3141:3141e+0 -31415:31415e+0 -314159:314159e+0 -3141592:3141592e+0 - -# negative numbers - --1:-1e+0 --10:-1e+1 --100:-1e+2 --1000:-1e+3 --10000:-1e+4 --100000:-1e+5 --1000000:-1e+6 --10000000:-1e+7 --100000000:-1e+8 --1000000000:-1e+9 --10000000000:-1e+10 --100000000000:-1e+11 --1000000000000:-1e+12 - --12:-12e+0 --120:-12e+1 --1200:-12e+2 --12000:-12e+3 --120000:-12e+4 --1200000:-12e+5 --12000000:-12e+6 --120000000:-12e+7 --1200000000:-12e+8 --12000000000:-12e+9 --120000000000:-12e+10 --1200000000000:-12e+11 - --123:-123e+0 --1230:-123e+1 --12300:-123e+2 --123000:-123e+3 --1230000:-123e+4 --12300000:-123e+5 --123000000:-123e+6 --1230000000:-123e+7 --12300000000:-123e+8 --123000000000:-123e+9 --1230000000000:-123e+10 - --1234:-1234e+0 --12340:-1234e+1 --123400:-1234e+2 --1234000:-1234e+3 --12340000:-1234e+4 --123400000:-1234e+5 --1234000000:-1234e+6 --12340000000:-1234e+7 --123400000000:-1234e+8 --1234000000000:-1234e+9 - --3:-3e+0 --31:-31e+0 --314:-314e+0 --3141:-3141e+0 --31415:-31415e+0 --314159:-314159e+0 --3141592:-3141592e+0 diff --git a/cpan/Math-BigInt/t/buparrow-mbi.t b/cpan/Math-BigInt/t/buparrow-mbi.t deleted file mode 100644 index f2583418f9..0000000000 --- a/cpan/Math-BigInt/t/buparrow-mbi.t +++ /dev/null @@ -1,581 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1021; - -my $class; - -BEGIN { - $class = 'Math::BigInt'; - use_ok($class); -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($a, $n, $b, $expected) = split /:/; - - # buparrow() modifies the invocand. - - { - my ($x, $y); - my $test = qq|\$x = $class->new("$a"); \$y = \$x->buparrow($n, $b);|; - - subtest $test, - sub { - plan tests => 4; - - eval $test; - is($@, "", "'$test' gives emtpy \$\@"); - - is(ref($y), $class, - "'$test' output arg is a $class"); - - is($y -> bstr(), $expected, - "'$test' output arg has the right value"); - - is($x -> bstr(), $expected, - "'$test' invocand has the right value"); - }; - } - - # uparrow() does not modify the invocand. - - { - my ($x, $y); - my $test = qq|\$x = $class->new("$a"); \$y = \$x->uparrow($n, $b);|; - - subtest $test, - sub { - plan tests => 4; - - eval $test; - is($@, "", "'$test' gives emtpy \$\@"); - - is(ref($y), $class, - "'$test' output arg is a $class"); - - is($y -> bstr(), $expected, - "'$test' output arg has the right value"); - - is($x -> bstr(), $a, - "'$test' invocand has the right value"); - }; - } -} - -__DATA__ -0:0:0:0 -0:0:1:0 -0:0:2:0 -0:0:3:0 -0:0:4:0 -0:0:5:0 -0:0:6:0 -0:0:7:0 -0:0:8:0 -0:0:9:0 -0:1:0:1 -0:1:1:0 -0:1:2:0 -0:1:3:0 -0:1:4:0 -0:1:5:0 -0:1:6:0 -0:1:7:0 -0:1:8:0 -0:1:9:0 -0:2:0:1 -0:2:1:0 -0:2:2:1 -0:2:3:0 -0:2:4:1 -0:2:5:0 -0:2:6:1 -0:2:7:0 -0:2:8:1 -0:2:9:0 -0:3:0:1 -0:3:1:0 -0:3:2:1 -0:3:3:0 -0:3:4:1 -0:3:5:0 -0:3:6:1 -0:3:7:0 -0:3:8:1 -0:3:9:0 -0:4:0:1 -0:4:1:0 -0:4:2:1 -0:4:3:0 -0:4:4:1 -0:4:5:0 -0:4:6:1 -0:4:7:0 -0:4:8:1 -0:4:9:0 -0:5:0:1 -0:5:1:0 -0:5:2:1 -0:5:3:0 -0:5:4:1 -0:5:5:0 -0:5:6:1 -0:5:7:0 -0:5:8:1 -0:5:9:0 -0:6:0:1 -0:6:1:0 -0:6:2:1 -0:6:3:0 -0:6:4:1 -0:6:5:0 -0:6:6:1 -0:6:7:0 -0:6:8:1 -0:6:9:0 -0:7:0:1 -0:7:1:0 -0:7:2:1 -0:7:3:0 -0:7:4:1 -0:7:5:0 -0:7:6:1 -0:7:7:0 -0:7:8:1 -0:7:9:0 -0:8:0:1 -0:8:1:0 -0:8:2:1 -0:8:3:0 -0:8:4:1 -0:8:5:0 -0:8:6:1 -0:8:7:0 -0:8:8:1 -0:8:9:0 -0:9:0:1 -0:9:1:0 -0:9:2:1 -0:9:3:0 -0:9:4:1 -0:9:5:0 -0:9:6:1 -0:9:7:0 -0:9:8:1 -0:9:9:0 -1:0:0:0 -1:0:1:1 -1:0:2:2 -1:0:3:3 -1:0:4:4 -1:0:5:5 -1:0:6:6 -1:0:7:7 -1:0:8:8 -1:0:9:9 -1:1:0:1 -1:1:1:1 -1:1:2:1 -1:1:3:1 -1:1:4:1 -1:1:5:1 -1:1:6:1 -1:1:7:1 -1:1:8:1 -1:1:9:1 -1:2:0:1 -1:2:1:1 -1:2:2:1 -1:2:3:1 -1:2:4:1 -1:2:5:1 -1:2:6:1 -1:2:7:1 -1:2:8:1 -1:2:9:1 -1:3:0:1 -1:3:1:1 -1:3:2:1 -1:3:3:1 -1:3:4:1 -1:3:5:1 -1:3:6:1 -1:3:7:1 -1:3:8:1 -1:3:9:1 -1:4:0:1 -1:4:1:1 -1:4:2:1 -1:4:3:1 -1:4:4:1 -1:4:5:1 -1:4:6:1 -1:4:7:1 -1:4:8:1 -1:4:9:1 -1:5:0:1 -1:5:1:1 -1:5:2:1 -1:5:3:1 -1:5:4:1 -1:5:5:1 -1:5:6:1 -1:5:7:1 -1:5:8:1 -1:5:9:1 -1:6:0:1 -1:6:1:1 -1:6:2:1 -1:6:3:1 -1:6:4:1 -1:6:5:1 -1:6:6:1 -1:6:7:1 -1:6:8:1 -1:6:9:1 -1:7:0:1 -1:7:1:1 -1:7:2:1 -1:7:3:1 -1:7:4:1 -1:7:5:1 -1:7:6:1 -1:7:7:1 -1:7:8:1 -1:7:9:1 -1:8:0:1 -1:8:1:1 -1:8:2:1 -1:8:3:1 -1:8:4:1 -1:8:5:1 -1:8:6:1 -1:8:7:1 -1:8:8:1 -1:8:9:1 -1:9:0:1 -1:9:1:1 -1:9:2:1 -1:9:3:1 -1:9:4:1 -1:9:5:1 -1:9:6:1 -1:9:7:1 -1:9:8:1 -1:9:9:1 -2:0:0:0 -2:0:1:2 -2:0:2:4 -2:0:3:6 -2:0:4:8 -2:0:5:10 -2:0:6:12 -2:0:7:14 -2:0:8:16 -2:0:9:18 -2:1:0:1 -2:1:1:2 -2:1:2:4 -2:1:3:8 -2:1:4:16 -2:1:5:32 -2:1:6:64 -2:1:7:128 -2:1:8:256 -2:1:9:512 -2:2:0:1 -2:2:1:2 -2:2:2:4 -2:2:3:16 -2:2:4:65536 -2:3:0:1 -2:3:1:2 -2:3:2:4 -2:3:3:65536 -2:4:0:1 -2:4:1:2 -2:4:2:4 -2:5:0:1 -2:5:1:2 -2:5:2:4 -2:6:0:1 -2:6:1:2 -2:6:2:4 -2:7:0:1 -2:7:1:2 -2:7:2:4 -2:8:0:1 -2:8:1:2 -2:8:2:4 -2:9:0:1 -2:9:1:2 -2:9:2:4 -3:0:0:0 -3:0:1:3 -3:0:2:6 -3:0:3:9 -3:0:4:12 -3:0:5:15 -3:0:6:18 -3:0:7:21 -3:0:8:24 -3:0:9:27 -3:1:0:1 -3:1:1:3 -3:1:2:9 -3:1:3:27 -3:1:4:81 -3:1:5:243 -3:1:6:729 -3:1:7:2187 -3:1:8:6561 -3:1:9:19683 -3:2:0:1 -3:2:1:3 -3:2:2:27 -3:2:3:7625597484987 -3:3:0:1 -3:3:1:3 -3:3:2:7625597484987 -3:4:0:1 -3:4:1:3 -3:5:0:1 -3:5:1:3 -3:6:0:1 -3:6:1:3 -3:7:0:1 -3:7:1:3 -3:8:0:1 -3:8:1:3 -3:9:0:1 -3:9:1:3 -4:0:0:0 -4:0:1:4 -4:0:2:8 -4:0:3:12 -4:0:4:16 -4:0:5:20 -4:0:6:24 -4:0:7:28 -4:0:8:32 -4:0:9:36 -4:1:0:1 -4:1:1:4 -4:1:2:16 -4:1:3:64 -4:1:4:256 -4:1:5:1024 -4:1:6:4096 -4:1:7:16384 -4:1:8:65536 -4:1:9:262144 -4:2:0:1 -4:2:1:4 -4:2:2:256 -4:2:3:13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084096 -4:3:0:1 -4:3:1:4 -4:4:0:1 -4:4:1:4 -4:5:0:1 -4:5:1:4 -4:6:0:1 -4:6:1:4 -4:7:0:1 -4:7:1:4 -4:8:0:1 -4:8:1:4 -4:9:0:1 -4:9:1:4 -5:0:0:0 -5:0:1:5 -5:0:2:10 -5:0:3:15 -5:0:4:20 -5:0:5:25 -5:0:6:30 -5:0:7:35 -5:0:8:40 -5:0:9:45 -5:1:0:1 -5:1:1:5 -5:1:2:25 -5:1:3:125 -5:1:4:625 -5:1:5:3125 -5:1:6:15625 -5:1:7:78125 -5:1:8:390625 -5:1:9:1953125 -5:2:0:1 -5:2:1:5 -5:2:2:3125 -5:2:3:1911012597945477520356404559703964599198081048990094337139512789246520530242615803012059386519739850265586440155794462235359212788673806972288410146915986602087961896757195701839281660338047611225975533626101001482651123413147768252411493094447176965282756285196737514395357542479093219206641883011787169122552421070050709064674382870851449950256586194461543183511379849133691779928127433840431549236855526783596374102105331546031353725325748636909159778690328266459182983815230286936572873691422648131291743762136325730321645282979486862576245362218017673224940567642819360078720713837072355305446356153946401185348493792719514594505508232749221605848912910945189959948686199543147666938013037176163592594479746164220050885079469804487133205133160739134230540198872570038329801246050197013467397175909027389493923817315786996845899794781068042822436093783946335265422815704302832442385515082316490967285712171708123232790481817268327510112746782317410985888683708522000711733492253913322300756147180429007527677793352306200618286012455254243061006894805446584704820650982664319360960388736258510747074340636286976576702699258649953557976318173902550891331223294743930343956161328334072831663498258145226862004307799084688103804187368324800903873596212919633602583120781673673742533322879296907205490595621406888825991244581842379597863476484315673760923625090371511798941424262270220066286486867868710182980872802560693101949280830825044198424796792058908817112327192301455582916746795197430548026404646854002733993860798594465961501752586965811447568510041568687730903712482535343839285397598749458497050038225012489284001826590056251286187629938044407340142347062055785305325034918189589707199305662188512963187501743535960282201038211616048545121039313312256332260766436236688296850208839496142830484739113991669622649948563685234712873294796680884509405893951104650944137909502276545653133018670633521323028460519434381399810561400652595300731790772711065783494174642684720956134647327748584238274899668755052504394218232191357223054066715373374248543645663782045701654593218154053548393614250664498585403307466468541890148134347714650315037954175778622811776585876941680908203125 -5:3:0:1 -5:3:1:5 -5:4:0:1 -5:4:1:5 -5:5:0:1 -5:5:1:5 -5:6:0:1 -5:6:1:5 -5:7:0:1 -5:7:1:5 -5:8:0:1 -5:8:1:5 -5:9:0:1 -5:9:1:5 -6:0:0:0 -6:0:1:6 -6:0:2:12 -6:0:3:18 -6:0:4:24 -6:0:5:30 -6:0:6:36 -6:0:7:42 -6:0:8:48 -6:0:9:54 -6:1:0:1 -6:1:1:6 -6:1:2:36 -6:1:3:216 -6:1:4:1296 -6:1:5:7776 -6:1:6:46656 -6:1:7:279936 -6:1:8:1679616 -6:1:9:10077696 -6:2:0:1 -6:2:1:6 -6:2:2:46656 -6:3:0:1 -6:3:1:6 -6:4:0:1 -6:4:1:6 -6:5:0:1 -6:5:1:6 -6:6:0:1 -6:6:1:6 -6:7:0:1 -6:7:1:6 -6:8:0:1 -6:8:1:6 -6:9:0:1 -6:9:1:6 -7:0:0:0 -7:0:1:7 -7:0:2:14 -7:0:3:21 -7:0:4:28 -7:0:5:35 -7:0:6:42 -7:0:7:49 -7:0:8:56 -7:0:9:63 -7:1:0:1 -7:1:1:7 -7:1:2:49 -7:1:3:343 -7:1:4:2401 -7:1:5:16807 -7:1:6:117649 -7:1:7:823543 -7:1:8:5764801 -7:1:9:40353607 -7:2:0:1 -7:2:1:7 -7:2:2:823543 -7:3:0:1 -7:3:1:7 -7:4:0:1 -7:4:1:7 -7:5:0:1 -7:5:1:7 -7:6:0:1 -7:6:1:7 -7:7:0:1 -7:7:1:7 -7:8:0:1 -7:8:1:7 -7:9:0:1 -7:9:1:7 -8:0:0:0 -8:0:1:8 -8:0:2:16 -8:0:3:24 -8:0:4:32 -8:0:5:40 -8:0:6:48 -8:0:7:56 -8:0:8:64 -8:0:9:72 -8:1:0:1 -8:1:1:8 -8:1:2:64 -8:1:3:512 -8:1:4:4096 -8:1:5:32768 -8:1:6:262144 -8:1:7:2097152 -8:1:8:16777216 -8:1:9:134217728 -8:2:0:1 -8:2:1:8 -8:2:2:16777216 -8:3:0:1 -8:3:1:8 -8:4:0:1 -8:4:1:8 -8:5:0:1 -8:5:1:8 -8:6:0:1 -8:6:1:8 -8:7:0:1 -8:7:1:8 -8:8:0:1 -8:8:1:8 -8:9:0:1 -8:9:1:8 -9:0:0:0 -9:0:1:9 -9:0:2:18 -9:0:3:27 -9:0:4:36 -9:0:5:45 -9:0:6:54 -9:0:7:63 -9:0:8:72 -9:0:9:81 -9:1:0:1 -9:1:1:9 -9:1:2:81 -9:1:3:729 -9:1:4:6561 -9:1:5:59049 -9:1:6:531441 -9:1:7:4782969 -9:1:8:43046721 -9:1:9:387420489 -9:2:0:1 -9:2:1:9 -9:2:2:387420489 -9:3:0:1 -9:3:1:9 -9:4:0:1 -9:4:1:9 -9:5:0:1 -9:5:1:9 -9:6:0:1 -9:6:1:9 -9:7:0:1 -9:7:1:9 -9:8:0:1 -9:8:1:9 -9:9:0:1 -9:9:1:9 diff --git a/cpan/Math-BigInt/t/const-mbf.t b/cpan/Math-BigInt/t/const-mbf.t deleted file mode 100644 index d6231ae2ff..0000000000 --- a/cpan/Math-BigInt/t/const-mbf.t +++ /dev/null @@ -1,314 +0,0 @@ -# -*- 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 deleted file mode 100644 index 17c30c217d..0000000000 --- a/cpan/Math-BigInt/t/const-mbi.t +++ /dev/null @@ -1,235 +0,0 @@ -# -*- 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/downgrade.t b/cpan/Math-BigInt/t/downgrade.t index c5f34402e4..1d76a76a69 100644 --- a/cpan/Math-BigInt/t/downgrade.t +++ b/cpan/Math-BigInt/t/downgrade.t @@ -5,134 +5,233 @@ use strict; use warnings; -use Test::More tests => 164; +use Test::More tests => 93; use Math::BigInt upgrade => 'Math::BigFloat'; use Math::BigFloat downgrade => 'Math::BigInt'; -# simplistic test for now is(Math::BigFloat->downgrade(), 'Math::BigInt', 'Math::BigFloat->downgrade()'); is(Math::BigInt->upgrade(), 'Math::BigFloat', 'Math::BigInt->upgrade()'); # bug until v1.67: -is(Math::BigFloat->new("0.2E0"), "0.2", qq|Math::BigFloat->new("0.2E0")|); -is(Math::BigFloat->new("0.2E1"), "2", qq|Math::BigFloat->new("0.2E1")|); -# until v1.67 resulted in 200: -is(Math::BigFloat->new("0.2E2"), "20", qq|Math::BigFloat->new("0.2E2")|); - -# disable, otherwise it screws calculations -Math::BigFloat->upgrade(undef); -is(Math::BigFloat->upgrade() || "", "", qq/Math::BigFloat->upgrade() || ""/); - -Math::BigFloat->div_scale(20); # make it a bit faster -my $x = Math::BigFloat->new(2); # downgrades -# the following test upgrade for bsqrt() and also makes new() NOT downgrade -# for the bpow() side -is(Math::BigFloat->bpow("2", "0.5"), $x->bsqrt(), - qq|Math::BigFloat->bpow("2", "0.5")|); + +subtest 'Math::BigFloat->new("0.2E0")' => sub { + plan tests => 2; + my $x = Math::BigFloat->new("0.2E0"); + is($x, "0.2", 'value of $x'); + is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); +}; + +subtest 'Math::BigFloat->new("0.2E1")' => sub { + plan tests => 2; + my $x = Math::BigFloat->new("2"); + is($x, "2", 'value of $x'); + is(ref($x), "Math::BigInt", '$x is downgraded to a Math::BigInt'); +}; + +subtest 'Math::BigFloat->new("0.2E2")' => sub { + plan tests => 2; + my $x = Math::BigFloat->new("20"); + is($x, "20", 'value of $x'); + is(ref($x), "Math::BigInt", '$x is downgraded to a Math::BigInt'); +}; + +# $x is a downgraded to a Math::BigInt, but bpow() and bsqrt() upgrades to +# Math::BigFloat. + +Math::BigFloat -> div_scale(20); # make it a bit faster + +my ($x, $y, $z); +subtest '$x = Math::BigFloat -> new(2);' => sub { + plan tests => 2; + $x = Math::BigFloat -> new(2); # downgrades + is(ref($x), 'Math::BigInt', '$x is downgraded to a Math::BigInt'); + cmp_ok($x, "==", 2, 'value of $x'); +}; + +subtest '$y = Math::BigFloat -> bpow("2", "0.5");' => sub { + plan tests => 2; + $y = Math::BigFloat -> bpow("2", "0.5"); + is(ref($y), 'Math::BigFloat', '$y is a Math::BigFloat'); + cmp_ok($y, "==", "1.4142135623730950488", 'value of $y'); +}; + +subtest '$z = $x -> bsqrt();' => sub { + plan tests => 2; + $z = $x -> bsqrt(); + is(ref($z), 'Math::BigFloat', '$y is a Math::BigFloat'); + cmp_ok($z, "==", "1.4142135623730950488", 'value of $z'); +}; + +# log_2(16) = 4 + +subtest '$x = Math::BigFloat -> new(16); $y = $x -> blog(2);' => sub { + plan tests => 4; + $x = Math::BigFloat -> new(16); + is(ref($x), 'Math::BigInt', '$x is downgraded to a Math::BigInt'); + cmp_ok($x, "==", 16, 'value of $x'); + $y = $x -> blog(2); + is(ref($y), 'Math::BigInt', '$y is downgraded to a Math::BigInt'); + cmp_ok($y, "==", 4, 'value of $y'); +}; + +# log_16(2) = 1/4 + +subtest '$x = Math::BigFloat -> new(2); $y = $x -> blog(16);' => sub { + plan tests => 4; + $x = Math::BigFloat -> new(2); + is(ref($x), 'Math::BigInt', '$x is downgraded to a Math::BigInt'); + cmp_ok($x, "==", 2, 'value of $x'); + $y = $x -> blog(16); + is(ref($y), 'Math::BigFloat', '$y is a Math::BigFloat'); + cmp_ok($y, "==", 0.25, 'value of $y'); +}; ################################################################################ # Verify that constructors downgrade when they should. note("Enable downgrading, and see if constructors downgrade"); -Math::BigFloat -> downgrade("Math::BigInt"); - -# new() +note("testing new()"); $x = Math::BigFloat -> new("0.5"); -cmp_ok($x, "==", 0.5); -is(ref $x, "Math::BigFloat", "Creating a 0.5 does not downgrade"); +subtest '$x = Math::BigFloat -> new("0.5")' => sub { + plan tests => 2; + cmp_ok($x, "==", 0.5, 'value of $x'); + is(ref $x, "Math::BigFloat", "does not downgrade from Math::BigFloat"); +}; $x = Math::BigFloat -> new("4"); -cmp_ok($x, "==", 4, 'new("4")'); -is(ref $x, "Math::BigInt", "Creating a 4 downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> new("4")' => sub { + plan tests => 2; + cmp_ok($x, "==", 4, 'value of $x'); + is(ref $x, "Math::BigInt", "downgrades to Math::BigInt"); +}; $x = Math::BigFloat -> new("0"); -cmp_ok($x, "==", 0, 'new("0")'); -is(ref $x, "Math::BigInt", "Creating a 0 downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> new("0")' => sub { + plan tests => 2; + cmp_ok($x, "==", 0, 'value of $x'); + is(ref $x, "Math::BigInt", "downgrades to Math::BigInt"); +}; $x = Math::BigFloat -> new("1"); -cmp_ok($x, "==", 1, 'new("1")'); -is(ref $x, "Math::BigInt", "Creating a 1 downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> new("1")' => sub { + plan tests => 2; + cmp_ok($x, "==", 1, 'value of $x'); + is(ref $x, "Math::BigInt", "downgrades to Math::BigInt"); +}; $x = Math::BigFloat -> new("Inf"); -cmp_ok($x, "==", "Inf", 'new("inf")'); -is(ref $x, "Math::BigInt", "Creating an Inf downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> new("inf")' => sub { + plan tests => 2; + cmp_ok($x, "==", "Inf", 'value of $x'); + is(ref $x, "Math::BigInt", "downgrades to Math::BigInt"); +}; $x = Math::BigFloat -> new("NaN"); -is($x, "NaN", 'new("NaN")'); -is(ref $x, "Math::BigInt", "Creating a NaN downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> new("NaN")' => sub { + plan tests => 2; + is($x, "NaN", ); + is(ref $x, "Math::BigInt", "downgrades to Math::BigInt"); +}; -# bzero() +note("testing bzero()"); $x = Math::BigFloat -> bzero(); -cmp_ok($x, "==", 0, "bzero()"); -is(ref $x, "Math::BigInt", "Creating a 0 downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> bzero()' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; -# bone() +note("testing bone()"); $x = Math::BigFloat -> bone(); -cmp_ok($x, "==", 1, "bone()"); -is(ref $x, "Math::BigInt", "Creating a 1 downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> bone()' => sub { + plan tests => 2; + cmp_ok($x, '==', 1, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; -# binf() +note("testing binf()"); $x = Math::BigFloat -> binf(); -cmp_ok($x, "==", "Inf", "binf()"); -is(ref $x, "Math::BigInt", "Creating an Inf downgrades to Math::BigInt"); +subtest '$x = Math::BigFloat -> binf()' => sub { + plan tests => 2; + cmp_ok($x, '==', 'Inf', 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; -# bnan() +note("testing bnan()"); $x = Math::BigFloat -> bnan(); -is($x, "NaN", "bnan()"); -is(ref $x, "Math::BigInt", "Creating a NaN downgrades to Math::BigInt"); - -# from_dec() - -$x = Math::BigFloat -> from_dec("3.14e2"); -cmp_ok($x, "==", 314, 'from_dec("3.14e2")'); -is(ref $x, "Math::BigInt", 'from_dec("3.14e2") downgrades to Math::BigInt'); - -# from_hex() - -$x = Math::BigFloat -> from_hex("0x1.3ap+8"); -cmp_ok($x, "==", 314, 'from_hex("3.14e2")'); -is(ref $x, "Math::BigInt", 'from_hex("3.14e2") downgrades to Math::BigInt'); - -# from_oct() - -$x = Math::BigFloat -> from_oct("0o1.164p+8"); -cmp_ok($x, "==", 314, 'from_oct("0o1.164p+8")'); -is(ref $x, "Math::BigInt", 'from_oct("0o1.164p+8") downgrades to Math::BigInt'); - -# from_bin() - -$x = Math::BigFloat -> from_bin("0b1.0011101p+8"); -cmp_ok($x, "==", 314, 'from_bin("0b1.0011101p+8")'); -is(ref $x, "Math::BigInt", - 'from_bin("0b1.0011101p+8") downgrades to Math::BigInt'); - -# from_ieee754() +subtest '$x = Math::BigFloat -> bnan()' => sub { + plan tests => 2; + is($x, 'NaN', 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; + +note("testing from_dec()"); + +$x = Math::BigFloat -> from_dec('3.14e2'); +subtest '$x = Math::BigFloat -> from_dec("3.14e2")' => sub { + plan tests => 2; + cmp_ok($x, '==', 314, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; + +note("testing from_hex()"); + +$x = Math::BigFloat -> from_hex('0x1.3ap+8'); +subtest '$x = Math::BigFloat -> from_hex("3.14e2")' => sub { + plan tests => 2; + cmp_ok($x, '==', 314, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; + +note("testing from_oct()"); + +$x = Math::BigFloat -> from_oct('0o1.164p+8'); +subtest '$x = Math::BigFloat -> from_oct("0o1.164p+8")' => sub { + plan tests => 2; + cmp_ok($x, '==', 314, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; + +note("testing from_bin()"); + +$x = Math::BigFloat -> from_bin('0b1.0011101p+8'); +subtest '$x = Math::BigFloat -> from_bin("0b1.0011101p+8")' => sub { + plan tests => 2; + cmp_ok($x, '==', 314, 'value of $x'); + is(ref $x, 'Math::BigInt', 'downgrades to Math::BigInt'); +}; + +note("testing from_ieee754()"); $x = Math::BigFloat -> from_ieee754("\x43\x9d\x00\x00", "binary32"); -cmp_ok($x, "==", 314, 'from_ieee754("\x43\x9d\x00\x00", "binary32")'); -is(ref $x, "Math::BigInt", - 'from_ieee754("\x43\x9d\x00\x00", "binary32") downgrades to Math::BigInt'); +subtest '$x = Math::BigFloat -> from_ieee754("\x43\x9d\x00\x00", "binary32")' => sub { + plan tests => 2; + cmp_ok($x, "==", 314, 'value of $x'); + is(ref $x, "Math::BigInt", 'downgrades to Math::BigInt'); +}; note("Disable downgrading, and see if constructors downgrade"); Math::BigFloat -> downgrade(undef); +my $zero = Math::BigFloat -> bzero(); my $half = Math::BigFloat -> new("0.5"); +my $one = Math::BigFloat -> bone(); my $four = Math::BigFloat -> new("4"); -my $zero = Math::BigFloat -> bzero(); my $inf = Math::BigFloat -> binf(); my $nan = Math::BigFloat -> bnan(); +is(ref $zero, "Math::BigFloat", "Creating a 0 does not downgrade"); is(ref $half, "Math::BigFloat", "Creating a 0.5 does not downgrade"); +is(ref $one, "Math::BigFloat", "Creating a 1 does not downgrade"); is(ref $four, "Math::BigFloat", "Creating a 4 does not downgrade"); -is(ref $zero, "Math::BigFloat", "Creating a 0 does not downgrade"); is(ref $inf, "Math::BigFloat", "Creating an Inf does not downgrade"); is(ref $nan, "Math::BigFloat", "Creating a NaN does not downgrade"); @@ -141,352 +240,536 @@ is(ref $nan, "Math::BigFloat", "Creating a NaN does not downgrade"); Math::BigFloat -> downgrade("Math::BigInt"); -# This shouldn't be necessary, but it is. Fixme! - -Math::BigInt -> upgrade(undef); - -# bneg() +note("testing bneg()"); $x = $zero -> copy() -> bneg(); -cmp_ok($x, "==", 0, "-(0) = 0"); -is(ref($x), "Math::BigInt", "-(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bneg();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, '-(0) = 0'); + is(ref($x), 'Math::BigInt', '-(0) => Math::BigInt'); +}; $x = $four -> copy() -> bneg(); -cmp_ok($x, "==", -4, "-(4) = -4"); -is(ref($x), "Math::BigInt", "-(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bneg();' => sub { + plan tests => 2; + cmp_ok($x, '==', -4, '-(4) = -4'); + is(ref($x), 'Math::BigInt', '-(4) => Math::BigInt'); +}; $x = $inf -> copy() -> bneg(); -cmp_ok($x, "==", "-inf", "-(Inf) = -Inf"); -is(ref($x), "Math::BigInt", "-(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bneg();' => sub { + plan tests => 2; + cmp_ok($x, '==', '-inf', '-(Inf) = -Inf'); + is(ref($x), 'Math::BigInt', '-(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bneg(); -is($x, "NaN", "-(NaN) = NaN"); -is(ref($x), "Math::BigInt", "-(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bneg();' => sub { + plan tests => 2; + is($x, 'NaN', '-(NaN) = NaN'); + is(ref($x), 'Math::BigInt', '-(NaN) => Math::BigInt'); +}; -# bnorm() +note("testing bnorm()"); $x = $zero -> copy() -> bnorm(); -cmp_ok($x, "==", 0, "bnorm(0)"); -is(ref($x), "Math::BigInt", "bnorm(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bnorm();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'value of $x'); + is(ref($x), 'Math::BigInt', 'bnorm(0) => Math::BigInt'); +}; $x = $four -> copy() -> bnorm(); -cmp_ok($x, "==", 4, "bnorm(4)"); -is(ref($x), "Math::BigInt", "bnorm(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bnorm();' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, 'value of $x'); + is(ref($x), 'Math::BigInt', 'bnorm(4) => Math::BigInt'); +}; $x = $inf -> copy() -> bnorm(); -cmp_ok($x, "==", "inf", "bnorm(Inf)"); -is(ref($x), "Math::BigInt", "bnorm(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bnorm();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'value of $x'); + is(ref($x), 'Math::BigInt', 'bnorm(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bnorm(); -is($x, "NaN", "bnorm(NaN)"); -is(ref($x), "Math::BigInt", "bnorm(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bnorm();' => sub { + plan tests => 2; + is($x, 'NaN', 'bnorm(NaN)'); + is(ref($x), 'Math::BigInt', 'bnorm(NaN) => Math::BigInt'); +}; -# binc() +note("testing binc()"); $x = $zero -> copy() -> binc(); -cmp_ok($x, "==", 1, "binc(0)"); -is(ref($x), "Math::BigInt", "binc(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> binc();' => sub { + plan tests => 2; + cmp_ok($x, '==', 1, 'binc(0)'); + is(ref($x), 'Math::BigInt', 'binc(0) => Math::BigInt'); +}; $x = $four -> copy() -> binc(); -cmp_ok($x, "==", 5, "binc(4)"); -is(ref($x), "Math::BigInt", "binc(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> binc();' => sub { + plan tests => 2; + cmp_ok($x, '==', 5, 'binc(4)'); + is(ref($x), 'Math::BigInt', 'binc(4) => Math::BigInt'); +}; $x = $inf -> copy() -> binc(); -cmp_ok($x, "==", "inf", "binc(Inf)"); -is(ref($x), "Math::BigInt", "binc(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> binc();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'binc(Inf)'); + is(ref($x), 'Math::BigInt', 'binc(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> binc(); -is($x, "NaN", "binc(NaN)"); -is(ref($x), "Math::BigInt", "binc(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> binc();' => sub { + plan tests => 2; + is($x, 'NaN', 'binc(NaN)'); + is(ref($x), 'Math::BigInt', 'binc(NaN) => Math::BigInt'); +}; -# bdec() +note("testing bdec()"); $x = $zero -> copy() -> bdec(); -cmp_ok($x, "==", -1, "bdec(0)"); -is(ref($x), "Math::BigInt", "bdec(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bdec();' => sub { + plan tests => 2; + cmp_ok($x, '==', -1, 'bdec(0)'); + is(ref($x), 'Math::BigInt', 'bdec(0) => Math::BigInt'); +}; $x = $four -> copy() -> bdec(); -cmp_ok($x, "==", 3, "bdec(4)"); -is(ref($x), "Math::BigInt", "bdec(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bdec();' => sub { + plan tests => 2; + cmp_ok($x, '==', 3, 'bdec(4)'); + is(ref($x), 'Math::BigInt', 'bdec(4) => Math::BigInt'); +}; $x = $inf -> copy() -> bdec(); -cmp_ok($x, "==", "inf", "bdec(Inf)"); -is(ref($x), "Math::BigInt", "bdec(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bdec();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bdec(Inf)'); + is(ref($x), 'Math::BigInt', 'bdec(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bdec(); -is($x, "NaN", "bdec(NaN)"); -is(ref($x), "Math::BigInt", "bdec(NaN) => Math::BigInt"); +subtest '' => sub { + plan tests => 2; + is($x, 'NaN', 'bdec(NaN)'); + is(ref($x), 'Math::BigInt', 'bdec(NaN) => Math::BigInt'); +}; -# badd() +note("testing badd()"); $x = $half -> copy() -> badd($nan); -is($x, "NaN", "0.5 + NaN = NaN"); -is(ref($x), "Math::BigInt", "0.5 + NaN => Math::BigInt"); +subtest '$x = $half -> copy() -> badd($nan);' => sub { + plan tests => 2; + is($x, 'NaN', '0.5 + NaN = NaN'); + is(ref($x), 'Math::BigInt', '0.5 + NaN => Math::BigInt'); +}; $x = $half -> copy() -> badd($inf); -cmp_ok($x, "==", "+Inf", "0.5 + Inf = Inf"); -is(ref($x), "Math::BigInt", "2.5 + Inf => Math::BigInt"); +subtest '$x = $half -> copy() -> badd($inf);' => sub { + plan tests => 2; + cmp_ok($x, '==', '+Inf', '0.5 + Inf = Inf'); + is(ref($x), 'Math::BigInt', '2.5 + Inf => Math::BigInt'); +}; $x = $half -> copy() -> badd($half); -cmp_ok($x, "==", 1, "0.5 + 0.5 = 1"); -is(ref($x), "Math::BigInt", "0.5 + 0.5 => Math::BigInt"); +subtest '$x = $half -> copy() -> badd($half);' => sub { + plan tests => 2; + cmp_ok($x, '==', 1, '0.5 + 0.5 = 1'); + is(ref($x), 'Math::BigInt', '0.5 + 0.5 => Math::BigInt'); +}; $x = $half -> copy() -> badd($half -> copy() -> bneg()); -cmp_ok($x, "==", 0, "0.5 + -0.5 = 0"); -is(ref($x), "Math::BigInt", "0.5 + -0.5 => Math::BigInt"); +subtest '$x = $half -> copy() -> badd($half -> copy() -> bneg());' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, '0.5 + -0.5 = 0'); + is(ref($x), 'Math::BigInt', '0.5 + -0.5 => Math::BigInt'); +}; $x = $four -> copy() -> badd($zero); -cmp_ok($x, "==", 4, "4 + 0 = 4"); -is(ref($x), "Math::BigInt", "4 + 0 => Math::BigInt"); +subtest '$x = $four -> copy() -> badd($zero);' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, '4 + 0 = 4'); + is(ref($x), 'Math::BigInt', '4 + 0 => Math::BigInt'); +}; $x = $zero -> copy() -> badd($four); -cmp_ok($x, "==", 4, "0 + 4 = 4"); -is(ref($x), "Math::BigInt", "0 + 4 => Math::BigInt"); +subtest '$x = $zero -> copy() -> badd($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, '0 + 4 = 4'); + is(ref($x), 'Math::BigInt', '0 + 4 => Math::BigInt'); +}; $x = $inf -> copy() -> badd($four); -cmp_ok($x, "==", "+Inf", "Inf + 4 = Inf"); -is(ref($x), "Math::BigInt", "Inf + 4 => Math::BigInt"); +subtest '$x = $inf -> copy() -> badd($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', '+Inf', 'Inf + 4 = Inf'); + is(ref($x), 'Math::BigInt', 'Inf + 4 => Math::BigInt'); +}; $x = $nan -> copy() -> badd($four); -is($x, "NaN", "NaN + 4 = NaN"); -is(ref($x), "Math::BigInt", "NaN + 4 => Math::BigInt"); +subtest '$x = $nan -> copy() -> badd($four);' => sub { + plan tests => 2; + is($x, 'NaN', 'NaN + 4 = NaN'); + is(ref($x), 'Math::BigInt', 'NaN + 4 => Math::BigInt'); +}; -# bsub() +note("testing bsub()"); $x = $half -> copy() -> bsub($nan); -is($x, "NaN", "0.5 - NaN = NaN"); -is(ref($x), "Math::BigInt", "0.5 - NaN => Math::BigInt"); +subtest '$x = $half -> copy() -> bsub($nan);' => sub { + plan tests => 2; + is($x, 'NaN', '0.5 - NaN = NaN'); + is(ref($x), 'Math::BigInt', '0.5 - NaN => Math::BigInt'); +}; $x = $half -> copy() -> bsub($inf); -cmp_ok($x, "==", "-Inf", "2.5 - Inf = -Inf"); -is(ref($x), "Math::BigInt", "2.5 - Inf => Math::BigInt"); +subtest '$x = $half -> copy() -> bsub($inf);' => sub { + plan tests => 2; + cmp_ok($x, '==', '-Inf', '2.5 - Inf = -Inf'); + is(ref($x), 'Math::BigInt', '2.5 - Inf => Math::BigInt'); +}; $x = $half -> copy() -> bsub($half); -cmp_ok($x, "==", 0, "0.5 + 0.5 = 0"); -is(ref($x), "Math::BigInt", "0.5 - 0.5 => Math::BigInt"); +subtest '$x = $half -> copy() -> bsub($half);' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, '0.5 + 0.5 = 0'); + is(ref($x), 'Math::BigInt', '0.5 - 0.5 => Math::BigInt'); +}; $x = $half -> copy() -> bsub($half -> copy() -> bneg()); -cmp_ok($x, "==", 1, "0.5 - -0.5 = 1"); -is(ref($x), "Math::BigInt", "0.5 - -0.5 => Math::BigInt"); +subtest '$x = $half -> copy() -> bsub($half -> copy() -> bneg());' => sub { + plan tests => 2; + cmp_ok($x, '==', 1, '0.5 - -0.5 = 1'); + is(ref($x), 'Math::BigInt', '0.5 - -0.5 => Math::BigInt'); +}; $x = $four -> copy() -> bsub($zero); -cmp_ok($x, "==", 4, "4 - 0 = 4"); -is(ref($x), "Math::BigInt", "4 - 0 => Math::BigInt"); +subtest '$x = $four -> copy() -> bsub($zero);' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, '4 - 0 = 4'); + is(ref($x), 'Math::BigInt', '4 - 0 => Math::BigInt'); +}; $x = $zero -> copy() -> bsub($four); -cmp_ok($x, "==", -4, "0 - 4 = -4"); -is(ref($x), "Math::BigInt", "0 - 4 => Math::BigInt"); +subtest '$x = $zero -> copy() -> bsub($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', -4, '0 - 4 = -4'); + is(ref($x), 'Math::BigInt', '0 - 4 => Math::BigInt'); +}; $x = $inf -> copy() -> bsub($four); -cmp_ok($x, "==", "Inf", "Inf - 4 = Inf"); -is(ref($x), "Math::BigInt", "Inf - 4 => Math::BigInt"); +subtest '$x = $inf -> copy() -> bsub($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 'Inf', 'Inf - 4 = Inf'); + is(ref($x), 'Math::BigInt', 'Inf - 4 => Math::BigInt'); +}; $x = $nan -> copy() -> bsub($four); -is($x, "NaN", "NaN - 4 = NaN"); -is(ref($x), "Math::BigInt", "NaN - 4 => Math::BigInt"); +subtest '$x = $nan -> copy() -> bsub($four);' => sub { + plan tests => 2; + is($x, 'NaN', 'NaN - 4 = NaN'); + is(ref($x), 'Math::BigInt', 'NaN - 4 => Math::BigInt'); +}; -# bmul() +note("testing bmul()"); $x = $zero -> copy() -> bmul($four); -cmp_ok($x, "==", 0, "bmul(0, 4) = 0"); -is(ref($x), "Math::BigInt", "bmul(0, 4) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bmul($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bmul(0, 4) = 0'); + is(ref($x), 'Math::BigInt', 'bmul(0, 4) => Math::BigInt'); +}; $x = $four -> copy() -> bmul($four); -cmp_ok($x, "==", 16, "bmul(4, 4) = 16"); -is(ref($x), "Math::BigInt", "bmul(4, 4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bmul($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 16, 'bmul(4, 4) = 16'); + is(ref($x), 'Math::BigInt', 'bmul(4, 4) => Math::BigInt'); +}; $x = $inf -> copy() -> bmul($four); -cmp_ok($x, "==", "inf", "bmul(Inf, 4) = Inf"); -is(ref($x), "Math::BigInt", "bmul(Inf, 4) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bmul($four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bmul(Inf, 4) = Inf'); + is(ref($x), 'Math::BigInt', 'bmul(Inf, 4) => Math::BigInt'); +}; $x = $nan -> copy() -> bmul($four); -is($x, "NaN", "bmul(NaN, 4) = NaN"); -is(ref($x), "Math::BigInt", "bmul(NaN, 4) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bmul($four);' => sub { + plan tests => 2; + is($x, 'NaN', 'bmul(NaN, 4) = NaN'); + is(ref($x), 'Math::BigInt', 'bmul(NaN, 4) => Math::BigInt'); +}; -$x = $four -> copy() -> bmul("0.5"); -cmp_ok($x, "==", 2, "bmul(4, 0.5) = 2"); -is(ref($x), "Math::BigInt", "bmul(4, 0.5) => Math::BigInt"); +$x = $four -> copy() -> bmul('0.5'); +subtest '' => sub { + plan tests => 2; + cmp_ok($x, '==', 2, 'bmul(4, 0.5) = 2'); + is(ref($x), 'Math::BigInt', 'bmul(4, 0.5) => Math::BigInt'); +}; -# bmuladd() +note("testing bmuladd()"); $x = $zero -> copy() -> bmuladd($four, $four); -cmp_ok($x, "==", 4, "bmuladd(0, 4, 4) = 4"); -is(ref($x), "Math::BigInt", "bmuladd(0, 4, 4) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bmuladd($four, $four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, 'bmuladd(0, 4, 4) = 4'); + is(ref($x), 'Math::BigInt', 'bmuladd(0, 4, 4) => Math::BigInt'); +}; $x = $four -> copy() -> bmuladd($four, $four); -cmp_ok($x, "==", 20, "bmuladd(4, 4, 4) = 20"); -is(ref($x), "Math::BigInt", "bmuladd(4, 4, 4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bmuladd($four, $four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 20, 'bmuladd(4, 4, 4) = 20'); + is(ref($x), 'Math::BigInt', 'bmuladd(4, 4, 4) => Math::BigInt'); +}; $x = $four -> copy() -> bmuladd($four, $inf); -cmp_ok($x, "==", "inf", "bmuladd(4, 4, Inf) = Inf"); -is(ref($x), "Math::BigInt", "bmuladd(4, 4, Inf) => Math::BigInt"); +subtest '$x = $four -> copy() -> bmuladd($four, $inf);' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bmuladd(4, 4, Inf) = Inf'); + is(ref($x), 'Math::BigInt', 'bmuladd(4, 4, Inf) => Math::BigInt'); +}; $x = $inf -> copy() -> bmuladd($four, $four); -cmp_ok($x, "==", "inf", "bmuladd(Inf, 4, 4) = Inf"); -is(ref($x), "Math::BigInt", "bmuladd(Inf, 4, 4) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bmuladd($four, $four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bmuladd(Inf, 4, 4) = Inf'); + is(ref($x), 'Math::BigInt', 'bmuladd(Inf, 4, 4) => Math::BigInt'); +}; $x = $inf -> copy() -> bmuladd($four, $four); -cmp_ok($x, "==", "inf", "bmuladd(Inf, 4, 4) = Inf"); -is(ref($x), "Math::BigInt", "bmuladd(Inf, 4, 4) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bmuladd($four, $four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bmuladd(Inf, 4, 4) = Inf'); + is(ref($x), 'Math::BigInt', 'bmuladd(Inf, 4, 4) => Math::BigInt'); +}; $x = $nan -> copy() -> bmuladd($four, $four); -is($x, "NaN", "bmuladd(NaN, 4, 4) = NaN"); -is(ref($x), "Math::BigInt", "bmuladd(NaN, 4, 4) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bmuladd($four, $four);' => sub { + plan tests => 2; + is($x, 'NaN', 'bmuladd(NaN, 4, 4) = NaN'); + is(ref($x), 'Math::BigInt', 'bmuladd(NaN, 4, 4) => Math::BigInt'); +}; $x = $four -> copy() -> bmuladd("0.5", $four); -cmp_ok($x, "==", 6, "bmuladd(4, 0.5, 4) = 6"); -is(ref($x), "Math::BigInt", "bmuladd(4, 0.5, 4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bmuladd("0.5", $four);' => sub { + plan tests => 2; + cmp_ok($x, '==', 6, 'bmuladd(4, 0.5, 4) = 6'); + is(ref($x), 'Math::BigInt', 'bmuladd(4, 0.5, 4) => Math::BigInt'); +}; -# bdiv() +note("testing bdiv()"); -# bmod() +$x = $zero -> copy() -> bdiv($one); +subtest '$x = $zero -> copy() -> bdiv($one);' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bdiv(0, 1) = 0'); + is(ref($x), 'Math::BigInt', 'bdiv(0, 1) => Math::BigInt'); +}; -# bmodpow() +note("testing bmod()"); -# bpow() +note("testing bmodpow()"); -# blog() +note("testing bpow()"); -# bexp() +note("testing blog()"); -# bnok() +note("testing bexp()"); -# bsin() +note("testing bnok()"); -# bcos() +note("testing bsin()"); -# batan() +note("testing bcos()"); -# batan() +note("testing batan()"); -# bsqrt() +note("testing batan()"); -# broot() +note("testing bsqrt()"); -# bfac() +note("testing broot()"); -# bdfac() +note("testing bfac()"); -# btfac() +note("testing bdfac()"); -# bmfac() +note("testing btfac()"); -# blsft() +note("testing bmfac()"); -# brsft() +note("testing blsft()"); -# band() +note("testing brsft()"); -# bior() +note("testing band()"); -# bxor() +note("testing bior()"); -# bnot() +note("testing bxor()"); -# bround() +note("testing bnot()"); -# Add tests for rounding a non-integer to an integer. Fixme! +note("testing bround()"); + +note("testing Add tests for rounding a non-integer to an integer. Fixme!"); $x = $zero -> copy() -> bround(); -cmp_ok($x, "==", 0, "bround(0)"); -is(ref($x), "Math::BigInt", "bround(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bround(0)'); + is(ref($x), 'Math::BigInt', 'bround(0) => Math::BigInt'); +}; $x = $four -> copy() -> bround(); -cmp_ok($x, "==", 4, "bround(4)"); -is(ref($x), "Math::BigInt", "bround(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, 'bround(4)'); + is(ref($x), 'Math::BigInt', 'bround(4) => Math::BigInt'); +}; $x = $inf -> copy() -> bround(); -cmp_ok($x, "==", "inf", "bround(Inf)"); -is(ref($x), "Math::BigInt", "bround(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bround(Inf)'); + is(ref($x), 'Math::BigInt', 'bround(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bround(); -is($x, "NaN", "bround(NaN)"); -is(ref($x), "Math::BigInt", "bround(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bround();' => sub { + plan tests => 2; + is($x, 'NaN', 'bround(NaN)'); + is(ref($x), 'Math::BigInt', 'bround(NaN) => Math::BigInt'); +}; -# bfround() +note("testing bfround()"); -# Add tests for rounding a non-integer to an integer. Fixme! +note("testing Add tests for rounding a non-integer to an integer. Fixme!"); $x = $zero -> copy() -> bfround(); -cmp_ok($x, "==", 0, "bfround(0)"); -is(ref($x), "Math::BigInt", "bfround(0) => Math::BigInt"); +subtest '$x = $zero -> copy() -> bfround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bfround(0)'); + is(ref($x), 'Math::BigInt', 'bfround(0) => Math::BigInt'); +}; $x = $four -> copy() -> bfround(); -cmp_ok($x, "==", 4, "bfround(4)"); -is(ref($x), "Math::BigInt", "bfround(4) => Math::BigInt"); +subtest '$x = $four -> copy() -> bfround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 4, 'bfround(4)'); + is(ref($x), 'Math::BigInt', 'bfround(4) => Math::BigInt'); +}; $x = $inf -> copy() -> bfround(); -cmp_ok($x, "==", "inf", "bfround(Inf)"); -is(ref($x), "Math::BigInt", "bfround(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bfround();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'inf', 'bfround(Inf)'); + is(ref($x), 'Math::BigInt', 'bfround(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bfround(); -is($x, "NaN", "bfround(NaN)"); -is(ref($x), "Math::BigInt", "bfround(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bfround();' => sub { + plan tests => 2; + is($x, 'NaN', 'bfround(NaN)'); + is(ref($x), 'Math::BigInt', 'bfround(NaN) => Math::BigInt'); +}; -# bfloor() +note("testing bfloor()"); $x = $half -> copy() -> bfloor(); -cmp_ok($x, "==", 0, "bfloor(0)"); -is(ref($x), "Math::BigInt", "bfloor(0) => Math::BigInt"); +subtest '$x = $half -> copy() -> bfloor();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bfloor(0)'); + is(ref($x), 'Math::BigInt', 'bfloor(0) => Math::BigInt'); +}; $x = $inf -> copy() -> bfloor(); -cmp_ok($x, "==", "Inf", "bfloor(Inf)"); -is(ref($x), "Math::BigInt", "bfloor(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bfloor();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'Inf', 'bfloor(Inf)'); + is(ref($x), 'Math::BigInt', 'bfloor(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bfloor(); -is($x, "NaN", "bfloor(NaN)"); -is(ref($x), "Math::BigInt", "bfloor(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bfloor();' => sub { + plan tests => 2; + is($x, 'NaN', 'bfloor(NaN)'); + is(ref($x), 'Math::BigInt', 'bfloor(NaN) => Math::BigInt'); +}; -# bceil() +note("testing bceil()"); $x = $half -> copy() -> bceil(); -cmp_ok($x, "==", 1, "bceil(0)"); -is(ref($x), "Math::BigInt", "bceil(0) => Math::BigInt"); +subtest '$x = $half -> copy() -> bceil();' => sub { + plan tests => 2; + cmp_ok($x, '==', 1, 'bceil(0)'); + is(ref($x), 'Math::BigInt', 'bceil(0) => Math::BigInt'); +}; $x = $inf -> copy() -> bceil(); -cmp_ok($x, "==", "Inf", "bceil(Inf)"); -is(ref($x), "Math::BigInt", "bceil(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bceil();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'Inf', 'bceil(Inf)'); + is(ref($x), 'Math::BigInt', 'bceil(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bceil(); -is($x, "NaN", "bceil(NaN)"); -is(ref($x), "Math::BigInt", "bceil(NaN) => Math::BigInt"); +subtest '$x = $nan -> copy() -> bceil();' => sub { + plan tests => 2; + is($x, 'NaN', 'bceil(NaN)'); + is(ref($x), 'Math::BigInt', 'bceil(NaN) => Math::BigInt'); +}; -# bint() +note("testing bint()"); $x = $half -> copy() -> bint(); -cmp_ok($x, "==", 0, "bint(0)"); -is(ref($x), "Math::BigInt", "bint(0) => Math::BigInt"); +subtest '$x = $half -> copy() -> bint();' => sub { + plan tests => 2; + cmp_ok($x, '==', 0, 'bint(0)'); + is(ref($x), 'Math::BigInt', 'bint(0) => Math::BigInt'); +}; $x = $inf -> copy() -> bint(); -cmp_ok($x, "==", "Inf", "bint(Inf)"); -is(ref($x), "Math::BigInt", "bint(Inf) => Math::BigInt"); +subtest '$x = $inf -> copy() -> bint();' => sub { + plan tests => 2; + cmp_ok($x, '==', 'Inf', 'bint(Inf)'); + is(ref($x), 'Math::BigInt', 'bint(Inf) => Math::BigInt'); +}; $x = $nan -> copy() -> bint(); -is($x, "NaN", "bint(NaN)"); -is(ref($x), "Math::BigInt", "bint(NaN) => Math::BigInt"); - -# bgcd() +subtest '$x = $nan -> copy() -> bint();' => sub { + plan tests => 2; + is($x, 'NaN', 'bint(NaN)'); + is(ref($x), 'Math::BigInt', 'bint(NaN) => Math::BigInt'); +}; -# blcm() +note("testing bgcd()"); -# mantissa() ? +note("testing blcm()"); -# exponent() ? +note("testing mantissa()"); -# parts() ? +note("testing exponent()"); -# sparts() +note("testing parts()"); -# nparts() +note("testing sparts()"); -# eparts() +note("testing nparts()"); -# dparts() +note("testing eparts()"); -# fparts() +note("testing dparts()"); -# numerator() +note("testing fparts()"); -# denominator() +note("testing numerator()"); -#require 'upgrade.inc'; # all tests here for sharing +note("testing denominator()"); diff --git a/cpan/Math-BigInt/t/dparts-mbf.t b/cpan/Math-BigInt/t/dparts-mbf.t deleted file mode 100644 index 43bdd22b76..0000000000 --- a/cpan/Math-BigInt/t/dparts-mbf.t +++ /dev/null @@ -1,294 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1840; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $int_str, $frc_str) = split /:/; - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| (\$i, \$f) = \$x -> dparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my ($int_got, $frc_got) = $x -> dparts(); - - isa_ok($int_got, "Math::BigFloat"); - isa_ok($frc_got, "Math::BigFloat"); - - 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"); - } - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| \$i = \$x -> dparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my $int_got = $x -> dparts(); - - isa_ok($int_got, "Math::BigFloat"); - - is($int_got, $int_str, "value of integer part"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:0 - -inf:inf:0 --inf:-inf:0 - -0:0:0 - -# positive numbers - -0.000000000001:0:0.000000000001 -0.00000000001:0:0.00000000001 -0.0000000001:0:0.0000000001 -0.000000001:0:0.000000001 -0.00000001:0:0.00000001 -0.0000001:0:0.0000001 -0.000001:0:0.000001 -0.00001:0:0.00001 -0.0001:0:0.0001 -0.001:0:0.001 -0.01:0:0.01 -0.1:0:0.1 -1:1:0 -10:10:0 -100:100:0 -1000:1000:0 -10000:10000:0 -100000:100000:0 -1000000:1000000:0 -10000000:10000000:0 -100000000:100000000:0 -1000000000:1000000000:0 -10000000000:10000000000:0 -100000000000:100000000000:0 -1000000000000:1000000000000:0 - -0.0000000000012:0:0.0000000000012 -0.000000000012:0:0.000000000012 -0.00000000012:0:0.00000000012 -0.0000000012:0:0.0000000012 -0.000000012:0:0.000000012 -0.00000012:0:0.00000012 -0.0000012:0:0.0000012 -0.000012:0:0.000012 -0.00012:0:0.00012 -0.0012:0:0.0012 -0.012:0:0.012 -0.12:0:0.12 -1.2:1:0.2 -12:12:0 -120:120:0 -1200:1200:0 -12000:12000:0 -120000:120000:0 -1200000:1200000:0 -12000000:12000000:0 -120000000:120000000:0 -1200000000:1200000000:0 -12000000000:12000000000:0 -120000000000:120000000000:0 -1200000000000:1200000000000:0 - -0.00000000000123:0:0.00000000000123 -0.0000000000123:0:0.0000000000123 -0.000000000123:0:0.000000000123 -0.00000000123:0:0.00000000123 -0.0000000123:0:0.0000000123 -0.000000123:0:0.000000123 -0.00000123:0:0.00000123 -0.0000123:0:0.0000123 -0.000123:0:0.000123 -0.00123:0:0.00123 -0.0123:0:0.0123 -0.123:0:0.123 -1.23:1:0.23 -12.3:12:0.3 -123:123:0 -1230:1230:0 -12300:12300:0 -123000:123000:0 -1230000:1230000:0 -12300000:12300000:0 -123000000:123000000:0 -1230000000:1230000000:0 -12300000000:12300000000:0 -123000000000:123000000000:0 -1230000000000:1230000000000:0 - -0.000000000001234:0:0.000000000001234 -0.00000000001234:0:0.00000000001234 -0.0000000001234:0:0.0000000001234 -0.000000001234:0:0.000000001234 -0.00000001234:0:0.00000001234 -0.0000001234:0:0.0000001234 -0.000001234:0:0.000001234 -0.00001234:0:0.00001234 -0.0001234:0:0.0001234 -0.001234:0:0.001234 -0.01234:0:0.01234 -0.1234:0:0.1234 -1.234:1:0.234 -12.34:12:0.34 -123.4:123:0.4 -1234:1234:0 -12340:12340:0 -123400:123400:0 -1234000:1234000:0 -12340000:12340000:0 -123400000:123400000:0 -1234000000:1234000000:0 -12340000000:12340000000:0 -123400000000:123400000000:0 -1234000000000:1234000000000:0 - -0.000003141592:0:0.000003141592 -0.00003141592:0:0.00003141592 -0.0003141592:0:0.0003141592 -0.003141592:0:0.003141592 -0.03141592:0:0.03141592 -0.3141592:0:0.3141592 -3.141592:3:0.141592 -31.41592:31:0.41592 -314.1592:314:0.1592 -3141.592:3141:0.592 -31415.92:31415:0.92 -314159.2:314159:0.2 -3141592:3141592:0 - -# negative numbers - --0.000000000001:0:-0.000000000001 --0.00000000001:0:-0.00000000001 --0.0000000001:0:-0.0000000001 --0.000000001:0:-0.000000001 --0.00000001:0:-0.00000001 --0.0000001:0:-0.0000001 --0.000001:0:-0.000001 --0.00001:0:-0.00001 --0.0001:0:-0.0001 --0.001:0:-0.001 --0.01:0:-0.01 --0.1:0:-0.1 --1:-1:0 --10:-10:0 --100:-100:0 --1000:-1000:0 --10000:-10000:0 --100000:-100000:0 --1000000:-1000000:0 --10000000:-10000000:0 --100000000:-100000000:0 --1000000000:-1000000000:0 --10000000000:-10000000000:0 --100000000000:-100000000000:0 --1000000000000:-1000000000000:0 - --0.0000000000012:0:-0.0000000000012 --0.000000000012:0:-0.000000000012 --0.00000000012:0:-0.00000000012 --0.0000000012:0:-0.0000000012 --0.000000012:0:-0.000000012 --0.00000012:0:-0.00000012 --0.0000012:0:-0.0000012 --0.000012:0:-0.000012 --0.00012:0:-0.00012 --0.0012:0:-0.0012 --0.012:0:-0.012 --0.12:0:-0.12 --1.2:-1:-0.2 --12:-12:0 --120:-120:0 --1200:-1200:0 --12000:-12000:0 --120000:-120000:0 --1200000:-1200000:0 --12000000:-12000000:0 --120000000:-120000000:0 --1200000000:-1200000000:0 --12000000000:-12000000000:0 --120000000000:-120000000000:0 --1200000000000:-1200000000000:0 - --0.00000000000123:0:-0.00000000000123 --0.0000000000123:0:-0.0000000000123 --0.000000000123:0:-0.000000000123 --0.00000000123:0:-0.00000000123 --0.0000000123:0:-0.0000000123 --0.000000123:0:-0.000000123 --0.00000123:0:-0.00000123 --0.0000123:0:-0.0000123 --0.000123:0:-0.000123 --0.00123:0:-0.00123 --0.0123:0:-0.0123 --0.123:0:-0.123 --1.23:-1:-0.23 --12.3:-12:-0.3 --123:-123:0 --1230:-1230:0 --12300:-12300:0 --123000:-123000:0 --1230000:-1230000:0 --12300000:-12300000:0 --123000000:-123000000:0 --1230000000:-1230000000:0 --12300000000:-12300000000:0 --123000000000:-123000000000:0 --1230000000000:-1230000000000:0 - --0.000000000001234:0:-0.000000000001234 --0.00000000001234:0:-0.00000000001234 --0.0000000001234:0:-0.0000000001234 --0.000000001234:0:-0.000000001234 --0.00000001234:0:-0.00000001234 --0.0000001234:0:-0.0000001234 --0.000001234:0:-0.000001234 --0.00001234:0:-0.00001234 --0.0001234:0:-0.0001234 --0.001234:0:-0.001234 --0.01234:0:-0.01234 --0.1234:0:-0.1234 --1.234:-1:-0.234 --12.34:-12:-0.34 --123.4:-123:-0.4 --1234:-1234:0 --12340:-12340:0 --123400:-123400:0 --1234000:-1234000:0 --12340000:-12340000:0 --123400000:-123400000:0 --1234000000:-1234000000:0 --12340000000:-12340000000:0 --123400000000:-123400000000:0 --1234000000000:-1234000000000:0 - --0.000003141592:0:-0.000003141592 --0.00003141592:0:-0.00003141592 --0.0003141592:0:-0.0003141592 --0.003141592:0:-0.003141592 --0.03141592:0:-0.03141592 --0.3141592:0:-0.3141592 --3.141592:-3:-0.141592 --31.41592:-31:-0.41592 --314.1592:-314:-0.1592 --3141.592:-3141:-0.592 --31415.92:-31415:-0.92 --314159.2:-314159:-0.2 --3141592:-3141592:0 diff --git a/cpan/Math-BigInt/t/dparts-mbi.t b/cpan/Math-BigInt/t/dparts-mbi.t deleted file mode 100644 index 0b4ba38267..0000000000 --- a/cpan/Math-BigInt/t/dparts-mbi.t +++ /dev/null @@ -1,162 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 784; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $int_str, $frc_str) = split /:/; - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| (\$i, \$f) = \$x -> dparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my ($int_got, $frc_got) = $x -> dparts(); - - isa_ok($int_got, "Math::BigInt"); - isa_ok($frc_got, "Math::BigInt"); - - 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"); - } - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| \$i = \$x -> dparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my $int_got = $x -> dparts(); - - isa_ok($int_got, "Math::BigInt"); - - is($int_got, $int_str, "value of integer part"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:0 - -inf:inf:0 --inf:-inf:0 - -0:0:0 - -# positive numbers - -1:1:0 -10:10:0 -100:100:0 -1000:1000:0 -10000:10000:0 -100000:100000:0 -1000000:1000000:0 -10000000:10000000:0 -100000000:100000000:0 -1000000000:1000000000:0 -10000000000:10000000000:0 -100000000000:100000000000:0 -1000000000000:1000000000000:0 - -12:12:0 -120:120:0 -1200:1200:0 -12000:12000:0 -120000:120000:0 -1200000:1200000:0 -12000000:12000000:0 -120000000:120000000:0 -1200000000:1200000000:0 -12000000000:12000000000:0 -120000000000:120000000000:0 -1200000000000:1200000000000:0 - -123:123:0 -1230:1230:0 -12300:12300:0 -123000:123000:0 -1230000:1230000:0 -12300000:12300000:0 -123000000:123000000:0 -1230000000:1230000000:0 -12300000000:12300000000:0 -123000000000:123000000000:0 -1230000000000:1230000000000:0 - -1234:1234:0 -12340:12340:0 -123400:123400:0 -1234000:1234000:0 -12340000:12340000:0 -123400000:123400000:0 -1234000000:1234000000:0 -12340000000:12340000000:0 -123400000000:123400000000:0 -1234000000000:1234000000000:0 - -3141592:3141592:0 - -# negative numbers - --1:-1:0 --10:-10:0 --100:-100:0 --1000:-1000:0 --10000:-10000:0 --100000:-100000:0 --1000000:-1000000:0 --10000000:-10000000:0 --100000000:-100000000:0 --1000000000:-1000000000:0 --10000000000:-10000000000:0 --100000000000:-100000000000:0 --1000000000000:-1000000000000:0 - --12:-12:0 --120:-120:0 --1200:-1200:0 --12000:-12000:0 --120000:-120000:0 --1200000:-1200000:0 --12000000:-12000000:0 --120000000:-120000000:0 --1200000000:-1200000000:0 --12000000000:-12000000000:0 --120000000000:-120000000000:0 --1200000000000:-1200000000000:0 - --123:-123:0 --1230:-1230:0 --12300:-12300:0 --123000:-123000:0 --1230000:-1230000:0 --12300000:-12300000:0 --123000000:-123000000:0 --1230000000:-1230000000:0 --12300000000:-12300000000:0 --123000000000:-123000000000:0 --1230000000000:-1230000000000:0 - --1234:-1234:0 --12340:-12340:0 --123400:-123400:0 --1234000:-1234000:0 --12340000:-12340000:0 --123400000:-123400000:0 --1234000000:-1234000000:0 --12340000000:-12340000000:0 --123400000000:-123400000000:0 --1234000000000:-1234000000000:0 - --3141592:-3141592:0 diff --git a/cpan/Math-BigInt/t/eparts-mbf.t b/cpan/Math-BigInt/t/eparts-mbf.t deleted file mode 100644 index a612461fa9..0000000000 --- a/cpan/Math-BigInt/t/eparts-mbf.t +++ /dev/null @@ -1,294 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1840; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> eparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my ($mant_got, $expo_got) = $x -> eparts(); - - isa_ok($mant_got, "Math::BigFloat"); - isa_ok($expo_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| \$m = \$x -> eparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my $mant_got = $x -> eparts(); - - isa_ok($mant_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -0.000000000001:1:-12 -0.00000000001:10:-12 -0.0000000001:100:-12 -0.000000001:1:-9 -0.00000001:10:-9 -0.0000001:100:-9 -0.000001:1:-6 -0.00001:10:-6 -0.0001:100:-6 -0.001:1:-3 -0.01:10:-3 -0.1:100:-3 -1:1:0 -10:10:0 -100:100:0 -1000:1:3 -10000:10:3 -100000:100:3 -1000000:1:6 -10000000:10:6 -100000000:100:6 -1000000000:1:9 -10000000000:10:9 -100000000000:100:9 -1000000000000:1:12 - -0.0000000000012:1.2:-12 -0.000000000012:12:-12 -0.00000000012:120:-12 -0.0000000012:1.2:-9 -0.000000012:12:-9 -0.00000012:120:-9 -0.0000012:1.2:-6 -0.000012:12:-6 -0.00012:120:-6 -0.0012:1.2:-3 -0.012:12:-3 -0.12:120:-3 -1.2:1.2:0 -12:12:0 -120:120:0 -1200:1.2:3 -12000:12:3 -120000:120:3 -1200000:1.2:6 -12000000:12:6 -120000000:120:6 -1200000000:1.2:9 -12000000000:12:9 -120000000000:120:9 -1200000000000:1.2:12 - -0.00000000000123:1.23:-12 -0.0000000000123:12.3:-12 -0.000000000123:123:-12 -0.00000000123:1.23:-9 -0.0000000123:12.3:-9 -0.000000123:123:-9 -0.00000123:1.23:-6 -0.0000123:12.3:-6 -0.000123:123:-6 -0.00123:1.23:-3 -0.0123:12.3:-3 -0.123:123:-3 -1.23:1.23:0 -12.3:12.3:0 -123:123:0 -1230:1.23:3 -12300:12.3:3 -123000:123:3 -1230000:1.23:6 -12300000:12.3:6 -123000000:123:6 -1230000000:1.23:9 -12300000000:12.3:9 -123000000000:123:9 -1230000000000:1.23:12 - -0.000000000001234:1.234:-12 -0.00000000001234:12.34:-12 -0.0000000001234:123.4:-12 -0.000000001234:1.234:-9 -0.00000001234:12.34:-9 -0.0000001234:123.4:-9 -0.000001234:1.234:-6 -0.00001234:12.34:-6 -0.0001234:123.4:-6 -0.001234:1.234:-3 -0.01234:12.34:-3 -0.1234:123.4:-3 -1.234:1.234:0 -12.34:12.34:0 -123.4:123.4:0 -1234:1.234:3 -12340:12.34:3 -123400:123.4:3 -1234000:1.234:6 -12340000:12.34:6 -123400000:123.4:6 -1234000000:1.234:9 -12340000000:12.34:9 -123400000000:123.4:9 -1234000000000:1.234:12 - -0.000003141592:3.141592:-6 -0.00003141592:31.41592:-6 -0.0003141592:314.1592:-6 -0.003141592:3.141592:-3 -0.03141592:31.41592:-3 -0.3141592:314.1592:-3 -3.141592:3.141592:0 -31.41592:31.41592:0 -314.1592:314.1592:0 -3141.592:3.141592:3 -31415.92:31.41592:3 -314159.2:314.1592:3 -3141592:3.141592:6 - -# negativ: numbers - --0.000000000001:-1:-12 --0.00000000001:-10:-12 --0.0000000001:-100:-12 --0.000000001:-1:-9 --0.00000001:-10:-9 --0.0000001:-100:-9 --0.000001:-1:-6 --0.00001:-10:-6 --0.0001:-100:-6 --0.001:-1:-3 --0.01:-10:-3 --0.1:-100:-3 --1:-1:0 --10:-10:0 --100:-100:0 --1000:-1:3 --10000:-10:3 --100000:-100:3 --1000000:-1:6 --10000000:-10:6 --100000000:-100:6 --1000000000:-1:9 --10000000000:-10:9 --100000000000:-100:9 --1000000000000:-1:12 - --0.0000000000012:-1.2:-12 --0.000000000012:-12:-12 --0.00000000012:-120:-12 --0.0000000012:-1.2:-9 --0.000000012:-12:-9 --0.00000012:-120:-9 --0.0000012:-1.2:-6 --0.000012:-12:-6 --0.00012:-120:-6 --0.0012:-1.2:-3 --0.012:-12:-3 --0.12:-120:-3 --1.2:-1.2:0 --12:-12:0 --120:-120:0 --1200:-1.2:3 --12000:-12:3 --120000:-120:3 --1200000:-1.2:6 --12000000:-12:6 --120000000:-120:6 --1200000000:-1.2:9 --12000000000:-12:9 --120000000000:-120:9 --1200000000000:-1.2:12 - --0.00000000000123:-1.23:-12 --0.0000000000123:-12.3:-12 --0.000000000123:-123:-12 --0.00000000123:-1.23:-9 --0.0000000123:-12.3:-9 --0.000000123:-123:-9 --0.00000123:-1.23:-6 --0.0000123:-12.3:-6 --0.000123:-123:-6 --0.00123:-1.23:-3 --0.0123:-12.3:-3 --0.123:-123:-3 --1.23:-1.23:0 --12.3:-12.3:0 --123:-123:0 --1230:-1.23:3 --12300:-12.3:3 --123000:-123:3 --1230000:-1.23:6 --12300000:-12.3:6 --123000000:-123:6 --1230000000:-1.23:9 --12300000000:-12.3:9 --123000000000:-123:9 --1230000000000:-1.23:12 - --0.000000000001234:-1.234:-12 --0.00000000001234:-12.34:-12 --0.0000000001234:-123.4:-12 --0.000000001234:-1.234:-9 --0.00000001234:-12.34:-9 --0.0000001234:-123.4:-9 --0.000001234:-1.234:-6 --0.00001234:-12.34:-6 --0.0001234:-123.4:-6 --0.001234:-1.234:-3 --0.01234:-12.34:-3 --0.1234:-123.4:-3 --1.234:-1.234:0 --12.34:-12.34:0 --123.4:-123.4:0 --1234:-1.234:3 --12340:-12.34:3 --123400:-123.4:3 --1234000:-1.234:6 --12340000:-12.34:6 --123400000:-123.4:6 --1234000000:-1.234:9 --12340000000:-12.34:9 --123400000000:-123.4:9 --1234000000000:-1.234:12 - --0.000003141592:-3.141592:-6 --0.00003141592:-31.41592:-6 --0.0003141592:-314.1592:-6 --0.003141592:-3.141592:-3 --0.03141592:-31.41592:-3 --0.3141592:-314.1592:-3 --3.141592:-3.141592:0 --31.41592:-31.41592:0 --314.1592:-314.1592:0 --3141.592:-3.141592:3 --31415.92:-31.41592:3 --314159.2:-314.1592:3 --3141592:-3.141592:6 diff --git a/cpan/Math-BigInt/t/eparts-mbi.t b/cpan/Math-BigInt/t/eparts-mbi.t deleted file mode 100644 index 783f716e5c..0000000000 --- a/cpan/Math-BigInt/t/eparts-mbi.t +++ /dev/null @@ -1,162 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 784; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> eparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my ($mant_got, $expo_got) = $x -> eparts(); - - isa_ok($mant_got, "Math::BigInt"); - isa_ok($expo_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| \$m = \$x -> eparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my $mant_got = $x -> eparts(); - - isa_ok($mant_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -1:1:0 -10:10:0 -100:100:0 -1000:1:3 -10000:10:3 -100000:100:3 -1000000:1:6 -10000000:10:6 -100000000:100:6 -1000000000:1:9 -10000000000:10:9 -100000000000:100:9 -1000000000000:1:12 - -12:12:0 -120:120:0 -1200:NaN:3 -12000:12:3 -120000:120:3 -1200000:NaN:6 -12000000:12:6 -120000000:120:6 -1200000000:NaN:9 -12000000000:12:9 -120000000000:120:9 -1200000000000:NaN:12 - -123:123:0 -1230:NaN:3 -12300:NaN:3 -123000:123:3 -1230000:NaN:6 -12300000:NaN:6 -123000000:123:6 -1230000000:NaN:9 -12300000000:NaN:9 -123000000000:123:9 -1230000000000:NaN:12 - -1234:NaN:3 -12340:NaN:3 -123400:NaN:3 -1234000:NaN:6 -12340000:NaN:6 -123400000:NaN:6 -1234000000:NaN:9 -12340000000:NaN:9 -123400000000:NaN:9 -1234000000000:NaN:12 - -3141592:NaN:6 - -# negativ: numbers - --1:-1:0 --10:-10:0 --100:-100:0 --1000:-1:3 --10000:-10:3 --100000:-100:3 --1000000:-1:6 --10000000:-10:6 --100000000:-100:6 --1000000000:-1:9 --10000000000:-10:9 --100000000000:-100:9 --1000000000000:-1:12 - --12:-12:0 --120:-120:0 --1200:NaN:3 --12000:-12:3 --120000:-120:3 --1200000:NaN:6 --12000000:-12:6 --120000000:-120:6 --1200000000:NaN:9 --12000000000:-12:9 --120000000000:-120:9 --1200000000000:NaN:12 - --123:-123:0 --1230:NaN:3 --12300:NaN:3 --123000:-123:3 --1230000:NaN:6 --12300000:NaN:6 --123000000:-123:6 --1230000000:NaN:9 --12300000000:NaN:9 --123000000000:-123:9 --1230000000000:NaN:12 - --1234:NaN:3 --12340:NaN:3 --123400:NaN:3 --1234000:NaN:6 --12340000:NaN:6 --123400000:NaN:6 --1234000000:NaN:9 --12340000000:NaN:9 --123400000000:NaN:9 --1234000000000:NaN:12 - --3141592:NaN:6 diff --git a/cpan/Math-BigInt/t/fparts-mbf.t b/cpan/Math-BigInt/t/fparts-mbf.t deleted file mode 100644 index 8d555bde9c..0000000000 --- a/cpan/Math-BigInt/t/fparts-mbf.t +++ /dev/null @@ -1,97 +0,0 @@ -# -*- mode: perl; -*- - -# test fparts(), numerator(), denominator() - -use strict; -use warnings; - -use Test::More tests => 43; - -my $class; - -BEGIN { - $class = 'Math::BigFloat'; - use_ok($class); -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $n_str, $d_str) = split /:/; - my $test; - - # test fparts() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| (\$n, \$d) = \$x -> fparts();|; - - subtest $test => sub { - plan tests => 5; - - my $x = $class -> new($x_str); - my ($n, $d) = $x -> fparts(); - - is(ref($n), $class, "class of numerator"); - is(ref($d), $class, "class of denominator"); - - is($n, $n_str, "value of numerator"); - is($d, $d_str, "value of denominator"); - is($x, $x_str, "input is unmodified"); - }; - - # test numerator() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| \$n = \$x -> numerator();|; - - subtest $test => sub { - plan tests => 3; - - my $x = $class -> new($x_str); - my $n = $x -> numerator(); - - is(ref($n), $class, "class of numerator"); - - is($n, $n_str, "value of numerator"); - is($x, $x_str, "input is unmodified"); - }; - - # test denominator() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| \$d = \$x -> denominator();|; - - subtest $test => sub { - plan tests => 3; - - my $x = $class -> new($x_str); - my $d = $x -> denominator(); - - is(ref($d), $class, "class of denominator"); - - is($d, $d_str, "value of denominator"); - is($x, $x_str, "input is unmodified"); - }; -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:1 --inf:-inf:1 - --30:-30:1 --3:-3:1 --1:-1:1 -0:0:1 -1:1:1 -3:3:1 -30:30:1 - --31400:-31400:1 --3.14:-157:50 -3.14:157:50 -31400:31400:1 diff --git a/cpan/Math-BigInt/t/fparts-mbi.t b/cpan/Math-BigInt/t/fparts-mbi.t deleted file mode 100644 index 449d6d8a59..0000000000 --- a/cpan/Math-BigInt/t/fparts-mbi.t +++ /dev/null @@ -1,92 +0,0 @@ -# -*- mode: perl; -*- - -# test fparts(), numerator(), denominator() - -use strict; -use warnings; - -use Test::More tests => 31; - -my $class; - -BEGIN { - $class = 'Math::BigInt'; - use_ok($class); -} - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $n_str, $d_str) = split /:/; - my $test; - - # test fparts() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| (\$n, \$d) = \$x -> fparts();|; - - subtest $test => sub { - plan tests => 5; - - my $x = $class -> new($x_str); - my ($n, $d) = $x -> fparts(); - - is(ref($n), $class, "class of numerator"); - is(ref($d), $class, "class of denominator"); - - is($n, $n_str, "value of numerator"); - is($d, $d_str, "value of denominator"); - is($x, $x_str, "input is unmodified"); - }; - - # test numerator() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| \$n = \$x -> numerator();|; - - subtest $test => sub { - plan tests => 3; - - my $x = $class -> new($x_str); - my $n = $x -> numerator(); - - is(ref($n), $class, "class of numerator"); - - is($n, $n_str, "value of numerator"); - is($x, $x_str, "input is unmodified"); - }; - - # test denominator() - - $test = qq|\$x = $class -> new("$x_str");| - . qq| \$d = \$x -> denominator();|; - - subtest $test => sub { - plan tests => 3; - - my $x = $class -> new($x_str); - my $d = $x -> denominator(); - - is(ref($d), $class, "class of denominator"); - - is($d, $d_str, "value of denominator"); - is($x, $x_str, "input is unmodified"); - }; -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:1 --inf:-inf:1 - --30:-30:1 --3:-3:1 --1:-1:1 -0:0:1 -1:1:1 -3:3:1 -30:30:1 diff --git a/cpan/Math-BigInt/t/from_base-mbi.t b/cpan/Math-BigInt/t/from_base-mbi.t deleted file mode 100644 index 1f664e1652..0000000000 --- a/cpan/Math-BigInt/t/from_base-mbi.t +++ /dev/null @@ -1,126 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 176; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -my @data; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my @in = split /:/; - my $out = pop @in; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_base("$in[0]", $in[1]|; - $test .= qq|, "$in[2]"| if @in == 3; - $test .= qq|);|; - - eval $test; - #die $@ if $@; # this should never happen - die "\nThe following test died when eval()'ed. This indicates a ", - "broken test\n\n $test\n\nThe error message was\n\n $@\n" - if $@; - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");|; - $test .= qq| \$x -> from_base("$in[0]", $in[1]|; - $test .= qq|, "$in[2]"| if @in == 3; - $test .= qq|);|; - - eval $test; - #die $@ if $@; # this should never happen - die "\nThe following test died when eval()'ed. This indicates a ", - "broken test\n\n $test\n\nThe error message was\n\n $@\n" - if $@; - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out, 'output arg has the right value'); - }; - } - } -} - -__END__ - -# Base 2 - -11111010:2:250 -11111010:2:01:250 - -# Base 8 - -372:8:250 -372:8:01234567:250 - -# Base 10 (in the last case, use a truncted collation sequence that does not -# include unused characters) - -250:10:250 -250:10:0123456789:250 -250:10:012345:250 - -# Base 16 - -fa:16:250 -FA:16:250 -fa:16:0123456789abcdef:250 - -# Base 3 - -100021:3:250 -100021:3:012:250 - -/|-:3:-/|:15 - -# Base 4 - -3322:4:250 -3322:4:0123:250 - -# Base 5 - -2000:5:250 -2000:5:01234:250 -caaa:5:abcde:250 - -# when base is less than or equal to 36, case is ignored - -6Y:36:250 -6y:36:250 - -6S:37:250 -7H:37:276 - -121:3:16 - -XYZ:36:44027 - -Why:62:125734 diff --git a/cpan/Math-BigInt/t/from_base_num-mbi.t b/cpan/Math-BigInt/t/from_base_num-mbi.t deleted file mode 100644 index aad7c6d18b..0000000000 --- a/cpan/Math-BigInt/t/from_base_num-mbi.t +++ /dev/null @@ -1,119 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 365; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -# For simplicity, we use the same data in the test programs for to_base_num() and -# from_base_num(). - -my @data = - ( - [ 0, 2, [ 0 ] ], - [ 1, 2, [ 1 ] ], - [ 2, 2, [ 1, 0 ] ], - [ 3, 2, [ 1, 1, ] ], - [ 4, 2, [ 1, 0, 0 ] ], - - [ 0, 10, [ 0 ] ], - [ 1, 10, [ 1 ] ], - [ 12, 10, [ 1, 2 ] ], - [ 123, 10, [ 1, 2, 3 ] ], - [ 1230, 10, [ 1, 2, 3, 0 ] ], - - [ "123456789", 100, [ 1, 23, 45, 67, 89 ] ], - - [ "1234567890" x 3, - "987654321", - [ "128", "142745769", "763888804", "574845669" ]], - - [ "1234567890" x 5, - "987654321" x 3, - [ "12499999874843750102814", "447551941015330718793208596" ]], - ); - -for (my $i = 0 ; $i <= $#data ; ++ $i) { - my @in = ($data[$i][2], $data[$i][1]); - my $out = $data[$i][0]; - - # As class method. - - { - for my $base_as_scalar (1, 0) { - for my $elements_as_scalar (1, 0) { - - my $x; - my $test = "\$x = $class -> from_base_num(["; - if ($elements_as_scalar) { - $test .= join ", ", map qq|"$_"|, @{ $in[0] }; - } else { - $test .= join ", ", map qq|$class -> new("$_")|, @{ $in[0] }; - } - $test .= "], "; - if ($base_as_scalar) { - $test .= qq|"$in[1]"|; - } else { - $test .= qq|$class -> new("$in[1]")|; - } - $test .= ")"; - - eval $test; - die "\nThe following test died when eval()'ed. This", - "indicates a broken test\n\n $test\n\nThe error", - " message was\n\n $@\n" if $@; - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out, 'output arg has the right value'); - }; - } - } - } - - # As instance method. - - { - for my $base_as_scalar (1, 0) { - for my $elements_as_scalar (1, 0) { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - - my $x; - my $test = qq|\$x = $class -> new("$str");|; - $test .= " \$x -> from_base_num(["; - if ($elements_as_scalar) { - $test .= join ", ", map qq|"$_"|, @{ $in[0] }; - } else { - $test .= join ", ", map qq|$class -> new("$_")|, @{ $in[0] }; - } - $test .= "], "; - if ($base_as_scalar) { - $test .= qq|"$in[1]"|; - } else { - $test .= qq|$class -> new("$in[1]")|; - } - $test .= ")"; - - eval $test; - die "\nThe following test died when eval()'ed. This", - "indicates a broken test\n\n $test\n\nThe error", - " message was\n\n $@\n" if $@; - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out, 'output arg has the right value'); - }; - } - } - } - } -} diff --git a/cpan/Math-BigInt/t/from_bin-mbf.t b/cpan/Math-BigInt/t/from_bin-mbf.t deleted file mode 100644 index a24f1bfd4d..0000000000 --- a/cpan/Math-BigInt/t/from_bin-mbf.t +++ /dev/null @@ -1,105 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 785; - -my $class; - -BEGIN { $class = 'Math::BigFloat'; } -BEGIN { use_ok($class, '1.999710'); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_bin("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_bin("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -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:12.5 -0b10010.001101p-1:9.1015625 --0b.11110001001101010111100110111101111p+31:-2023406814.9375 -0b10.0100011010001010110011110001001101p+34:39093746765 - -0b.p+0:NaN - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/from_bin-mbi.t b/cpan/Math-BigInt/t/from_bin-mbi.t deleted file mode 100644 index da8300726b..0000000000 --- a/cpan/Math-BigInt/t/from_bin-mbi.t +++ /dev/null @@ -1,132 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1457; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_bin("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_bin("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -0b0:0 -0b1:1 -0b10:2 -0b11:3 -0b100:4 -0b101:5 -0b110:6 -0b111:7 -0b1000:8 -0b1001:9 -0b1010:10 -0b1011:11 -0b1100:12 -0b1101:13 -0b1110:14 -0b1111:15 -0b10000:16 -0b10001:17 - -0b11111110:254 -0b11111111:255 -0b100000000:256 -0b100000001:257 - -0b1111111111111110:65534 -0b1111111111111111:65535 -0b10000000000000000:65536 -0b10000000000000001:65537 - -0b111111111111111111111110:16777214 -0b111111111111111111111111:16777215 -0b1000000000000000000000000:16777216 -0b1000000000000000000000001:16777217 - -0b11111111111111111111111111111110:4294967294 -0b11111111111111111111111111111111:4294967295 -0b100000000000000000000000000000000:4294967296 -0b100000000000000000000000000000001:4294967297 - -0b1111111111111111111111111111111111111110:1099511627774 -0b1111111111111111111111111111111111111111:1099511627775 -0b10000000000000000000000000000000000000000:1099511627776 -0b10000000000000000000000000000000000000001:1099511627777 - -0b111111111111111111111111111111111111111111111110:281474976710654 -0b111111111111111111111111111111111111111111111111:281474976710655 -0b1000000000000000000000000000000000000000000000000:281474976710656 -0b1000000000000000000000000000000000000000000000001:281474976710657 - -0b11111111111111111111111111111111111111111111111111111110:72057594037927934 -0b11111111111111111111111111111111111111111111111111111111:72057594037927935 -0b100000000000000000000000000000000000000000000000000000000:72057594037927936 -0b100000000000000000000000000000000000000000000000000000001:72057594037927937 - -0B10:2 -b10:2 -B10:2 - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/from_hex-mbf.t b/cpan/Math-BigInt/t/from_hex-mbf.t deleted file mode 100644 index 8a9f3cf012..0000000000 --- a/cpan/Math-BigInt/t/from_hex-mbf.t +++ /dev/null @@ -1,105 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 785; - -my $class; - -BEGIN { $class = 'Math::BigFloat'; } -BEGIN { use_ok($class, '1.999821'); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_hex("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_hex("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -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:12.5 -0x12.34p-1:9.1015625 --0x.789abcdefp+32:-2023406814.9375 -0x12.3456789ap+31:39093746765 - -0x.p+0:NaN - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/from_hex-mbi.t b/cpan/Math-BigInt/t/from_hex-mbi.t deleted file mode 100644 index 200253134f..0000000000 --- a/cpan/Math-BigInt/t/from_hex-mbi.t +++ /dev/null @@ -1,132 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1457; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_hex("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_hex("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -0x0:0 -0x1:1 -0x2:2 -0x3:3 -0x4:4 -0x5:5 -0x6:6 -0x7:7 -0x8:8 -0x9:9 -0xa:10 -0xb:11 -0xc:12 -0xd:13 -0xe:14 -0xf:15 -0x10:16 -0x11:17 - -0xfe:254 -0xff:255 -0x100:256 -0x101:257 - -0xfffe:65534 -0xffff:65535 -0x10000:65536 -0x10001:65537 - -0xfffffe:16777214 -0xffffff:16777215 -0x1000000:16777216 -0x1000001:16777217 - -0xfffffffe:4294967294 -0xffffffff:4294967295 -0x100000000:4294967296 -0x100000001:4294967297 - -0xfffffffffe:1099511627774 -0xffffffffff:1099511627775 -0x10000000000:1099511627776 -0x10000000001:1099511627777 - -0xfffffffffffe:281474976710654 -0xffffffffffff:281474976710655 -0x1000000000000:281474976710656 -0x1000000000001:281474976710657 - -0xfffffffffffffe:72057594037927934 -0xffffffffffffff:72057594037927935 -0x100000000000000:72057594037927936 -0x100000000000001:72057594037927937 - -0X10:16 -x10:16 -X10:16 - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/from_ieee754-mbf.t b/cpan/Math-BigInt/t/from_ieee754-mbf.t deleted file mode 100644 index 8edb904ba4..0000000000 --- a/cpan/Math-BigInt/t/from_ieee754-mbf.t +++ /dev/null @@ -1,257 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 230; - -use Math::BigFloat; - -my @k = (16, 32, 64, 128); - -sub stringify { - my $x = shift; - return "$x" unless $x -> is_finite(); - my $nstr = $x -> bnstr(); - my $sstr = $x -> bsstr(); - return length($nstr) < length($sstr) ? $nstr : $sstr; -} - -for my $k (@k) { - - # Parameters specific to this format: - - my $b = 2; - my $p = $k == 16 ? 11 - : $k == 32 ? 24 - : $k == 64 ? 53 - : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13; - - $b = Math::BigFloat -> new($b); - $k = Math::BigFloat -> new($k); - $p = Math::BigFloat -> new($p); - my $w = $k - $p; - - my $emax = 2 ** ($w - 1) - 1; - my $emin = 1 - $emax; - - my $format = sprintf 'binary%u', $k; - - my $binv = Math::BigFloat -> new("0.5"); - - my $data = - [ - - { - dsc => "smallest positive subnormal number", - bin => "0" - . ("0" x $w) - . ("0" x ($p - 2)) . "1", - asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") " - . "= $b ** (" . ($emin + 1 - $p) . ")", - mbf => $binv ** ($p - 1 - $emin), - }, - - { - dsc => "largest subnormal number", - bin => "0" - . ("0" x $w) - . ("1" x ($p - 1)), - asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))", - mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)), - }, - - { - dsc => "smallest positive normal number", - bin => "0" - . ("0" x ($w - 1)) . "1" - . ("0" x ($p - 1)), - asc => "$b ** ($emin)", - mbf => $binv ** (-$emin), - }, - - { - dsc => "largest normal number", - bin => "0" - . ("1" x ($w - 1)) . "0" - . "1" x ($p - 1), - asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))", - mbf => $b ** $emax * ($b - $binv ** ($p - 1)), - }, - - { - dsc => "largest number less than one", - bin => "0" - . "0" . ("1" x ($w - 2)) . "0" - . "1" x ($p - 1), - asc => "1 - $b ** (-$p)", - mbf => 1 - $binv ** $p, - }, - - { - dsc => "smallest number larger than one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . ("0" x ($p - 2)) . "1", - asc => "1 + $b ** (" . (1 - $p) . ")", - mbf => 1 + $binv ** ($p - 1), - }, - - { - dsc => "second smallest number larger than one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . ("0" x ($p - 3)) . "10", - asc => "1 + $b ** (" . (2 - $p) . ")", - mbf => 1 + $binv ** ($p - 2), - }, - - { - dsc => "one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . "0" x ($p - 1), - asc => "1", - mbf => Math::BigFloat -> new("1"), - }, - - { - dsc => "minus one", - bin => "1" - . "0" . ("1" x ($w - 1)) - . "0" x ($p - 1), - asc => "-1", - mbf => Math::BigFloat -> new("-1"), - }, - - { - dsc => "two", - bin => "0" - . "1" . ("0" x ($w - 1)) - . ("0" x ($p - 1)), - asc => "2", - mbf => Math::BigFloat -> new("2"), - }, - - { - dsc => "minus two", - bin => "1" - . "1" . ("0" x ($w - 1)) - . ("0" x ($p - 1)), - asc => "-2", - mbf => Math::BigFloat -> new("-2"), - }, - - { - dsc => "positive zero", - bin => "0" - . ("0" x $w) - . ("0" x ($p - 1)), - asc => "+0", - mbf => Math::BigFloat -> new("0"), - }, - - { - dsc => "negative zero", - bin => "1" - . ("0" x $w) - . ("0" x ($p - 1)), - asc => "-0", - mbf => Math::BigFloat -> new("0"), - }, - - { - dsc => "positive infinity", - bin => "0" - . ("1" x $w) - . ("0" x ($p - 1)), - asc => "+inf", - mbf => Math::BigFloat -> new("inf"), - }, - - { - dsc => "negative infinity", - bin => "1" - . ("1" x $w) - . ("0" x ($p - 1)), - asc => "-inf", - mbf => Math::BigFloat -> new("-inf"), - }, - - { - dsc => "NaN (sNaN on most processors, such as x86 and ARM)", - bin => "0" - . ("1" x $w) - . ("0" x ($p - 2)) . "1", - asc => "sNaN", - mbf => Math::BigFloat -> new("NaN"), - }, - - { - dsc => "NaN (qNaN on most processors, such as x86 and ARM)", - bin => "0" - . ("1" x $w) - . "1" . ("0" x ($p - 3)) . "1", - asc => "qNaN", - mbf => Math::BigFloat -> new("NaN"), - }, - - { - dsc => "NaN (an alternative encoding)", - bin => "0" - . ("1" x $w) - . ("1" x ($p - 1)), - asc => "NaN", - mbf => Math::BigFloat -> new("NaN"), - }, - - { - dsc => "NaN (encoding used by Perl on Cygwin)", - bin => "1" - . ("1" x $w) - . ("1" . ("0" x ($p - 2))), - asc => "NaN", - mbf => Math::BigFloat -> new("NaN"), - }, - - ]; - - for my $entry (@$data) { - my $bin = $entry -> {bin}; - my $bytes = pack "B*", $bin; - my $hex = unpack "H*", $bytes; - - note("\n", $entry -> {dsc }, " (k = $k)\n\n"); - - my $expected = stringify($entry -> {mbf}); - my ($got, $test); - - $got = Math::BigFloat -> from_ieee754($bin, $format); - $got = stringify($got); - $test = qq|Math::BigFloat->from_ieee754("$bin")|; - is($got, $expected, $test); - - $got = Math::BigFloat -> from_ieee754($hex, $format); - $got = stringify($got); - $test = qq|Math::BigFloat->from_ieee754("$hex")|; - is($got, $expected, $test); - - $got = Math::BigFloat -> from_ieee754($bytes, $format); - $got = stringify($got); - (my $str = $hex) =~ s/(..)/\\x$1/g; - $test = qq|Math::BigFloat->from_ieee754("$str")|; - is($got, $expected, $test); - } -} - -note("\nTest as class method vs. instance method.\n\n"); - -# As class method. - -my $x = Math::BigFloat -> from_ieee754("4000000000000000", "binary64"); -is($x, 2, "class method"); - -# As instance method, the invocand should be modified. - -$x -> from_ieee754("4008000000000000", "binary64"); -is($x, 3, "instance method modifies invocand"); diff --git a/cpan/Math-BigInt/t/from_oct-mbf.t b/cpan/Math-BigInt/t/from_oct-mbf.t deleted file mode 100644 index 2fff2a0ba3..0000000000 --- a/cpan/Math-BigInt/t/from_oct-mbf.t +++ /dev/null @@ -1,137 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1401; - -my $class; - -BEGIN { $class = 'Math::BigFloat'; } -BEGIN { use_ok($class, '1.999710'); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_oct("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_oct("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -# Without "0o" prefix. - -01p+0:1 -0.4p+1:1 -0.2p+2:1 -0.1p+3:1 -0.04p+4:1 -02p-1:1 -04p-2:1 -010p-3:1 - --1p+0:-1 - -0p+0:0 -0p+7:0 -0p-7:0 -0.p+0:0 -.0p+0:0 -0.0p+0:0 - -145376:51966 -0145376:51966 -00145376:51966 - -3.1p+2:12.5 -22.15p-1:9.1015625 --0.361152746757p+32:-2023406814.9375 -44.3212636115p+30:39093746765 - -.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:12.5 -0o22.15p-1:9.1015625 --0o0.361152746757p+32:-2023406814.9375 -0o44.3212636115p+30:39093746765 - -0o.p+0:NaN - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/from_oct-mbi.t b/cpan/Math-BigInt/t/from_oct-mbi.t deleted file mode 100644 index 3ec700ee88..0000000000 --- a/cpan/Math-BigInt/t/from_oct-mbi.t +++ /dev/null @@ -1,186 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 2745; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -my @data; -my $space = "\t\r\n "; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($in0, $out0) = split /:/; - - push @data, [ $in0, $out0 ], - [ $in0 . $space, $out0 ], - [ $space . $in0, $out0 ], - [ $space . $in0 . $space, $out0 ]; -} - -for my $entry (@data) { - my ($in0, $out0) = @$entry; - - # As class method. - - { - my $x; - my $test = qq|\$x = $class -> from_oct("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - - # As instance method. - - { - for my $str ("-1", "0", "1", "-inf", "+inf", "NaN") { - my $x; - my $test = qq|\$x = $class -> new("$str");| - . qq| \$x -> from_oct("$in0");|; - - eval $test; - die $@ if $@; # this should never happen - - subtest $test, sub { - plan tests => 2, - - is(ref($x), $class, "output arg is a $class"); - is($x, $out0, 'output arg has the right value'); - }; - } - } -} - -__END__ - -0:0 -1:1 -2:2 -3:3 -4:4 -5:5 -6:6 -7:7 -10:8 -11:9 -12:10 -13:11 -14:12 -15:13 -16:14 -17:15 -20:16 -21:17 - -376:254 -377:255 -400:256 -401:257 - -177776:65534 -177777:65535 -200000:65536 -200001:65537 - -77777776:16777214 -77777777:16777215 -100000000:16777216 -100000001:16777217 - -37777777776:4294967294 -37777777777:4294967295 -40000000000:4294967296 -40000000001:4294967297 - -17777777777776:1099511627774 -17777777777777:1099511627775 -20000000000000:1099511627776 -20000000000001:1099511627777 - -7777777777777776:281474976710654 -7777777777777777:281474976710655 -10000000000000000:281474976710656 -10000000000000001:281474976710657 - -3777777777777777776:72057594037927934 -3777777777777777777:72057594037927935 -4000000000000000000:72057594037927936 -4000000000000000001:72057594037927937 - -0o0:0 -0o1:1 -0o2:2 -0o3:3 -0o4:4 -0o5:5 -0o6:6 -0o7:7 -0o10:8 -0o11:9 -0o12:10 -0o13:11 -0o14:12 -0o15:13 -0o16:14 -0o17:15 -0o20:16 -0o21:17 - -0o376:254 -0o377:255 -0o400:256 -0o401:257 - -0o177776:65534 -0o177777:65535 -0o200000:65536 -0o200001:65537 - -0o77777776:16777214 -0o77777777:16777215 -0o100000000:16777216 -0o100000001:16777217 - -0o37777777776:4294967294 -0o37777777777:4294967295 -0o40000000000:4294967296 -0o40000000001:4294967297 - -0o17777777777776:1099511627774 -0o17777777777777:1099511627775 -0o20000000000000:1099511627776 -0o20000000000001:1099511627777 - -0o7777777777777776:281474976710654 -0o7777777777777777:281474976710655 -0o10000000000000000:281474976710656 -0o10000000000000001:281474976710657 - -0o3777777777777777776:72057594037927934 -0o3777777777777777777:72057594037927935 -0o4000000000000000000:72057594037927936 -0o4000000000000000001:72057594037927937 - -0O10:8 -o10:8 -O10:8 - -NaN:NaN -+inf:NaN --inf:NaN diff --git a/cpan/Math-BigInt/t/inf_nan.t b/cpan/Math-BigInt/t/inf_nan.t index 9634396b71..b8c792d914 100644 --- a/cpan/Math-BigInt/t/inf_nan.t +++ b/cpan/Math-BigInt/t/inf_nan.t @@ -1,13 +1,12 @@ # -*- mode: perl; -*- # test inf/NaN handling all in one place -# Thanx to Jarkko for the excellent explanations and the tables use strict; use warnings; use lib 't'; -use Test::More tests => 2052; +use Test::More tests => 1044; use Math::BigInt; use Math::BigFloat; @@ -17,7 +16,7 @@ use Math::BigFloat::Subclass; my @biclasses = qw/ Math::BigInt Math::BigInt::Subclass /; my @bfclasses = qw/ Math::BigFloat Math::BigFloat::Subclass /; -my (@args, $x, $y, $z); +my (@args, $x, $y, $z, $test); # + @@ -75,13 +74,25 @@ foreach (qw/ { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { + $args[2] = '0' if $args[2] eq '-0'; # Math::Big* has no -0 $x = $class->new($args[0]); $y = $class->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 - my $r = $x->badd($y); - - is($x->bstr(), $args[2], "x $class $args[0] + $args[1]"); - is($x->bstr(), $args[2], "r $class $args[0] + $args[1]"); + $z = $x->badd($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$z = \$x->badd(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($z), $class, "\$z is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($z->bstr(), $args[2], 'value of $z'); + }; } } @@ -141,13 +152,25 @@ foreach (qw/ { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { + $args[2] = '0' if $args[2] eq '-0'; # Math::Big* has no -0 $x = $class->new($args[0]); $y = $class->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 - my $r = $x->bsub($y); - - is($x->bstr(), $args[2], "x $class $args[0] - $args[1]"); - is($r->bstr(), $args[2], "r $class $args[0] - $args[1]"); + $z = $x->bsub($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$z = \$x->bsub(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($z), $class, "\$z is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($z->bstr(), $args[2], 'value of $z'); + }; } } @@ -207,13 +230,25 @@ foreach (qw/ { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { + $args[2] = '0' if $args[2] eq '-0'; # Math::Big* has no -0 $x = $class->new($args[0]); $y = $class->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 - my $r = $x->bmul($y); - - is($x->bstr(), $args[2], "x $class $args[0] * $args[1]"); - is($r->bstr(), $args[2], "r $class $args[0] * $args[1]"); + $z = $x->bmul($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$z = \$x->bmul(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($z), $class, "\$z is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($z->bstr(), $args[2], 'value of $z'); + }; } } @@ -273,34 +308,80 @@ foreach (qw/ { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { - $x = $class->new($args[0]); - $y = $class->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 + $args[2] = '0' if $args[2] eq '-0'; # Math::Big* has no -0 - my $t = $x->copy(); - my $tmod = $t->copy(); + my ($q, $r); # bdiv in scalar context + + $x = $class->new($args[0]); + $y = $class->new($args[1]); + unless ($class =~ /^Math::BigFloat/) { - my $r = $x->bdiv($y); - is($x->bstr(), $args[2], "x $class $args[0] / $args[1]"); - is($r->bstr(), $args[2], "r $class $args[0] / $args[1]"); + $q = $x->bdiv($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$q = \$x->bdiv(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($q), $class, "\$q is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($q->bstr(), $args[2], 'value of $q'); + }; } # bmod and bdiv in list context - my ($d, $rem) = $t->bdiv($y); + + $x = $class->new($args[0]); + $y = $class->new($args[1]); + + ($q, $r) = $x->bdiv($y); # bdiv in list context - is($t->bstr(), $args[2], "t $class $args[0] / $args[1]"); - is($d->bstr(), $args[2], "d $class $args[0] / $args[1]"); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|(\$q, \$r) = \$x->bdiv(\$y);|; + + subtest $test => sub { + plan tests => 7; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($q), $class, "\$q is a $class"); + is(ref($r), $class, "\$r is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($q->bstr(), $args[2], 'value of $q'); + }; # bmod - my $m = $tmod->bmod($y); - # bmod() agrees with bdiv? - is($m->bstr(), $rem->bstr(), "m $class $args[0] % $args[1]"); - # bmod() return agrees with set value? - is($tmod->bstr(), $m->bstr(), "o $class $args[0] % $args[1]"); + $x = $class->new($args[0]); + $y = $class->new($args[1]); + + my $m = $x->bmod($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$m = \$x->bmod(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($m), $class, "\$m is a $class"); + is($x->bstr(), $r->bstr(), 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($m->bstr(), $r->bstr(), 'value of $m'); + }; } } @@ -360,17 +441,25 @@ foreach (qw/ { @args = split /:/, $_; for my $class (@bfclasses) { + $args[2] = '0' if $args[2] eq '-0'; # Math::Big* has no -0 $x = $class->new($args[0]); $y = $class->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 - - my $t = $x->copy(); - my $tmod = $t->copy(); - - # bdiv in scalar context - my $r = $x->bdiv($y); - is($x->bstr(), $args[2], "x $class $args[0] / $args[1]"); - is($r->bstr(), $args[2], "r $class $args[0] / $args[1]"); + $z = $x->bdiv($y); + + $test = qq|\$x = $class->new("$args[0]"); | + . qq|\$y = $class->new("$args[1]"); | + . qq|\$z = \$x->bdiv(\$y);|; + + subtest $test => sub { + plan tests => 6; + + is(ref($x), $class, "\$x is a $class"); + is(ref($y), $class, "\$y is still a $class"); + is(ref($z), $class, "\$z is a $class"); + is($x->bstr(), $args[2], 'value of $x'); + is($y->bstr(), $args[1], 'value of $y'); + is($z->bstr(), $args[2], 'value of $z'); + }; } } @@ -378,9 +467,9 @@ foreach (qw/ # overloaded comparisons foreach my $c (@biclasses, @bfclasses) { - my $x = $c->bnan(); - my $y = $c->bnan(); # test with two different objects, too - my $z = $c->bzero(); + $x = $c->bnan(); + $y = $c->bnan(); # test with two different objects, too + $z = $c->bzero(); is($x == $y, '', 'NaN == NaN: ""'); is($x != $y, 1, 'NaN != NaN: 1'); diff --git a/cpan/Math-BigInt/t/lib_load-mbf-mbi.t b/cpan/Math-BigInt/t/lib_load-mbf-mbi.t deleted file mode 100644 index e18476ed49..0000000000 --- a/cpan/Math-BigInt/t/lib_load-mbf-mbi.t +++ /dev/null @@ -1,72 +0,0 @@ -# -*- 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 deleted file mode 100644 index 8868667fe3..0000000000 --- a/cpan/Math-BigInt/t/lib_load-mbi-mbf.t +++ /dev/null @@ -1,72 +0,0 @@ -# -*- 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/mbimbf.inc b/cpan/Math-BigInt/t/mbimbf.inc index 7a52d73c8a..c3b458f300 100644 --- a/cpan/Math-BigInt/t/mbimbf.inc +++ b/cpan/Math-BigInt/t/mbimbf.inc @@ -417,17 +417,15 @@ $x = $mbi->new(123400); $x->{_a} = 4; is($x->bnot(), -123400, q|$x->bnot()|); # not -1234001 -# both babs() and bneg() don't need to round, since the input will already -# be rounded (either as $x or via new($string)), and they don't change the -# value. The two tests below peek at this by using _a (illegally) directly +# to be consistent with other methods, babs() and bneg() also support rounding $x = $mbi->new(-123401); $x->{_a} = 4; -is($x->babs(), 123401, q|$x->babs()|); +is($x->babs(), 123400, q|$x->babs()|); $x = $mbi->new(-123401); $x->{_a} = 4; -is($x->bneg(), 123401, q|$x->bneg()|); +is($x->bneg(), 123400, q|$x->bneg()|); # test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions) @@ -1293,7 +1291,7 @@ while (<DATA>) { $try .= qq| \$y->accuracy($ya);| if $ya ne ''; $try .= qq| \$y->precision($yp);| if $yp ne ''; - $try .= ' $x->$f($y);'; + $try .= ' $x->' . $f . '($y);'; # print "trying $try\n"; $rc = eval $try; diff --git a/cpan/Math-BigInt/t/new-mbf.t b/cpan/Math-BigInt/t/new-mbf.t deleted file mode 100644 index d4fa8b6017..0000000000 --- a/cpan/Math-BigInt/t/new-mbf.t +++ /dev/null @@ -1,303 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 112; - -use Scalar::Util qw< refaddr >; - -my $class; - -BEGIN { $class = 'Math::BigFloat'; } -BEGIN { use_ok($class, '1.999821'); } - -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::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 -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:12.5 -0b10010.001101p-1:9.1015625 --0b.11110001001101010111100110111101111p+31:-2023406814.9375 -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:12.5 -022.15p-1:9.1015625 --00.361152746757p+32:-2023406814.9375 -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:12.5 -0o22.15p-1:9.1015625 --0o0.361152746757p+32:-2023406814.9375 -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:12.5 -0x12.34p-1:9.1015625 --0x.789abcdefp+32:-2023406814.9375 -0x12.3456789ap+31:39093746765 - -0x.p+0:NaN - -#NaN:NaN -#+inf:NaN -#-inf:NaN diff --git a/cpan/Math-BigInt/t/new-mbi.t b/cpan/Math-BigInt/t/new-mbi.t deleted file mode 100644 index 07d826d4ca..0000000000 --- a/cpan/Math-BigInt/t/new-mbi.t +++ /dev/null @@ -1,279 +0,0 @@ -# -*- 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/nparts-mbf.t b/cpan/Math-BigInt/t/nparts-mbf.t deleted file mode 100644 index 0c558ad3be..0000000000 --- a/cpan/Math-BigInt/t/nparts-mbf.t +++ /dev/null @@ -1,294 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1840; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> nparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my ($mant_got, $expo_got) = $x -> nparts(); - - isa_ok($mant_got, "Math::BigFloat"); - isa_ok($expo_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| \$m = \$x -> nparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my $mant_got = $x -> nparts(); - - isa_ok($mant_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -0.000000000001:1:-12 -0.00000000001:1:-11 -0.0000000001:1:-10 -0.000000001:1:-9 -0.00000001:1:-8 -0.0000001:1:-7 -0.000001:1:-6 -0.00001:1:-5 -0.0001:1:-4 -0.001:1:-3 -0.01:1:-2 -0.1:1:-1 -1:1:0 -10:1:1 -100:1:2 -1000:1:3 -10000:1:4 -100000:1:5 -1000000:1:6 -10000000:1:7 -100000000:1:8 -1000000000:1:9 -10000000000:1:10 -100000000000:1:11 -1000000000000:1:12 - -0.0000000000012:1.2:-12 -0.000000000012:1.2:-11 -0.00000000012:1.2:-10 -0.0000000012:1.2:-9 -0.000000012:1.2:-8 -0.00000012:1.2:-7 -0.0000012:1.2:-6 -0.000012:1.2:-5 -0.00012:1.2:-4 -0.0012:1.2:-3 -0.012:1.2:-2 -0.12:1.2:-1 -1.2:1.2:0 -12:1.2:1 -120:1.2:2 -1200:1.2:3 -12000:1.2:4 -120000:1.2:5 -1200000:1.2:6 -12000000:1.2:7 -120000000:1.2:8 -1200000000:1.2:9 -12000000000:1.2:10 -120000000000:1.2:11 -1200000000000:1.2:12 - -0.00000000000123:1.23:-12 -0.0000000000123:1.23:-11 -0.000000000123:1.23:-10 -0.00000000123:1.23:-9 -0.0000000123:1.23:-8 -0.000000123:1.23:-7 -0.00000123:1.23:-6 -0.0000123:1.23:-5 -0.000123:1.23:-4 -0.00123:1.23:-3 -0.0123:1.23:-2 -0.123:1.23:-1 -1.23:1.23:0 -12.3:1.23:1 -123:1.23:2 -1230:1.23:3 -12300:1.23:4 -123000:1.23:5 -1230000:1.23:6 -12300000:1.23:7 -123000000:1.23:8 -1230000000:1.23:9 -12300000000:1.23:10 -123000000000:1.23:11 -1230000000000:1.23:12 - -0.000000000001234:1.234:-12 -0.00000000001234:1.234:-11 -0.0000000001234:1.234:-10 -0.000000001234:1.234:-9 -0.00000001234:1.234:-8 -0.0000001234:1.234:-7 -0.000001234:1.234:-6 -0.00001234:1.234:-5 -0.0001234:1.234:-4 -0.001234:1.234:-3 -0.01234:1.234:-2 -0.1234:1.234:-1 -1.234:1.234:0 -12.34:1.234:1 -123.4:1.234:2 -1234:1.234:3 -12340:1.234:4 -123400:1.234:5 -1234000:1.234:6 -12340000:1.234:7 -123400000:1.234:8 -1234000000:1.234:9 -12340000000:1.234:10 -123400000000:1.234:11 -1234000000000:1.234:12 - -0.000003141592:3.141592:-6 -0.00003141592:3.141592:-5 -0.0003141592:3.141592:-4 -0.003141592:3.141592:-3 -0.03141592:3.141592:-2 -0.3141592:3.141592:-1 -3.141592:3.141592:0 -31.41592:3.141592:1 -314.1592:3.141592:2 -3141.592:3.141592:3 -31415.92:3.141592:4 -314159.2:3.141592:5 -3141592:3.141592:6 - -# negativ: numbers - --0.000000000001:-1:-12 --0.00000000001:-1:-11 --0.0000000001:-1:-10 --0.000000001:-1:-9 --0.00000001:-1:-8 --0.0000001:-1:-7 --0.000001:-1:-6 --0.00001:-1:-5 --0.0001:-1:-4 --0.001:-1:-3 --0.01:-1:-2 --0.1:-1:-1 --1:-1:0 --10:-1:1 --100:-1:2 --1000:-1:3 --10000:-1:4 --100000:-1:5 --1000000:-1:6 --10000000:-1:7 --100000000:-1:8 --1000000000:-1:9 --10000000000:-1:10 --100000000000:-1:11 --1000000000000:-1:12 - --0.0000000000012:-1.2:-12 --0.000000000012:-1.2:-11 --0.00000000012:-1.2:-10 --0.0000000012:-1.2:-9 --0.000000012:-1.2:-8 --0.00000012:-1.2:-7 --0.0000012:-1.2:-6 --0.000012:-1.2:-5 --0.00012:-1.2:-4 --0.0012:-1.2:-3 --0.012:-1.2:-2 --0.12:-1.2:-1 --1.2:-1.2:0 --12:-1.2:1 --120:-1.2:2 --1200:-1.2:3 --12000:-1.2:4 --120000:-1.2:5 --1200000:-1.2:6 --12000000:-1.2:7 --120000000:-1.2:8 --1200000000:-1.2:9 --12000000000:-1.2:10 --120000000000:-1.2:11 --1200000000000:-1.2:12 - --0.00000000000123:-1.23:-12 --0.0000000000123:-1.23:-11 --0.000000000123:-1.23:-10 --0.00000000123:-1.23:-9 --0.0000000123:-1.23:-8 --0.000000123:-1.23:-7 --0.00000123:-1.23:-6 --0.0000123:-1.23:-5 --0.000123:-1.23:-4 --0.00123:-1.23:-3 --0.0123:-1.23:-2 --0.123:-1.23:-1 --1.23:-1.23:0 --12.3:-1.23:1 --123:-1.23:2 --1230:-1.23:3 --12300:-1.23:4 --123000:-1.23:5 --1230000:-1.23:6 --12300000:-1.23:7 --123000000:-1.23:8 --1230000000:-1.23:9 --12300000000:-1.23:10 --123000000000:-1.23:11 --1230000000000:-1.23:12 - --0.000000000001234:-1.234:-12 --0.00000000001234:-1.234:-11 --0.0000000001234:-1.234:-10 --0.000000001234:-1.234:-9 --0.00000001234:-1.234:-8 --0.0000001234:-1.234:-7 --0.000001234:-1.234:-6 --0.00001234:-1.234:-5 --0.0001234:-1.234:-4 --0.001234:-1.234:-3 --0.01234:-1.234:-2 --0.1234:-1.234:-1 --1.234:-1.234:0 --12.34:-1.234:1 --123.4:-1.234:2 --1234:-1.234:3 --12340:-1.234:4 --123400:-1.234:5 --1234000:-1.234:6 --12340000:-1.234:7 --123400000:-1.234:8 --1234000000:-1.234:9 --12340000000:-1.234:10 --123400000000:-1.234:11 --1234000000000:-1.234:12 - --0.000003141592:-3.141592:-6 --0.00003141592:-3.141592:-5 --0.0003141592:-3.141592:-4 --0.003141592:-3.141592:-3 --0.03141592:-3.141592:-2 --0.3141592:-3.141592:-1 --3.141592:-3.141592:0 --31.41592:-3.141592:1 --314.1592:-3.141592:2 --3141.592:-3.141592:3 --31415.92:-3.141592:4 --314159.2:-3.141592:5 --3141592:-3.141592:6 diff --git a/cpan/Math-BigInt/t/nparts-mbi.t b/cpan/Math-BigInt/t/nparts-mbi.t deleted file mode 100644 index a970535339..0000000000 --- a/cpan/Math-BigInt/t/nparts-mbi.t +++ /dev/null @@ -1,162 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 784; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> nparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my ($mant_got, $expo_got) = $x -> nparts(); - - isa_ok($mant_got, "Math::BigInt"); - isa_ok($expo_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| \$m = \$x -> nparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my $mant_got = $x -> nparts(); - - isa_ok($mant_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -1:1:0 -10:1:1 -100:1:2 -1000:1:3 -10000:1:4 -100000:1:5 -1000000:1:6 -10000000:1:7 -100000000:1:8 -1000000000:1:9 -10000000000:1:10 -100000000000:1:11 -1000000000000:1:12 - -12:NaN:1 -120:NaN:2 -1200:NaN:3 -12000:NaN:4 -120000:NaN:5 -1200000:NaN:6 -12000000:NaN:7 -120000000:NaN:8 -1200000000:NaN:9 -12000000000:NaN:10 -120000000000:NaN:11 -1200000000000:NaN:12 - -123:NaN:2 -1230:NaN:3 -12300:NaN:4 -123000:NaN:5 -1230000:NaN:6 -12300000:NaN:7 -123000000:NaN:8 -1230000000:NaN:9 -12300000000:NaN:10 -123000000000:NaN:11 -1230000000000:NaN:12 - -1234:NaN:3 -12340:NaN:4 -123400:NaN:5 -1234000:NaN:6 -12340000:NaN:7 -123400000:NaN:8 -1234000000:NaN:9 -12340000000:NaN:10 -123400000000:NaN:11 -1234000000000:NaN:12 - -3141592:NaN:6 - -# negativ: numbers - --1:-1:0 --10:-1:1 --100:-1:2 --1000:-1:3 --10000:-1:4 --100000:-1:5 --1000000:-1:6 --10000000:-1:7 --100000000:-1:8 --1000000000:-1:9 --10000000000:-1:10 --100000000000:-1:11 --1000000000000:-1:12 - --12:NaN:1 --120:NaN:2 --1200:NaN:3 --12000:NaN:4 --120000:NaN:5 --1200000:NaN:6 --12000000:NaN:7 --120000000:NaN:8 --1200000000:NaN:9 --12000000000:NaN:10 --120000000000:NaN:11 --1200000000000:NaN:12 - --123:NaN:2 --1230:NaN:3 --12300:NaN:4 --123000:NaN:5 --1230000:NaN:6 --12300000:NaN:7 --123000000:NaN:8 --1230000000:NaN:9 --12300000000:NaN:10 --123000000000:NaN:11 --1230000000000:NaN:12 - --1234:NaN:3 --12340:NaN:4 --123400:NaN:5 --1234000:NaN:6 --12340000:NaN:7 --123400000:NaN:8 --1234000000:NaN:9 --12340000000:NaN:10 --123400000000:NaN:11 --1234000000000:NaN:12 - --3141592:NaN:6 diff --git a/cpan/Math-BigInt/t/objectify_mbf.t b/cpan/Math-BigInt/t/objectify_mbf.t deleted file mode 100644 index 8ea7abe1e0..0000000000 --- a/cpan/Math-BigInt/t/objectify_mbf.t +++ /dev/null @@ -1,99 +0,0 @@ -# -*- 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. - -use strict; -use warnings; - -package main; - -use Test::More tests => 6; - -use Math::BigFloat; - -############################################################################### - -for my $class ('Math::BigFloat', 'Math::BigFloat::Subclass') { - - # This object defines what we want. - - my $float = $class -> new(10); - - # Create various objects that should work with the object above after - # objectify() has done its thing. - - my $float_percent1 = My::Percent::Float1 -> new(100); - is($float * $float_percent1, 10, - qq|\$float = $class -> new(10);| - . q| $float_percent1 = My::Percent::Float1 -> new(100);| - . q| $float * $float_percent1;|); - - my $float_percent2 = My::Percent::Float2 -> new(100); - is($float * $float_percent2, 10, - qq|\$float = $class -> new(10);| - . q| $float_percent2 = My::Percent::Float2 -> new(100);| - . q| $float * $float_percent2;|); - - my $float_percent3 = My::Percent::Float3 -> new(100); - is($float * $float_percent3, 10, - qq|\$float = $class -> new(10);| - . q| $float_percent3 = My::Percent::Float3 -> new(100);| - . q| $float * $float_percent3;|); -} - -############################################################################### -# Class supports as_float(), which returns a Math::BigFloat. - -package My::Percent::Float1; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_float { - my $self = shift; - return Math::BigFloat -> new($$self / 100); -} - -############################################################################### -# Class supports as_float(), which returns a scalar. - -package My::Percent::Float2; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_float { - my $self = shift; - return $$self / 100; -} - -############################################################################### -# Class does not support as_float(). - -package My::Percent::Float3; - -use overload '""' => sub { $_[0] -> as_string(); }; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_string { - my $self = shift; - return $$self / 100; -} - -############################################################################### - -package Math::BigFloat::Subclass; - -use base 'Math::BigFloat'; diff --git a/cpan/Math-BigInt/t/objectify_mbi.t b/cpan/Math-BigInt/t/objectify_mbi.t deleted file mode 100644 index 8efb4520c7..0000000000 --- a/cpan/Math-BigInt/t/objectify_mbi.t +++ /dev/null @@ -1,145 +0,0 @@ -# -*- 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. - -use strict; -use warnings; - -package main; - -use Test::More tests => 10; - -use Math::BigInt; - -############################################################################### - -for my $class ('Math::BigInt', 'Math::BigInt::Subclass') { - - # This object defines what we want. - - my $int = $class -> new(10); - - # Create various objects that should work with the object above after - # objectify() has done its thing. - - my $int_percent1 = My::Percent::Int1 -> new(100); - is($int * $int_percent1, 10, - qq|\$class -> new(10);| - . q| $int_percent1 = My::Percent::Int1 -> new(100);| - . q| $int * $int_percent1|); - - my $int_percent2 = My::Percent::Int2 -> new(100); - is($int * $int_percent2, 10, - qq|\$class -> new(10);| - . q| $int_percent2 = My::Percent::Int2 -> new(100);| - . q| $int * $int_percent2|); - - my $int_percent3 = My::Percent::Int3 -> new(100); - is($int * $int_percent3, 10, - qq|\$class -> new(10);| - . q| $int_percent3 = My::Percent::Int3 -> new(100);| - . q| $int * $int_percent3|); - - my $int_percent4 = My::Percent::Int4 -> new(100); - is($int * $int_percent4, 10, - qq|\$class -> new(10);| - . q| $int_percent4 = My::Percent::Int4 -> new(100);| - . q| $int * $int_percent4|); - - my $int_percent5 = My::Percent::Int5 -> new(100); - is($int * $int_percent5, 10, - qq|\$class -> new(10);| - . q| $int_percent5 = My::Percent::Int5 -> new(100);| - . q| $int * $int_percent5|); -} - -############################################################################### -# Class supports as_int(), which returns a Math::BigInt. - -package My::Percent::Int1; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_int { - my $self = shift; - return Math::BigInt -> new($$self / 100); -} - -############################################################################### -# Class supports as_int(), which returns a scalar. - -package My::Percent::Int2; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_int { - my $self = shift; - return $$self / 100; -} - -############################################################################### -# Class does not support as_int(), but supports as_number(), which returns a -# Math::BigInt. - -package My::Percent::Int3; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_number { - my $self = shift; - return Math::BigInt -> new($$self / 100); -} - -############################################################################### -# Class does not support as_int(), but supports as_number(), which returns a -# scalar. - -package My::Percent::Int4; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_number { - my $self = shift; - return $$self / 100; -} - -############################################################################### -# Class supports neither as_int() or as_number(). - -package My::Percent::Int5; - -use overload '""' => sub { $_[0] -> as_string(); }; - -sub new { - my $class = shift; - my $num = shift; - return bless \$num, $class; -} - -sub as_string { - my $self = shift; - return $$self / 100; -} - -############################################################################### - -package Math::BigInt::Subclass; - -use base 'Math::BigInt'; diff --git a/cpan/Math-BigInt/t/sparts-mbf.t b/cpan/Math-BigInt/t/sparts-mbf.t deleted file mode 100644 index b1a7a4a87e..0000000000 --- a/cpan/Math-BigInt/t/sparts-mbf.t +++ /dev/null @@ -1,325 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 1848; - -use Math::BigFloat; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> sparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my ($mant_got, $expo_got) = $x -> sparts(); - - isa_ok($mant_got, "Math::BigFloat"); - isa_ok($expo_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigFloat -> new("$x_str");|, - qq| \$m = \$x -> sparts();\n\n|); - - { - my $x = Math::BigFloat -> new($x_str); - my $mant_got = $x -> sparts(); - - isa_ok($mant_got, "Math::BigFloat"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -# Verify that the accuracy of the significand and the exponent depends on the -# accuracy of the invocand, if set, not the class. - -note(qq|\nVerify that accuracy depends on invocand, not class.\n\n|); - -{ - Math::BigFloat -> accuracy(20); - my $x = Math::BigFloat -> new("3"); # accuray is 20 - $x -> accuracy(10); # reduce accuray to 10 - - my ($mant, $expo) = $x -> sparts(); - cmp_ok($mant, '==', 3, "value of significand"); - cmp_ok($expo, '==', 0, "value of exponent"); - cmp_ok($mant -> accuracy(), '==', 10, "accuracy of significand"); - cmp_ok($expo -> accuracy(), '==', 20, "accuracy of exponent"); -} - -note(qq|\nVerify that precision depends on invocand, not class.\n\n|); - -{ - Math::BigFloat -> precision(20); - my $x = Math::BigFloat -> new("3"); # precision is 20 - $x -> precision(10); # reduce precision to 10 - - my ($mant, $expo) = $x -> sparts(); - cmp_ok($mant, '==', 3, "value of significand"); - cmp_ok($expo, '==', 0, "value of exponent"); - cmp_ok($mant -> precision(), '==', 10, "precision of significand"); - cmp_ok($expo -> precision(), '==', 20, "precision of exponent"); -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -0.000000000001:1:-12 -0.00000000001:1:-11 -0.0000000001:1:-10 -0.000000001:1:-9 -0.00000001:1:-8 -0.0000001:1:-7 -0.000001:1:-6 -0.00001:1:-5 -0.0001:1:-4 -0.001:1:-3 -0.01:1:-2 -0.1:1:-1 -1:1:0 -10:1:1 -100:1:2 -1000:1:3 -10000:1:4 -100000:1:5 -1000000:1:6 -10000000:1:7 -100000000:1:8 -1000000000:1:9 -10000000000:1:10 -100000000000:1:11 -1000000000000:1:12 - -0.0000000000012:12:-13 -0.000000000012:12:-12 -0.00000000012:12:-11 -0.0000000012:12:-10 -0.000000012:12:-9 -0.00000012:12:-8 -0.0000012:12:-7 -0.000012:12:-6 -0.00012:12:-5 -0.0012:12:-4 -0.012:12:-3 -0.12:12:-2 -1.2:12:-1 -12:12:0 -120:12:1 -1200:12:2 -12000:12:3 -120000:12:4 -1200000:12:5 -12000000:12:6 -120000000:12:7 -1200000000:12:8 -12000000000:12:9 -120000000000:12:10 -1200000000000:12:11 - -0.00000000000123:123:-14 -0.0000000000123:123:-13 -0.000000000123:123:-12 -0.00000000123:123:-11 -0.0000000123:123:-10 -0.000000123:123:-9 -0.00000123:123:-8 -0.0000123:123:-7 -0.000123:123:-6 -0.00123:123:-5 -0.0123:123:-4 -0.123:123:-3 -1.23:123:-2 -12.3:123:-1 -123:123:0 -1230:123:1 -12300:123:2 -123000:123:3 -1230000:123:4 -12300000:123:5 -123000000:123:6 -1230000000:123:7 -12300000000:123:8 -123000000000:123:9 -1230000000000:123:10 - -0.000000000001234:1234:-15 -0.00000000001234:1234:-14 -0.0000000001234:1234:-13 -0.000000001234:1234:-12 -0.00000001234:1234:-11 -0.0000001234:1234:-10 -0.000001234:1234:-9 -0.00001234:1234:-8 -0.0001234:1234:-7 -0.001234:1234:-6 -0.01234:1234:-5 -0.1234:1234:-4 -1.234:1234:-3 -12.34:1234:-2 -123.4:1234:-1 -1234:1234:0 -12340:1234:1 -123400:1234:2 -1234000:1234:3 -12340000:1234:4 -123400000:1234:5 -1234000000:1234:6 -12340000000:1234:7 -123400000000:1234:8 -1234000000000:1234:9 - -0.000003141592:3141592:-12 -0.00003141592:3141592:-11 -0.0003141592:3141592:-10 -0.003141592:3141592:-9 -0.03141592:3141592:-8 -0.3141592:3141592:-7 -3.141592:3141592:-6 -31.41592:3141592:-5 -314.1592:3141592:-4 -3141.592:3141592:-3 -31415.92:3141592:-2 -314159.2:3141592:-1 -3141592:3141592:0 - -# negativ: numbers - --0.000000000001:-1:-12 --0.00000000001:-1:-11 --0.0000000001:-1:-10 --0.000000001:-1:-9 --0.00000001:-1:-8 --0.0000001:-1:-7 --0.000001:-1:-6 --0.00001:-1:-5 --0.0001:-1:-4 --0.001:-1:-3 --0.01:-1:-2 --0.1:-1:-1 --1:-1:0 --10:-1:1 --100:-1:2 --1000:-1:3 --10000:-1:4 --100000:-1:5 --1000000:-1:6 --10000000:-1:7 --100000000:-1:8 --1000000000:-1:9 --10000000000:-1:10 --100000000000:-1:11 --1000000000000:-1:12 - --0.0000000000012:-12:-13 --0.000000000012:-12:-12 --0.00000000012:-12:-11 --0.0000000012:-12:-10 --0.000000012:-12:-9 --0.00000012:-12:-8 --0.0000012:-12:-7 --0.000012:-12:-6 --0.00012:-12:-5 --0.0012:-12:-4 --0.012:-12:-3 --0.12:-12:-2 --1.2:-12:-1 --12:-12:0 --120:-12:1 --1200:-12:2 --12000:-12:3 --120000:-12:4 --1200000:-12:5 --12000000:-12:6 --120000000:-12:7 --1200000000:-12:8 --12000000000:-12:9 --120000000000:-12:10 --1200000000000:-12:11 - --0.00000000000123:-123:-14 --0.0000000000123:-123:-13 --0.000000000123:-123:-12 --0.00000000123:-123:-11 --0.0000000123:-123:-10 --0.000000123:-123:-9 --0.00000123:-123:-8 --0.0000123:-123:-7 --0.000123:-123:-6 --0.00123:-123:-5 --0.0123:-123:-4 --0.123:-123:-3 --1.23:-123:-2 --12.3:-123:-1 --123:-123:0 --1230:-123:1 --12300:-123:2 --123000:-123:3 --1230000:-123:4 --12300000:-123:5 --123000000:-123:6 --1230000000:-123:7 --12300000000:-123:8 --123000000000:-123:9 --1230000000000:-123:10 - --0.000000000001234:-1234:-15 --0.00000000001234:-1234:-14 --0.0000000001234:-1234:-13 --0.000000001234:-1234:-12 --0.00000001234:-1234:-11 --0.0000001234:-1234:-10 --0.000001234:-1234:-9 --0.00001234:-1234:-8 --0.0001234:-1234:-7 --0.001234:-1234:-6 --0.01234:-1234:-5 --0.1234:-1234:-4 --1.234:-1234:-3 --12.34:-1234:-2 --123.4:-1234:-1 --1234:-1234:0 --12340:-1234:1 --123400:-1234:2 --1234000:-1234:3 --12340000:-1234:4 --123400000:-1234:5 --1234000000:-1234:6 --12340000000:-1234:7 --123400000000:-1234:8 --1234000000000:-1234:9 - --0.000003141592:-3141592:-12 --0.00003141592:-3141592:-11 --0.0003141592:-3141592:-10 --0.003141592:-3141592:-9 --0.03141592:-3141592:-8 --0.3141592:-3141592:-7 --3.141592:-3141592:-6 --31.41592:-3141592:-5 --314.1592:-3141592:-4 --3141.592:-3141592:-3 --31415.92:-3141592:-2 --314159.2:-3141592:-1 --3141592:-3141592:0 diff --git a/cpan/Math-BigInt/t/sparts-mbi.t b/cpan/Math-BigInt/t/sparts-mbi.t deleted file mode 100644 index 5d1dab333f..0000000000 --- a/cpan/Math-BigInt/t/sparts-mbi.t +++ /dev/null @@ -1,193 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 792; - -use Math::BigInt; - -while (<DATA>) { - s/#.*$//; # remove comments - s/\s+$//; # remove trailing whitespace - next unless length; # skip empty lines - - my ($x_str, $mant_str, $expo_str) = split /:/; - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| (\$m, \$e) = \$x -> sparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my ($mant_got, $expo_got) = $x -> sparts(); - - isa_ok($mant_got, "Math::BigInt"); - isa_ok($expo_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($expo_got, $expo_str, "value of exponent"); - is($x, $x_str, "input is unmodified"); - } - - note(qq|\n\$x = Math::BigInt -> new("$x_str");|, - qq| \$m = \$x -> sparts();\n\n|); - - { - my $x = Math::BigInt -> new($x_str); - my $mant_got = $x -> sparts(); - - isa_ok($mant_got, "Math::BigInt"); - - is($mant_got, $mant_str, "value of mantissa"); - is($x, $x_str, "input is unmodified"); - } - -} - -# Verify that the accuracy of the significand and the exponent depends on the -# accuracy of the invocand, if set, not the class. - -note(qq|\nVerify that accuracy depends on invocand, not class.\n\n|); - -{ - Math::BigInt -> accuracy(20); - my $x = Math::BigInt -> new("3"); # accuracy is 20 - $x -> accuracy(10); # reduce accuracy to 10 - - my ($mant, $expo) = $x -> sparts(); - cmp_ok($mant, '==', 3, "value of significand"); - cmp_ok($expo, '==', 0, "value of exponent"); - cmp_ok($mant -> accuracy(), '==', 10, "accuracy of significand"); - cmp_ok($expo -> accuracy(), '==', 20, "accuracy of exponent"); -} - -note(qq|\nVerify that precision depends on invocand, not class.\n\n|); - -{ - Math::BigInt -> precision(20); - my $x = Math::BigInt -> new("3"); # precision is 20 - $x -> precision(10); # reduce precision to 10 - - my ($mant, $expo) = $x -> sparts(); - cmp_ok($mant, '==', 3, "value of significand"); - cmp_ok($expo, '==', 0, "value of exponent"); - cmp_ok($mant -> precision(), '==', 10, "precision of significand"); - cmp_ok($expo -> precision(), '==', 20, "precision of exponent"); -} - -__DATA__ - -NaN:NaN:NaN - -inf:inf:inf --inf:-inf:inf - -0:0:0 - -# positive numbers - -1:1:0 -10:1:1 -100:1:2 -1000:1:3 -10000:1:4 -100000:1:5 -1000000:1:6 -10000000:1:7 -100000000:1:8 -1000000000:1:9 -10000000000:1:10 -100000000000:1:11 -1000000000000:1:12 - -12:12:0 -120:12:1 -1200:12:2 -12000:12:3 -120000:12:4 -1200000:12:5 -12000000:12:6 -120000000:12:7 -1200000000:12:8 -12000000000:12:9 -120000000000:12:10 -1200000000000:12:11 - -123:123:0 -1230:123:1 -12300:123:2 -123000:123:3 -1230000:123:4 -12300000:123:5 -123000000:123:6 -1230000000:123:7 -12300000000:123:8 -123000000000:123:9 -1230000000000:123:10 - -1234:1234:0 -12340:1234:1 -123400:1234:2 -1234000:1234:3 -12340000:1234:4 -123400000:1234:5 -1234000000:1234:6 -12340000000:1234:7 -123400000000:1234:8 -1234000000000:1234:9 - -3141592:3141592:0 - -# negativ: numbers - --1:-1:0 --10:-1:1 --100:-1:2 --1000:-1:3 --10000:-1:4 --100000:-1:5 --1000000:-1:6 --10000000:-1:7 --100000000:-1:8 --1000000000:-1:9 --10000000000:-1:10 --100000000000:-1:11 --1000000000000:-1:12 - --12:-12:0 --120:-12:1 --1200:-12:2 --12000:-12:3 --120000:-12:4 --1200000:-12:5 --12000000:-12:6 --120000000:-12:7 --1200000000:-12:8 --12000000000:-12:9 --120000000000:-12:10 --1200000000000:-12:11 - --123:-123:0 --1230:-123:1 --12300:-123:2 --123000:-123:3 --1230000:-123:4 --12300000:-123:5 --123000000:-123:6 --1230000000:-123:7 --12300000000:-123:8 --123000000000:-123:9 --1230000000000:-123:10 - --1234:-1234:0 --12340:-1234:1 --123400:-1234:2 --1234000:-1234:3 --12340000:-1234:4 --123400000:-1234:5 --1234000000:-1234:6 --12340000000:-1234:7 --123400000000:-1234:8 --1234000000000:-1234:9 - --3141592:-3141592:0 diff --git a/cpan/Math-BigInt/t/sub_mbf.t b/cpan/Math-BigInt/t/sub_mbf.t index cf2788ea6b..242b947816 100644 --- a/cpan/Math-BigInt/t/sub_mbf.t +++ b/cpan/Math-BigInt/t/sub_mbf.t @@ -25,7 +25,7 @@ is($ms->{_custom}, 1, '$ms has custom attribute \$ms->{_custom}'); # Check that subclass is a Math::BigFloat, but not a Math::Bigint isa_ok($ms, 'Math::BigFloat'); ok(!$ms->isa('Math::BigInt'), - "An object of class '" . ref($ms) . "' isn't a 'Math::BigFloat'"); + "An object of class '" . ref($ms) . "' isn't a 'Math::BigInt'"); use Math::BigFloat; diff --git a/cpan/Math-BigInt/t/sub_mbi.t b/cpan/Math-BigInt/t/sub_mbi.t index d4553e8e5b..10fffd1f06 100644 --- a/cpan/Math-BigInt/t/sub_mbi.t +++ b/cpan/Math-BigInt/t/sub_mbi.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4280 # tests in require'd file +use Test::More tests => 4278 # tests in require'd file + 7; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/to_base-mbi.t b/cpan/Math-BigInt/t/to_base-mbi.t deleted file mode 100644 index 61f2ae7850..0000000000 --- a/cpan/Math-BigInt/t/to_base-mbi.t +++ /dev/null @@ -1,100 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 30; - -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 @in = split /:/; - my $out = pop @in; - - my ($x, $xo, $y); - my $test = qq|\$x = $class -> new("$in[0]");|; - $test .= qq| \$xo = \$x -> copy();|; - $test .= qq| \$y = \$x -> to_base($in[1]|; - $test .= qq|, "$in[2]"| if @in == 3; - $test .= qq|);|; - - eval $test; - #die $@ if $@; # this should never happen - die "\nThe following test died when eval()'ed. This indicates a ", - "broken test\n\n $test\n\nThe error message was\n\n $@\n" - if $@; - - subtest $test, sub { - plan tests => 2, - - is($x, $xo, "invocand object was not changed"); - is($y, $out, 'output arg has the right value'); - }; -} - -__END__ - -# Base 2 - -0:2:0 -1:2:1 -2:2:10 -0:2:ab:a -1:2:ab:b -2:2:ab:ba - -250:2:11111010 -250:2:01:11111010 - -# Base 8 - -250:8:372 -250:8:01234567:372 - -# Base 10 (in the last case, use a truncted collation sequence that does not -# include unused characters) - -250:10:250 -250:10:0123456789:250 -250:10:012345:250 - -# Base 16 - -250:16:FA -250:16:0123456789abcdef:fa -250:16:0123456789abcdef:fa - -# Base 3 - -250:3:100021 -250:3:012:100021 - -15:3:-/|:/|- - -# Base 4 - -250:4:3322 -250:4:0123:3322 - -# Base 5 - -250:5:2000 -250:5:01234:2000 -250:5:abcde:caaa - -# Other bases - -250:36:6Y - -250:37:6S - -16:3:121 -44027:36:XYZ -125734:62:Why diff --git a/cpan/Math-BigInt/t/to_base_num-mbi.t b/cpan/Math-BigInt/t/to_base_num-mbi.t deleted file mode 100644 index 821aefb896..0000000000 --- a/cpan/Math-BigInt/t/to_base_num-mbi.t +++ /dev/null @@ -1,63 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 14; - -my $class; - -BEGIN { $class = 'Math::BigInt'; } -BEGIN { use_ok($class); } - -# For simplicity, we use the same data in the test programs for to_base_num() and -# from_base_num(). - -my @data = - ( - [ 0, 2, [ 0 ] ], - [ 1, 2, [ 1 ] ], - [ 2, 2, [ 1, 0 ] ], - [ 3, 2, [ 1, 1, ] ], - [ 4, 2, [ 1, 0, 0 ] ], - - [ 0, 10, [ 0 ] ], - [ 1, 10, [ 1 ] ], - [ 12, 10, [ 1, 2 ] ], - [ 123, 10, [ 1, 2, 3 ] ], - [ 1230, 10, [ 1, 2, 3, 0 ] ], - - [ "123456789", 100, [ 1, 23, 45, 67, 89 ] ], - - [ "1234567890" x 3, - "987654321", - [ "128", "142745769", "763888804", "574845669" ]], - - [ "1234567890" x 5, - "987654321" x 3, - [ "12499999874843750102814", "447551941015330718793208596" ]], - ); - -for (my $i = 0 ; $i <= $#data ; ++ $i) { - my @in = ($data[$i][0], $data[$i][1]); - my $out = $data[$i][2]; - - my ($x, $xo, $y); - my $test = qq|\$x = $class -> new("$in[0]");|; - $test .= qq| \$xo = \$x -> copy();|; - $test .= qq| \$y = \$x -> to_base_num("$in[1]")|; - - eval $test; - die "\nThe following test died when eval()'ed. This indicates a ", - "broken test\n\n $test\n\nThe error message was\n\n $@\n" - if $@; - - subtest $test, sub { - plan tests => 4, - - is($x, $xo, "invocand object was not changed"); - is(ref($y), 'ARRAY', "output arg is an ARRAY ref"); - ok(! grep(ref() ne $class, @$y), "every array element is a $class"); - is_deeply($y, $out, 'every array element has the right value'); - }; -} diff --git a/cpan/Math-BigInt/t/to_ieee754-mbf.t b/cpan/Math-BigInt/t/to_ieee754-mbf.t deleted file mode 100644 index 9dbfa092cb..0000000000 --- a/cpan/Math-BigInt/t/to_ieee754-mbf.t +++ /dev/null @@ -1,303 +0,0 @@ -# -*- mode: perl; -*- - -use strict; -use warnings; - -use Test::More tests => 66; - -use Math::BigFloat; - -my @k = (16, 32, 64, 128); - -sub stringify { - my $x = shift; - return "$x" unless $x -> is_finite(); - my $nstr = $x -> bnstr(); - my $sstr = $x -> bsstr(); - return length($nstr) < length($sstr) ? $nstr : $sstr; -} - -for my $k (@k) { - - # Parameters specific to this format: - - my $b = 2; - my $p = $k == 16 ? 11 - : $k == 32 ? 24 - : $k == 64 ? 53 - : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13; - - $b = Math::BigFloat -> new($b); - $k = Math::BigFloat -> new($k); - $p = Math::BigFloat -> new($p); - my $w = $k - $p; - - my $emax = 2 ** ($w - 1) - 1; - my $emin = 1 - $emax; - - my $format = 'binary' . $k; - - note("\nComputing test data for k = $k ...\n\n"); - - my $binv = Math::BigFloat -> new("0.5"); - - my $data = - [ - - { - dsc => "smallest positive subnormal number", - bin => "0" - . ("0" x $w) - . ("0" x ($p - 2)) . "1", - asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") " - . "= $b ** (" . ($emin + 1 - $p) . ")", - mbf => $binv ** ($p - 1 - $emin), - }, - - { - dsc => "largest subnormal number", - bin => "0" - . ("0" x $w) - . ("1" x ($p - 1)), - asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))", - mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)), - }, - - { - dsc => "smallest positive normal number", - bin => "0" - . ("0" x ($w - 1)) . "1" - . ("0" x ($p - 1)), - asc => "$b ** ($emin)", - mbf => $binv ** (-$emin), - }, - - { - dsc => "largest normal number", - bin => "0" - . ("1" x ($w - 1)) . "0" - . "1" x ($p - 1), - asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))", - mbf => $b ** $emax * ($b - $binv ** ($p - 1)), - }, - - { - dsc => "largest number less than one", - bin => "0" - . "0" . ("1" x ($w - 2)) . "0" - . "1" x ($p - 1), - asc => "1 - $b ** (-$p)", - mbf => 1 - $binv ** $p, - }, - - { - dsc => "smallest number larger than one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . ("0" x ($p - 2)) . "1", - asc => "1 + $b ** (" . (1 - $p) . ")", - mbf => 1 + $binv ** ($p - 1), - }, - - { - dsc => "second smallest number larger than one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . ("0" x ($p - 3)) . "10", - asc => "1 + $b ** (" . (2 - $p) . ")", - mbf => 1 + $binv ** ($p - 2), - }, - - { - dsc => "one", - bin => "0" - . "0" . ("1" x ($w - 1)) - . "0" x ($p - 1), - asc => "1", - mbf => Math::BigFloat -> new("1"), - }, - - { - dsc => "minus one", - bin => "1" - . "0" . ("1" x ($w - 1)) - . "0" x ($p - 1), - asc => "-1", - mbf => Math::BigFloat -> new("-1"), - }, - - { - dsc => "two", - bin => "0" - . "1" . ("0" x ($w - 1)) - . ("0" x ($p - 1)), - asc => "2", - mbf => Math::BigFloat -> new("2"), - }, - - { - dsc => "minus two", - bin => "1" - . "1" . ("0" x ($w - 1)) - . ("0" x ($p - 1)), - asc => "-2", - mbf => Math::BigFloat -> new("-2"), - }, - - { - dsc => "positive zero", - bin => "0" - . ("0" x $w) - . ("0" x ($p - 1)), - asc => "+0", - mbf => Math::BigFloat -> new("0"), - }, - - { - dsc => "positive infinity", - bin => "0" - . ("1" x $w) - . ("0" x ($p - 1)), - asc => "+inf", - mbf => Math::BigFloat -> new("inf"), - }, - - { - dsc => "negative infinity", - bin => "1" - . ("1" x $w) - . ("0" x ($p - 1)), - asc => "-inf", - mbf => Math::BigFloat -> new("-inf"), - }, - - { - dsc => "NaN (encoding used by Perl on Cygwin)", - bin => "1" - . ("1" x $w) - . ("1" . ("0" x ($p - 2))), - asc => "NaN", - mbf => Math::BigFloat -> new("NaN"), - }, - - ]; - - for my $entry (@$data) { - my $bin = $entry -> {bin}; - my $bytes = pack "B*", $bin; - my $hex = unpack "H*", $bytes; - - note("\n", $entry -> {dsc}, " (k = $k): ", $entry -> {asc}, "\n\n"); - - my $x = $entry -> {mbf}; - - my $test = qq|Math::BigFloat -> new("| . stringify($x) - . qq|") -> to_ieee754("$format")|; - - my $got_bytes = $x -> to_ieee754($format); - my $got_hex = unpack "H*", $got_bytes; - $got_hex =~ s/(..)/\\x$1/g; - - my $expected_hex = $hex; - $expected_hex =~ s/(..)/\\x$1/g; - - is($got_hex, $expected_hex); - } -} - -# These tests verify fixing CPAN RT #139960. - -# binary16 - -{ - # largest subnormal number - my $lo = Math::BigFloat -> from_ieee754("03ff", "binary16"); - - # smallest normal number - my $hi = Math::BigFloat -> from_ieee754("0400", "binary16"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary16"); - is($got, "0400", - "6.102025508880615234375e-5 -> 0x0400"); -} - -{ - # largest number smaller than one - my $lo = Math::BigFloat -> from_ieee754("3bff", "binary16"); - - # one - my $hi = Math::BigFloat -> from_ieee754("3c00", "binary16"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary16"); - is($got, "3c00", "9.998779296875e-1 -> 0x3c00"); -} - -# binary32 - -{ - # largest subnormal number - my $lo = Math::BigFloat -> from_ieee754("007fffff", "binary32"); - - # smallest normal number - my $hi = Math::BigFloat -> from_ieee754("00800000", "binary32"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary32"); - is($got, "00800000", - "1.1754943157898258998483097641290060955707622747...e-38 -> 0x00800000"); -} - -{ - # largest number smaller than one - my $lo = Math::BigFloat -> from_ieee754("3f7fffff", "binary32"); - - # one - my $hi = Math::BigFloat -> from_ieee754("3f800000", "binary32"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary32"); - is($got, "3f800000", - "9.9999998509883880615234375e-1 -> 0x3f800000"); -} - -# binary64 - -{ - # largest subnormal number - my $lo = Math::BigFloat -> from_ieee754("000fffffffffffff", "binary64"); - - # smallest normal number - my $hi = Math::BigFloat -> from_ieee754("0010000000000000", "binary64"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary64"); - is($got, "0010000000000000", - "2.2250738585072012595738212570207680200...e-308 -> 0x0010000000000000"); -} - -{ - # largest number smaller than one - my $lo = Math::BigFloat -> from_ieee754("3fefffffffffffff", "binary64"); - - # one - my $hi = Math::BigFloat -> from_ieee754("3ff0000000000000", "binary64"); - - # compute an average weighted towards the larger of the two - my $x = 0.25 * $lo + 0.75 * $hi; - - my $got = unpack "H*", $x -> to_ieee754("binary64"); - is($got, "3ff0000000000000", - "9.999999999999999722444243843710864894092...e-1 -> 0x3ff0000000000000"); -} diff --git a/cpan/Math-BigInt/t/upgrade.inc b/cpan/Math-BigInt/t/upgrade.inc index 3cef71108d..d8bd119086 100644 --- a/cpan/Math-BigInt/t/upgrade.inc +++ b/cpan/Math-BigInt/t/upgrade.inc @@ -25,7 +25,7 @@ our ($CLASS, $LIB, $EXPECTED_CLASS); package Math::Foo; use Math::BigInt lib => $main::LIB; -our @ISA = (qw/Math::BigInt/); +our @ISA = ('Math::BigInt'); use overload # customized overload for sub, since original does not use swap there @@ -573,7 +573,7 @@ boneNaN:+:1 &binf 1:+:inf 2:-:-inf -3:abc:inf +3:+inf:inf &is_nan 123:0 @@ -620,14 +620,14 @@ abc:abc:NaN -1234:0:10:-1234 +1234:0:10:1234 +200:2:10:2 -+1234:3:10:1 -+1234:2:10:12 ++1234:3:10:1.234 ++1234:2:10:12.34 +1234:-3:10:NaN 310000:4:10:31 12300000:5:10:123 1230000000000:10:10:123 -09876123456789067890:12:10:9876123 -1234561234567890123:13:10:123456 +09876123456789067890:12:10:9876123.45678906789 +1234561234567890123:13:10:123456.1234567890123 &bsstr 1e+34:1e+34 diff --git a/cpan/Math-BigInt/t/upgrade.t b/cpan/Math-BigInt/t/upgrade.t index 94f7e8a0dc..132c9c5e9d 100644 --- a/cpan/Math-BigInt/t/upgrade.t +++ b/cpan/Math-BigInt/t/upgrade.t @@ -33,8 +33,8 @@ $EXPECTED_CLASS = "Math::BigFloat"; $LIB = "Math::BigInt::Calc"; # backend is(Math::BigInt->upgrade(), "Math::BigFloat", - qq/Math::BigInt->upgrade()/); -is(Math::BigInt->downgrade() || "", "", - qq/Math::BigInt->downgrade() || ""/); + "Math::BigInt->upgrade()"); +is(Math::BigInt->downgrade(), undef, + "Math::BigInt->downgrade()"); require './t/upgrade.inc'; # all tests here for sharing diff --git a/cpan/Math-BigInt/t/upgrade2.t b/cpan/Math-BigInt/t/upgrade2.t index 8b8c03691d..28ecdbb50b 100644 --- a/cpan/Math-BigInt/t/upgrade2.t +++ b/cpan/Math-BigInt/t/upgrade2.t @@ -12,6 +12,7 @@ use Math::BigFloat upgrade => 'Math::BigMouse'; no warnings 'once'; @Math::BigMouse::ISA = 'Math::BigFloat'; +sub Math::BigMouse::bsqrt {}; () = sqrt Math::BigInt->new(2); pass('sqrt on a big int does not segv if there are 2 upgrade levels'); |