diff options
Diffstat (limited to 'cpan')
188 files changed, 8590 insertions, 3072 deletions
diff --git a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm index 62dab0465d..f20c8eb1d8 100644 --- a/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm +++ b/cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm @@ -12,7 +12,7 @@ BEGIN { our @ISA = qw< Math::BigInt::Calc >; } -our $VERSION = '0.5010'; +our $VERSION = '0.5012'; my $MAX_EXP_F; # the maximum possible base 10 exponent with "no integer" my $MAX_EXP_I; # the maximum possible base 10 exponent with "use integer" @@ -200,7 +200,7 @@ the same terms as Perl itself. Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/> in late 2000. -Separated from BigInt and shaped API with the help of John Peacock. +Separated from Math::BigInt and shaped API with the help of John Peacock. Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003. Further streamlining (api_version 1 etc.) by Tels 2004-2007. diff --git a/cpan/Math-BigInt-FastCalc/t/bigintfc.t b/cpan/Math-BigInt-FastCalc/t/bigintfc.t index f8a39fc7ba..a7f27729be 100644 --- a/cpan/Math-BigInt-FastCalc/t/bigintfc.t +++ b/cpan/Math-BigInt-FastCalc/t/bigintfc.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test Math::BigInt::FastCalc @@ -14,7 +14,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc -> _base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt-FastCalc/t/biglog.t b/cpan/Math-BigInt-FastCalc/t/biglog.t index 7befc87c3d..18f959b39c 100644 --- a/cpan/Math-BigInt-FastCalc/t/biglog.t +++ b/cpan/Math-BigInt-FastCalc/t/biglog.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test blog function (and bpow, since it uses blog), as well as bexp(). diff --git a/cpan/Math-BigInt-FastCalc/t/bigroot.t b/cpan/Math-BigInt-FastCalc/t/bigroot.t index 076f02e7cb..2d8c8446e1 100644 --- a/cpan/Math-BigInt-FastCalc/t/bigroot.t +++ b/cpan/Math-BigInt-FastCalc/t/bigroot.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test broot function (and bsqrt() function, since it is used by broot()). diff --git a/cpan/Math-BigInt-FastCalc/t/bootstrap.t b/cpan/Math-BigInt-FastCalc/t/bootstrap.t index 6f94bebc88..153dc92b91 100644 --- a/cpan/Math-BigInt-FastCalc/t/bootstrap.t +++ b/cpan/Math-BigInt-FastCalc/t/bootstrap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +# -*- mode: perl; -*- use Test::More tests => 1; diff --git a/cpan/Math-BigInt-FastCalc/t/leak.t b/cpan/Math-BigInt-FastCalc/t/leak.t index 6d0f7464a5..58935ba759 100644 --- a/cpan/Math-BigInt-FastCalc/t/leak.t +++ b/cpan/Math-BigInt-FastCalc/t/leak.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +# -*- mode: perl; -*- # Test for memory leaks. diff --git a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t index 1186e2e144..1b4599e45b 100644 --- a/cpan/Math-BigInt-FastCalc/t/mbi_rand.t +++ b/cpan/Math-BigInt-FastCalc/t/mbi_rand.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 5dcc919e1a..b6d0bcbaf0 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -16,10 +16,11 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; -use Math::BigInt (); +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; +use Math::BigInt qw< >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw/Math::BigInt/; @@ -58,21 +59,21 @@ use overload # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -194,7 +195,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -360,52 +361,80 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; + # Make "require" work. + + $class -> import() if $IMPORT == 0; + + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. + + return $class -> bzero() unless @_; + my ($wanted, @r) = @_; - # avoid numify-calls by not using || on $wanted! + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); + } - unless (defined $wanted) { - #carp("Use of uninitialized value in new"); - return $self->bzero(@r); + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on + # Initialize a new object. + + $self = bless {}, $class unless $selfref; + + # The first following ought to work. However, it causes a 'Deep recursion on # subroutine "Math::BigFloat::as_number"' in some tests. Fixme! - if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) { - my $copy = $wanted -> copy(); - if ($selfref) { # if new() called as instance method - %$self = %$copy; - } else { # if new() called as class method - $self = $copy; - } - return $copy; + if (defined(blessed($wanted)) && $wanted -> isa('Math::BigFloat')) { + #if (defined(blessed($wanted)) && UNIVERSAL::isa($wanted, 'Math::BigFloat')) { + $self -> {sign} = $wanted -> {sign}; + $self -> {_m} = $LIB -> _copy($wanted -> {_m}); + $self -> {_es} = $wanted -> {_es}; + $self -> {_e} = $LIB -> _copy($wanted -> {_e}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $class->import() if $IMPORT == 0; # make require work - - # If called as a class method, initialize a new object. + # Shortcut for Math::BigInt and its subclasses. This should be improved. - $self = bless {}, $class unless $selfref; + if (defined(blessed($wanted))) { + if ($wanted -> isa('Math::BigInt')) { + $self->{sign} = $wanted -> {sign}; + $self->{_m} = $LIB -> _copy($wanted -> {value}); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } - # shortcut for bigints and its subclasses - if ((ref($wanted)) && $wanted -> can("as_number")) { - $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{sign} = $wanted->sign(); - return $self->bnorm(); + if ($wanted -> can("as_number")) { + $self->{sign} = $wanted -> sign(); + $self->{_m} = $wanted -> as_number() -> {value}; + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } } - # else: got a string or something masquerading as number (with overload) # Handle Infs. if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { return $downgrade->new($wanted) if $downgrade; my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $self->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). @@ -417,142 +446,119 @@ sub new { return $self; } - # Handle hexadecimal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0x", "0X", "x", or "X". + # Shortcut for simple forms like '123' that have no trailing zeros. - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); + if ($wanted =~ / ^ + \s* # optional leading whitespace + ( [+-]? ) # optional sign + 0* # optional leading zeros + ( [1-9] (?: [0-9]* [1-9] )? ) # significand + \s* # optional trailing whitespace + $ + /x) + { + return $downgrade->new($1 . $2) if $downgrade; + $self->{sign} = $1 || '+'; + $self->{_m} = $LIB -> _new($2); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; return $self; } - # Handle octal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0o", "0O", "o", or "O". If the prefix is just "0", the number must - # have a binary exponent, or else the number is interpreted as decimal. - - if ($wanted =~ / - ^ - \s* - - # sign - [+-]? - - (?: - # prefix - 0? [Oo] - | - - # prefix - 0 - - # significand using the octal digits 0..7 - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - - # exponent (power of 2) using decimal digits - [Pp] - [+-]? - \d+ (?: _ \d+ )* - \s* - $ - ) - /x) + my @parts; + + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) + + or + + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) + + or + + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) { - $self = $class -> from_oct($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } + # The value is an integer iff the exponent is non-negative. - # Handle binary numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0b", "0B", "b", or "B". + if ($parts[2] eq '+' && $downgrade) { + #return $downgrade->new($str, @r); + return $downgrade->new($wanted, @r); + } - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Shortcut for simple forms like '12' that have no trailing zeros. - if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) { - $self->{_e} = $LIB -> _zero(); - $self->{_es} = '+'; - $self->{sign} = $1 || '+'; - $self->{_m} = $LIB -> _new($2); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not an explicit Inf or a NaN either. - my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number initialized to $class"); - } + return $class -> bnan(); +} - return $downgrade->bnan() if $downgrade; +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{_m} = $LIB->_zero(); - $self->{sign} = $nan; - } else { - # make integer from mantissa by adjusting exp, then convert to int - $self->{_e} = $LIB->_new($$ev); # exponent - $self->{_es} = $$es || '+'; - my $mantissa = "$$miv$$mfv"; # create mant. - $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros - $self->{_m} = $LIB->_new($mantissa); # create mant. - - # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 - if (CORE::length($$mfv) != 0) { - my $len = $LIB->_new(CORE::length($$mfv)); - ($self->{_e}, $self->{_es}) = - _e_sub($self->{_e}, $len, $self->{_es}, '+'); - } - # we can only have trailing zeros on the mantissa if $$mfv eq '' - else { - # Use a regexp to count the trailing zeros in $$miv instead of - # _zeros() because that is faster, especially when _m is not stored - # in base 10. - my $zeros = 0; - $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; - if ($zeros != 0) { - my $z = $LIB->_new($zeros); - # turn '120e2' into '12e3' - $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10); - ($self->{_e}, $self->{_es}) = - _e_add($self->{_e}, $z, $self->{_es}, '+'); - } - } - $self->{sign} = $$mis; + # Don't modify constant (read-only) objects. - # for something like 0Ey, set y to 0, and -0 => +0 - # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not - # have become 0. That's faster than to call $LIB->_is_zero(). - $self->{sign} = '+', $self->{_e} = $LIB->_zero() - if $$miv eq '0' and $$mfv eq ''; + return if $selfref && $self->modify('from_dec'); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. - # if downgrade, inf, NaN or integers go down + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. - if ($downgrade && $self->{_es} eq '+') { - if ($LIB->_is_zero($self->{_e})) { - return $downgrade->new($$mis . $LIB->_str($self->{_m})); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade->new($str, @r); } - return $downgrade->new($self->bsstr()); + + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $self->bnorm(); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; + + return $self -> bnan(@r); } sub from_hex { @@ -565,85 +571,27 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional hexadecimal prefix - (?: 0? [Xx] )? - - # significand using the hex digits 0..9 and a..f - ( - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - (?: - \. - (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )? - )? - | - \. - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 16, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(16) / log(2) = 4. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("4"); - } + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_hex('0x' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_hex($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_oct { @@ -656,85 +604,27 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional octal prefix - (?: 0? [Oo] )? - - # significand using the octal digits 0..7 - ( - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - | - \. - [0-7]+ (?: _ [0-7]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 8, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(8) / log(2) = 3. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("3"); - } + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_oct($s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_oct($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_bin { @@ -747,82 +637,27 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional binary prefix - (?: 0? [Bb] )? - - # significand using the binary digits 0 and 1 - ( - [01]+ (?: _ [01]+ )* - (?: - \. - (?: [01]+ (?: _ [01]+ )* )? - )? - | - \. - [01]+ (?: _ [01]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx); - } + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_bin('0b' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_bin($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_ieee754 { @@ -839,6 +674,7 @@ sub from_ieee754 { my $enc; # significand encoding (applies only to decimal) my $k; # storage width in bits my $b; # base + my @r = @_; if ($format =~ /^binary(\d+)\z/) { $k = $1; @@ -907,7 +743,7 @@ sub from_ieee754 { unless (defined $in) { carp("Input is undefined"); - return $self -> bzero(); + return $self -> bzero(@r); } # Make sure input string is a string of zeros and ones. @@ -978,7 +814,7 @@ sub from_ieee754 { } else { $self = $x; } - return $self; + return $self -> round(@r); } croak("The format '$format' is not yet supported."); @@ -1208,7 +1044,7 @@ sub bpi { # we assume bpi() is called as a function. if (@_ == 0 && - (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i) + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) || !defined($self)) { @@ -1462,7 +1298,7 @@ sub bcmp { # Handle all 'nan' cases. - return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); + return if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); # Handle all '+inf' and '-inf' cases. @@ -1620,9 +1456,9 @@ sub bacmp { # handle +-inf and NaN's if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if ($x->is_inf() && $y->is_inf()); - return 1 if ($x->is_inf() && !$y->is_inf()); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if ($x->is_inf() && $y->is_inf()); + return 1 if ($x->is_inf() && !$y->is_inf()); return -1; } @@ -1825,6 +1661,7 @@ sub badd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($y->{_m}); @@ -1832,6 +1669,9 @@ sub badd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); + } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1844,6 +1684,8 @@ sub badd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign}); } # delete trailing zeros, then round @@ -1916,6 +1758,7 @@ sub bmul { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1953,6 +1796,7 @@ sub bmuladd { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1970,6 +1814,7 @@ sub bmuladd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($z->{_m}); @@ -1977,6 +1822,8 @@ sub bmuladd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1989,6 +1836,8 @@ sub bmuladd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $z->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign}); } # delete trailing zeros, then round @@ -2153,8 +2002,12 @@ sub bdiv { # correct exponent of $x ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); # correct for 10**scale ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+'); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+'); $x->bnorm(); # remove trailing 0's } } # end else $x != $y @@ -4685,58 +4538,96 @@ sub numify { sub import { my $class = shift; $IMPORT++; # remember we did import() + + my @import = ('objectify'); my @a; # unrecognized arguments - my $lib = ''; - my $lib_kind = 'try'; - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; + + # Enable overloading of constants. + + if ($param eq ':constant') { + overload::constant - if ($_[$i] eq ':constant') { - # This causes overlord er load to step in. 'binary' and 'integer' - # are handled by BigInt. - overload::constant float => sub { $class->new(shift); }; + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; + } + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; } - elsif ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i+1]; # or undef to disable - $i++; + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; } - elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] =~ /^(lib|try|only)\z/) { - # alternative library - $lib = $_[$i+1] || ''; - $lib_kind = $1; # "lib", "try", or "only" - $i++; + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { + push @import, $param; + push @import, shift() if @_; + next; } - elsif ($_[$i] eq 'with') { + if ($param eq 'with') { # alternative class for our private parts() # XXX: no longer supported - # $LIB = $_[$i+1] || 'Calc'; + # $LIB = shift() || 'Calc'; # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; - $i++; + shift; + next; } - else { - push @a, $_[$i]; - } + # Unrecognized parameter. + + push @a, $param; } - my @import = ('objectify'); - push @import, $lib_kind, $lib if $lib ne ''; Math::BigInt -> import(@import); # find out which one was actually loaded - $LIB = Math::BigInt->config('lib'); + $LIB = Math::BigInt -> config('lib'); $class->export_to_level(1, $class, @a); # export wanted functions } @@ -4998,7 +4889,8 @@ sub _log_10 { } ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 - + #($x->{_e}, $x->{_es}) = + # $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign); } # Now: 0.1 <= $x < 10 (and possible correction in l_10) @@ -5088,6 +4980,7 @@ sub _e_sub { # flip sign $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job } sub _pow { @@ -5386,7 +5279,8 @@ exactly what you expect. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents a floating point number. +like a number. Anything that is accepted by Perl as a literal numeric constant +should be accepted by this module. =over @@ -5403,19 +5297,22 @@ gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * @@ -5423,26 +5320,44 @@ If the string can not be interpreted, NaN is returned. =item * -For hexadecimal, octal, and binary numbers, the exponent must be separated from -the significand (mantissa) by the letter "p" or "P", not "e" or "E" as with -decimal numbers. +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + 0x1.921fb5p+1 3.14159262180328369140625e+0 0o1.2677025p1 2.71828174591064453125 01.2677025p1 2.71828174591064453125 @@ -5816,76 +5731,103 @@ C<as_number()>: $x = Math::BigFloat->new(2.5); $y = $x->as_number('odd'); # $y = 3 -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigFloat ':constant'> all the floating point constants -in the given scope are converted to C<Math::BigFloat>. This conversion -happens at compile time. +After C<use Math::BigFloat ':constant'> all numeric literals in the given scope +are converted to C<Math::BigFloat> objects. This conversion happens at compile +time. -In particular +For example, - perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' + perl -MMath::BigFloat=:constant -le 'print 2e-150' -prints the value of C<2E-100>. Note that without conversion of -constants the expression 2E-100 will be calculated as normal floating point -number. +prints the exact value of C<2e-150>. Note that without conversion of constants +the expression C<2e-150> is calculated using Perl scalars, which leads to an +inaccuracte result. -Please note that ':constant' does not affect integer constants, nor binary -nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to -work. +Note that strings are not affected, so that -=head2 Math library + use Math::BigFloat qw/:constant/; -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: + $y = "1234567890123456789012345678901234567890" + + "123456789123456789"; - use Math::BigFloat lib => 'Calc'; +does not give you what you expect. You need an explicit Math::BigFloat->new() +around at least one of the operands. You should also quote large constants to +prevent loss of precision: -You can change this by using: + use Math::BigFloat; - use Math::BigFloat lib => 'GMP'; + $x = Math::BigFloat->new("1234567889123456789123456789123456789"); -B<Note>: General purpose packages should not be explicit about the library -to use; let the script author decide which is best. +Without the quotes Perl converts the large number to a floating point constant +at compile time, and then converts the result to a Math::BigFloat object at +runtime, which results in an inaccurate result. -Note: The keyword 'lib' will warn when the requested library could not be -loaded. To suppress the warning use 'try' instead: +=head2 Hexadecimal, octal, and binary floating point literals - use Math::BigFloat try => 'GMP'; +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. -If your script works with huge numbers and Calc is too slow for them, -you can also for the loading of one of these libraries and if none -of them can be used, the code will die: +Hexadecimal floating point literals: - use Math::BigFloat only => 'GMP,Pari'; + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: +Octal floating point literals (with "0" prefix): - use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -See the respective low-level library documentation for further details. +Octal floating point literals (with "0o" prefix) (requires v5.34.0): -Please note that Math::BigFloat does B<not> use the denoted library itself, -but it merely passes the lib argument to Math::BigInt. So, instead of the need -to do: + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - use Math::BigInt lib => 'GMP'; - use Math::BigFloat; +Binary floating point literals: -you can roll it all into one line: + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 - use Math::BigFloat lib => 'GMP'; +=head2 Math library -It is also possible to just require Math::BigFloat: +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: - require Math::BigFloat; + use Math::BigFloat lib => "Calc"; + +You can change this by using: + + use Math::BigFloat lib => "GMP"; + +B<Note>: General purpose packages should not be explicit about the library to +use; let the script author decide which is best. -This will load the necessary things (like BigInt) when they are needed, and -automatically. +Note: The keyword 'lib' will warn when the requested library could not be +loaded. To suppress the warning use 'try' instead: + + use Math::BigFloat try => "GMP"; + +If your script works with huge numbers and Calc is too slow for them, you can +also for the loading of one of these libraries and if none of them can be used, +the code will die: + + use Math::BigFloat only => "GMP,Pari"; + +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigFloat lib => "Foo,Math::BigInt::Bar"; + +See the respective low-level library documentation for further details. -See L<Math::BigInt> for more details than you ever wanted to know about using -a different low-level library. +See L<Math::BigInt> for more details about using a different low-level library. =head2 Using Math::BigInt::Lite @@ -6072,8 +6014,7 @@ the same terms as Perl itself. L<Math::BigInt> and L<Math::BigInt> as well as the backends L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. -The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest -because they solve the autoupgrading/downgrading issue, at least partly. +The pragmas L<bignum>, L<bigint> and L<bigrat>. =head1 AUTHORS diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 82d289752e..84c4bcdcf4 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -20,9 +20,10 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw(Exporter); @@ -45,44 +46,44 @@ use overload '+' => sub { $_[0] -> copy() -> badd($_[1]); }, - '-' => sub { my $c = $_[0] -> copy; + '-' => sub { my $c = $_[0] -> copy(); $_[2] ? $c -> bneg() -> badd($_[1]) : $c -> bsub($_[1]); }, '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) - : $_[0] -> copy -> bdiv($_[1]); }, + : $_[0] -> copy() -> bdiv($_[1]); }, '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) - : $_[0] -> copy -> bmod($_[1]); }, + : $_[0] -> copy() -> bmod($_[1]); }, '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) - : $_[0] -> copy -> bpow($_[1]); }, + : $_[0] -> copy() -> bpow($_[1]); }, '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0]) - : $_[0] -> copy -> blsft($_[1]); }, + : $_[0] -> copy() -> blsft($_[1]); }, '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0]) - : $_[0] -> copy -> brsft($_[1]); }, + : $_[0] -> copy() -> brsft($_[1]); }, # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -116,13 +117,13 @@ use overload # overload key: str_comparison -# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) +# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) # : $_[0] -> bstrlt($_[1]); }, # # 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) # : $_[0] -> bstrle($_[1]); }, # -# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) +# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) # : $_[0] -> bstrgt($_[1]); }, # # 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) @@ -135,17 +136,17 @@ use overload # overload key: binary '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) - : $_[0] -> copy -> band($_[1]); }, + : $_[0] -> copy() -> band($_[1]); }, '&=' => sub { $_[0] -> band($_[1]); }, '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) - : $_[0] -> copy -> bior($_[1]); }, + : $_[0] -> copy() -> bior($_[1]); }, '|=' => sub { $_[0] -> bior($_[1]); }, '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) - : $_[0] -> copy -> bxor($_[1]); }, + : $_[0] -> copy() -> bxor($_[1]); }, '^=' => sub { $_[0] -> bxor($_[1]); }, @@ -182,9 +183,9 @@ use overload 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) : $_[0] -> copy() -> batan2($_[1]); }, - 'cos' => sub { $_[0] -> copy -> bcos(); }, + 'cos' => sub { $_[0] -> copy() -> bcos(); }, - 'sin' => sub { $_[0] -> copy -> bsin(); }, + 'sin' => sub { $_[0] -> copy() -> bsin(); }, 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, @@ -204,7 +205,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -228,11 +229,14 @@ our $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life +# Module to do the low level math. + my $DEFAULT_LIB = 'Math::BigInt::Calc'; -my $LIB; # module to do the low level math - # default is Calc.pm -my $IMPORT = 0; # was import() called yet? - # used to make require work +my $LIB; + +# Has import() been called yet? Needed to make "require" work. + +my $IMPORT = 0; ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -530,49 +534,54 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; - # The POD says: - # - # "Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') - # results in 'NaN'. This might change in the future, so use always the - # following explicit forms to get a zero or NaN: - # $zero = Math::BigInt->bzero(); - # $nan = Math::BigInt->bnan(); - # - # But although this use has been discouraged for more than 10 years, people - # apparently still use it, so we still support it. + # Make "require" work. - return $self->bzero() unless @_; + $class -> import() if $IMPORT == 0; - my ($wanted, $a, $p, $r) = @_; + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. - # Always return a new object, so if called as an instance method, copy the - # invocand, and if called as a class method, initialize a new object. + return $class -> bzero() unless @_; - $self = $selfref ? $self -> copy() - : bless {}, $class; + my ($wanted, @r) = @_; - unless (defined $wanted) { - #carp("Use of uninitialized value in new()"); - return $self->bzero($a, $p, $r); + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); } - if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass - # Using "$copy = $wanted -> copy()" here fails some tests. Fixme! - my $copy = $class -> copy($wanted); - if ($selfref) { - %$self = %$copy; - } else { - $self = $copy; - } - return $self; + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - $class->import() if $IMPORT == 0; # make require work + # Initialize a new object. + + $self = bless {}, $class; + + # Math::BigInt or subclass + + if (defined(blessed($wanted)) && $wanted -> isa($class)) { + + # We don't copy the accuracy and precision, because a new object should + # get them from the global configuration. + + $self -> {sign} = $wanted -> {sign}; + $self -> {value} = $LIB -> _copy($wanted -> {value}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; + } # Shortcut for non-zero scalar integers with no non-zero exponent. - if (!ref($wanted) && - $wanted =~ / ^ + if ($wanted =~ / ^ ([+-]?) # optional sign ([1-9][0-9]*) # non-zero significand (\.0*)? # ... with optional zero fraction @@ -584,16 +593,7 @@ sub new { my $abs = $2; $self->{sign} = $sgn || '+'; $self->{value} = $LIB->_new($abs); - - no strict 'refs'; - if (defined($a) || defined($p) - || defined(${"${class}::precision"}) - || defined(${"${class}::accuracy"})) - { - $self->round($a, $p, $r) - unless @_ >= 3 && !defined $a && !defined $p; - } - + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } @@ -601,123 +601,118 @@ sub new { if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $class->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { $self = $class -> bnan(); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they - # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + my @parts; - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). - # Handle octal numbers. We auto-detect octal numbers if they have a "0o", - # "0O", "o", "O" prefix, cf. CORE::oct(). + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) - if ($wanted =~ /^\s*[+-]?0?[Oo]/) { - $self = $class -> from_oct($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + or - # Handle binary numbers. We auto-detect binary numbers if they have a "0b", - # "B", "b", or "B" prefix, cf. CORE::oct(). + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) - # Split string into mantissa, exponent, integer, fraction, value, and sign. - my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number in $class"); - } - $self->{value} = $LIB->_zero(); - $self->{sign} = $nan; - return $self; - } + or - if (!ref $miv) { - # _from_hex or _from_bin - $self->{value} = $mis->{value}; - $self->{sign} = $mis->{sign}; - return $self; # throw away $mis - } + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). - # Make integer from mantissa by adjusting exponent, then convert to a - # Math::BigInt. - $self->{sign} = $$mis; # store sign - $self->{value} = $LIB->_zero(); # for all the NaN cases - my $e = int("$$es$$ev"); # exponent (avoid recursion) - if ($e > 0) { - my $diff = $e - CORE::length($$mfv); - if ($diff < 0) { # Not integer - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 1\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } else { # diff >= 0 - # adjust fraction and add it to value - #print "diff > 0 $$miv\n"; - $$miv = $$miv . ($$mfv . '0' x $diff); + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) + { + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } + + # If we get here, the value is a valid number, but it is not an integer. + + return $upgrade -> new($wanted, @r) if defined $upgrade; + return $class -> bnan(); } - else { - if ($$mfv ne '') { # e <= 0 - # fraction and negative/zero E => NOI - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 2 \$\$mfv '$$mfv'\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } elsif ($e < 0) { - # xE-y, and empty mfv - # Split the mantissa at the decimal point. E.g., if - # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123. - - my $frac = substr($$miv, $e); # $frac is fraction part - substr($$miv, $e) = ""; # $$miv is now integer part - - if ($frac =~ /[^0]/) { - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 3\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not explicit an Inf or a NaN either. + + return $class -> bnan(); +} + +# Create a Math::BigInt from a decimal string. This is an equivalent to +# from_hex(), from_oct(), and from_bin(). It is like new() except that it does +# not accept anything but a string representing a finite decimal number. + +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + # Don't modify constant (read-only) objects. + + return if $selfref && $self->modify('from_dec'); + + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. + + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); } - } - unless ($self->{sign} eq $nan) { - $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 - $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/; + return $upgrade -> new($str, @r) if defined $upgrade; } - # If any of the globals are set, use them to round, and store them inside - # $self. Do not round for new($x, undef, undef) since that is used by MBF - # to signal no rounding. - - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - $self; + return $self -> bnan(@r); } # Create a Math::BigInt from a hexadecimal string. @@ -732,48 +727,26 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Xx] )? - ( - [0-9a-fA-F]* - ( _ [0-9a-fA-F]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_hex('0x' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::hex() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from an octal string. @@ -788,48 +761,26 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Oo] )? - ( - [0-7]* - ( _ [0-7]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_oct('0' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::oct() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from a binary string. @@ -844,49 +795,26 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Bb] )? - ( - [01]* - ( _ [01]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_bin('0b' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # For consistency with from_hex() and from_oct(), we return NaN when the - # input is invalid. - - return $self->bnan(); - + return $self -> bnan(@r); } # Create a Math::BigInt from a byte string. @@ -904,13 +832,14 @@ sub from_bytes { unless $LIB->can('_from_bytes'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; $self -> {sign} = '+'; $self -> {value} = $LIB -> _from_bytes($str); - return $self; + return $self -> round(@r); } sub from_base { @@ -954,7 +883,7 @@ sub from_base { $self -> {sign} = '+'; $self -> {value} = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ()); - return $self + return $self; } sub from_base_num { @@ -983,6 +912,8 @@ sub from_base_num { my $base = shift; $base = $class -> new($base) unless ref($base) && $base -> isa($class); + my @r = @_; + # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; @@ -994,7 +925,7 @@ sub from_base_num { $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ], $base -> {value}); - return $self; + return $self -> round(@r); } sub bzero { @@ -1175,24 +1106,86 @@ sub bnan { $self -> {sign} = $nan; $self -> {value} = $LIB -> _zero(); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } + return $self; } sub bpi { - # Calculate PI to N digits. Unless upgrading is in effect, returns the - # result truncated to an integer, that is, always returns '3'. - my ($self, $n) = @_; - if (@_ == 1) { - # called like Math::BigInt::bpi(10); - $n = $self; - $self = __PACKAGE__; + + # Called as Argument list + # --------- ------------- + # Math::BigInt->bpi() ("Math::BigInt") + # Math::BigInt->bpi(10) ("Math::BigInt", 10) + # $x->bpi() ($x) + # $x->bpi(10) ($x, 10) + # Math::BigInt::bpi() () + # Math::BigInt::bpi(10) (10) + # + # In ambiguous cases, we favour the OO-style, so the following case + # + # $n = Math::BigInt->new("10"); + # $x = Math::BigInt->bpi($n); + # + # which gives an argument list with the single element $n, is resolved as + # + # $n->bpi(); + + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + my @r; # rounding paramters + + # If bpi() is called as a function ... + # + # This cludge is necessary because we still support bpi() as a function. If + # bpi() is called with either no argument or one argument, and that one + # argument is either undefined or a scalar that looks like a number, then + # we assume bpi() is called as a function. + + if (@_ == 0 && + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) + || + !defined($self)) + { + $r[0] = $self; + $class = __PACKAGE__; + $self = bless {}, $class; + } + + # ... or if bpi() is called as a method ... + + else { + @r = @_; + if ($selfref) { # bpi() called as instance method + return $self if $self -> modify('bpi'); + } else { # bpi() called as class method + $self = bless {}, $class; + } } - $self = ref($self) if ref($self); - return $upgrade->new($n) if defined $upgrade; + return $upgrade -> bpi(@r) if defined $upgrade; # hard-wired to "3" - $self->new(3); + $self -> {sign} = '+'; + $self -> {value} = $LIB -> _new("3"); + $self -> round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } sub copy { @@ -1344,8 +1337,8 @@ sub bcmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; @@ -1384,7 +1377,7 @@ sub bacmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; @@ -4137,9 +4130,13 @@ sub objectify { no strict 'refs'; - # What we upgrade to, if anything. + # What we upgrade to, if anything. Note that we need the whole chain of + # upgrading, because we accept objects that go through multiple upgrades, + # e.g., when Math::BigInt upgrades to Math::BigFloat which upgrades to + # Math::BigRat. We delay getting the chain until we actually need it. - my $up = ${"$a[0]::upgrade"}; + my @upg = (); + my $have_upgrade_chain = 0; # Disable downgrading, because Math::BigFloat -> foo('1.0', '2.0') needs # floats. @@ -4150,7 +4147,7 @@ sub objectify { ${"$a[0]::downgrade"} = undef; } - for my $i (1 .. $count) { + ARG: for my $i (1 .. $count) { my $ref = ref $a[$i]; @@ -4167,8 +4164,19 @@ sub objectify { # Upgrading is OK, so skip further tests if the argument is upgraded. - if (defined $up && $ref -> isa($up)) { - next; + unless ($have_upgrade_chain) { + my $cls = $class; + my $upg = $cls -> upgrade(); + while (defined $upg) { + push @upg, $upg; + $cls = $upg; + $upg = $cls -> upgrade(); + } + $have_upgrade_chain = 1; + } + + for my $upg (@upg) { + next ARG if $ref -> isa($upg); } # See if we can call one of the as_xxx() methods. We don't know whether @@ -4227,129 +4235,174 @@ sub import { my $class = shift; $IMPORT++; # remember we did import() my @a; # unrecognized arguments - my @libs; # backend libriaries - my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; # Enable overloading of constants. - if ($_[$i] eq ':constant') { + if ($param eq ':constant') { overload::constant - integer => sub { $class->new(shift) }, - binary => sub { $class->new(shift) }; + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; } - # Enable/disable upgrading. + # Upgrading. - elsif ($_[$i] eq 'upgrade') { - $upgrade = $_[$i+1]; # undef to disable - $i++; + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - # Use a user-specified backend libray. + # Downgrading. - elsif ($_[$i] =~ /^(lib|try|only)\z/) { + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; + } + + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { # try => 0 (no warn if unavailable module) # lib => 1 (warn on fallback) # only => 2 (die on fallback) - $warn_or_die = 1 if $_[$i] eq 'lib'; - $warn_or_die = 2 if $_[$i] eq 'only'; - - # Get and check the list of libraries. - - my $userlibs = $_[$i+1]; - croak "Library argument for import parameter '$_[$i]' is undefined" - unless defined($userlibs); - $userlibs =~ s/^\s+//; - $userlibs =~ s/\s+$//; - my @userlibs = split /\s*,\s*/, $userlibs; - carp "Argument for import parameter '$_[$i]' contains no libraries" - unless @userlibs; - - for my $lib (@userlibs) { - # Limit to sane characters. Should we warn about invalid - # characters, i.e., invalid module names? - $lib =~ tr/a-zA-Z0-9_://cd; - if (CORE::length $lib) { - $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; - push @libs, $lib; - next; - } - carp "Specified library name is empty or invalid"; - } - $i++; - } + # Get the list of user-specified libraries. - else { - push @a, $_[$i]; - } - } + croak "Library argument for import parameter '$param' is missing" + unless @_; + my $libs = shift; + croak "Library argument for import parameter '$param' is undefined" + unless defined($libs); - # Any non ':constant' stuff is handled by our parent, Exporter + # Check and clean up the list of user-specified libraries. - if (@a > 0) { - $class->SUPER::import(@a); # need it for subclasses - $class->export_to_level(1, $class, @a); # need it for MBF - } + my @libs; + for my $lib (split /,/, $libs) { + $lib =~ s/^\s+//; + $lib =~ s/\s+$//; - if (@libs) { + if ($lib =~ /[^a-zA-Z0-9_:]/) { + carp "Library name '$lib' contains invalid characters"; + next; + } - # Try to load the specified libraries, if any. + if (! CORE::length $lib) { + carp "Library name is empty"; + next; + } - my $numfail = 0; # increment for each lib that fails to load - for (my $i = 0 ; $i <= $#libs ; $i++) { - my $lib = $libs[$i]; - eval "require $lib"; - unless ($@) { - $LIB = $lib; - last; + $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; + + # If a library has already been loaded, that is OK only if the + # requested library is identical to the loaded one. + + if (defined($LIB)) { + if ($lib ne $LIB) { + #carp "Library '$LIB' has already been loaded, so", + # " ignoring requested library '$lib'"; + } + next; + } + + push @libs, $lib; } - $numfail++; - } - # All attempts to load a library failed. + next if defined $LIB; - if ($numfail == @libs) { + croak "Library list contains no valid libraries" unless @libs; - # The fallback library is either the most recently loaded library, - # or the default library, if no library has been successfully yet. + # Try to load the specified libraries, if any. - my $FALLBACK_LIB = defined($LIB) ? $LIB : $DEFAULT_LIB; + for (my $i = 0 ; $i <= $#libs ; $i++) { + my $lib = $libs[$i]; + eval "require $lib"; + unless ($@) { + $LIB = $lib; + last; + } + } + + next if defined $LIB; - # If the user requested a specific list of modules and didn't allow - # a fallback. + # No library has been loaded, and none of the requested libraries + # could be loaded, and fallback and the user doesn't allow fallback. - if ($warn_or_die == 2) { + if ($param eq 'only') { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", and fallback to '$FALLBACK_LIB' is disallowed"; + ", and fallback to '$DEFAULT_LIB' is not allowed"; } - # The user accepts the use of a fallback library, so try to load it. - # Note that it might already have been loaded successfully, but we - # don't know that, and there is minimal overhead in trying to load - # it again. + # No library has been loaded, and none of the requested libraries + # could be loaded, but the user accepts the use of a fallback + # library, so try to load it. - eval "require $FALLBACK_LIB"; + eval "require $DEFAULT_LIB"; if ($@) { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", not even the fallback lib '$FALLBACK_LIB'"; + ", not even the fallback lib '$DEFAULT_LIB'"; } - # The fallback library was successfully loaded, but the user might - # want to know that we are using the fallback. + # The fallback library was successfully loaded, but the user + # might want to know that we are using the fallback. - if ($warn_or_die == 1) { + if ($param eq 'lib') { carp "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", so using fallback lib '$FALLBACK_LIB'"; + ", so using fallback lib '$DEFAULT_LIB'"; } + + next; } + + # Unrecognized parameter. + + push @a, $param; + } + + # Any non-':constant' stuff is handled by our parent, Exporter + + if (@a) { + $class->SUPER::import(@a); # need it for subclasses + $class->export_to_level(1, $class, @a); # need it for Math::BigFlaot } # We might not have loaded any backend library yet, either because the user @@ -4368,79 +4421,6 @@ sub import { # import done } -sub _split_dec_string { - my $str = shift; - - if ($str =~ s/ - ^ - - # leading whitespace - ( \s* ) - - # optional sign - ( [+-]? ) - - # significand - ( - \d+ (?: _ \d+ )* - (?: - \. - (?: \d+ (?: _ \d+ )* )? - )? - | - \. - \d+ (?: _ \d+ )* - ) - - # optional exponent - (?: - [Ee] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - # trailing stuff - ( \D .*? )? - - \z - //x) { - my $leading = $1; - my $significand_sgn = $2 || '+'; - my $significand_abs = $3; - my $exponent_sgn = $4 || '+'; - my $exponent_abs = $5 || '0'; - my $trailing = $6; - - # Remove underscores and leading zeros. - - $significand_abs =~ tr/_//d; - $exponent_abs =~ tr/_//d; - - $significand_abs =~ s/^0+(.)/$1/; - $exponent_abs =~ s/^0+(.)/$1/; - - # If the significand contains a dot, remove it and adjust the exponent - # accordingly. E.g., "1234.56789e+3" -> "123456789e-2" - - my $idx = index $significand_abs, '.'; - if ($idx > -1) { - $significand_abs =~ s/0+\z//; - substr($significand_abs, $idx, 1) = ''; - my $exponent = $exponent_sgn . $exponent_abs; - $exponent .= $idx - CORE::length($significand_abs); - $exponent_abs = abs $exponent; - $exponent_sgn = $exponent < 0 ? '-' : '+'; - } - - return($leading, - $significand_sgn, $significand_abs, - $exponent_sgn, $exponent_abs, - $trailing); - } - - return undef; -} - sub _split { # input: num_str; output: undef for invalid or # (\$mantissa_sign, \$mantissa_value, \$mantissa_fraction, @@ -4508,6 +4488,49 @@ sub _split { return; # NaN, not a number } +sub _e_add { + # Internal helper sub to take two positive integers and their signs and + # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output + # ($LIB, ('+'|'-')). + + my ($x, $y, $xs, $ys) = @_; + + # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + if ($xs eq $ys) { + $x = $LIB->_add($x, $y); # +a + +b or -a + -b + } else { + my $a = $LIB->_acmp($x, $y); + if ($a == 0) { + # This does NOT modify $x in-place. TODO: Fix this? + $x = $LIB->_zero(); # result is 0 + $xs = '+'; + return ($x, $xs); + } + if ($a > 0) { + $x = $LIB->_sub($x, $y); # abs sub + } else { # a < 0 + $x = $LIB->_sub ($y, $x, 1); # abs sub + $xs = $ys; + } + } + + $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0" + + return ($x, $xs); +} + +sub _e_sub { + # Internal helper sub to take two positive integers and their signs and + # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), + # output ($LIB, ('+'|'-')) + my ($x, $y, $xs, $ys) = @_; + + # flip sign + $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... + _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job +} + sub _trailing_zeros { # return the amount of trailing zeros in $x (as scalar) my $x = shift; @@ -4596,6 +4619,635 @@ sub _find_round_parameters { ($self, $a, $p, $r); } +# Trims the sign of the significand, the (absolute value of the) significand, +# the sign of the exponent, and the (absolute value of the) exponent. The +# returned values have no underscores ("_") or unnecessary leading or trailing +# zeros. + +sub _trim_split_parts { + shift; + + my $sig_sgn = shift() || '+'; + my $sig_str = shift() || '0'; + my $exp_sgn = shift() || '+'; + my $exp_str = shift() || '0'; + + $sig_str =~ tr/_//d; # "1.0_0_0" -> "1.000" + $sig_str =~ s/^0+//; # "01.000" -> "1.000" + $sig_str =~ s/\.0*$// # "1.000" -> "1" + || $sig_str =~ s/(\..*[^0])0+$/$1/; # "1.010" -> "1.01" + $sig_str = '0' unless CORE::length($sig_str); + + return '+', '0', '+', '0' if $sig_str eq '0'; + + $exp_str =~ tr/_//d; # "01_234" -> "01234" + $exp_str =~ s/^0+//; # "01234" -> "1234" + $exp_str = '0' unless CORE::length($exp_str); + + return $sig_sgn, $sig_str, $exp_sgn, $exp_str; +} + +# Takes any string representing a valid decimal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. Both the +# significand and the exponent are in base 10. +# +# Perl accepts literals like the following. The value is 100.1. +# +# 1__0__.__0__1__e+0__1__ (prints "Misplaced _ in number") +# 1_0.0_1e+0_1 +# +# Strings representing decimal numbers do not allow underscores, so only the +# following is valid +# +# "10.01e+01" + +sub _dec_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # significand + ( + # integer part and optional fraction part ... + \d+ (?: _+ \d+ )* _* + (?: + \. + (?: _* \d+ (?: _+ \d+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + \d+ (?: _+ \d+ )* _* + ) + + # optional exponent + (?: + [Ee] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four strings: the sign of the significand, the absolute value of the +# significand, the sign of the exponent, and the absolute value of the exponent. +# The significand is in base 16, and the exponent is in base 2. +# +# Perl accepts literals like the following. The "x" might be a capital "X". The +# value is 32.0078125. +# +# 0x__1__0__.0__1__p+0__1__ (prints "Misplaced _ in number") +# 0x1_0.0_1p+0_1 +# +# The CORE::hex() function does not accept floating point accepts +# +# "0x_1_0" +# "x_1_0" +# "_1_0" + +sub _hex_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional hex prefix + (?: 0? [Xx] _* )? + + # significand using the hex digits 0..9 and a..f + ( + # integer part and optional fraction part ... + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + (?: + \. + (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid octal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 8, and the exponent is in base 2. + +sub _oct_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional octal prefix + (?: 0? [Oo] _* )? + + # significand using the octal digits 0..7 + ( + # integer part and optional fraction part ... + [0-7]+ (?: _+ [0-7]+ )* _* + (?: + \. + (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-7]+ (?: _+ [0-7]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid binary number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 2, and the exponent is in base 2. + +sub _bin_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional binary prefix + (?: 0? [Bb] _* )? + + # significand using the binary digits 0 and 1 + ( + # integer part and optional fraction part ... + [01]+ (?: _+ [01]+ )* _* + (?: + \. + (?: _* [01]+ (?: _+ [01]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [01]+ (?: _+ [01]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid decimal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _dec_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_; + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., + # + # 12.345e-2 -> 12345e-5 + # 12.345e+2 -> 12345e-1 + # 0.0123e+5 -> 00123e+1 -> 123e+1 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = length - index + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent. E.g., + # + # 12340e-5 -> 1234e-4 + # 12340e-1 -> 1234e0 + # 12340e+3 -> 1234e4 + + if ($sig_str =~ s/(0+)\z//) { + my $len = CORE::length($1); + ($exp_lib, $exp_sgn) = + $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+'); + } + + # At this point, the significand is empty or an integer with no trailing + # zeros. The exponent is in base 10. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $LIB -> _new($sig_str); + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_; + my $bpc_lib = $LIB -> _new($bpc); + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., with + # hexadecimal numbers + # + # 12.345p-2 -> 12345p-14 + # 12.345p+2 -> 12345p-10 + # 0.0123p+5 -> 00123p-11 -> 123p-11 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = (length - index) * bpc + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent accordingly. E.g., with hexadecimal numbers + # + # 12340p-5 -> 1234p-1 + # 12340p-1 -> 1234p+3 + # 12340p+3 -> 1234p+7 + + if ($sig_str =~ s/(0+)\z//) { + + # delta = length * bpc + my $delta = $LIB -> _new(CORE::length($1)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent + delta + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+'); + } + + # At this point, the significand is empty or an integer with no leading + # or trailing zeros. The exponent is in base 2. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str) + : $bpc == 3 ? $LIB -> _from_oct('0' . $sig_str) + : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str) + : die "internal error: invalid exponent multiplier"; + + # If the exponent (in base 2) is positive or zero ... + + if ($exp_sgn eq '+') { + + if (!$LIB -> _is_zero($exp_lib)) { + + # Multiply significand by 2 raised to the exponent. + + my $p = $LIB -> _pow($LIB -> _two(), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + $exp_lib = $LIB -> _zero(); + } + } + + # ... else if the exponent is negative ... + + else { + + # Rather than dividing the significand by 2 raised to the absolute + # value of the exponent, multiply the significand by 5 raised to the + # absolute value of the exponent and let the exponent be in base 10: + # + # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b + + my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + } + + # Adjust for the case when the conversion to decimal introduced trailing + # zeros in the significand. + + my $n = $LIB -> _zeros($sig_lib); + if ($n) { + $n = $LIB -> _new($n); + $sig_lib = $LIB -> _rsft($sig_lib, $n, 10); + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+'); + } + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four parts: the sign of the significand, the absolute value of the significand +# as a libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _hex_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 4); # 4 bits pr. chr + } + return; +} + +# Takes any string representing a valid octal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _oct_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 3); # 3 bits pr. chr + } + return; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 1); # 1 bit pr. chr + } + return; +} + +# Decimal string is split into the sign of the signficant, the absolute value of +# the significand as library thingy, the sign of the exponent, and the absolute +# value of the exponent as a a library thingy. + +sub _dec_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_str_parts($str)) { + return $class -> _dec_parts_to_lib_parts(@parts); + } + return; +} + +# Hexdecimal string to a string using decimal floating point notation. + +sub hex_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Octal string to a string using decimal floating point notation. + +sub oct_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Binary string to a string decimal floating point notation. + +sub bin_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Decimal string to a string using decimal floating point notation. + +sub dec_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Hexdecimal string to decimal notation (no exponent). + +sub hex_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Octal string to decimal notation (no exponent). + +sub oct_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Binary string to decimal notation (no exponent). + +sub bin_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Decimal string to decimal notation (no exponent). + +sub dec_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +sub _lib_parts_to_flt_str { + my $class = shift; + my @parts = @_; + return $parts[0] . $LIB -> _str($parts[1]) + . 'e' . $parts[2] . $LIB -> _str($parts[3]); +} + +sub _lib_parts_to_dec_str { + my $class = shift; + my @parts = @_; + + # The number is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + my $str = $parts[0] + . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10)); + return $str; + } + + # If it is not an integer, add a decimal point. + + else { + my $mant = $LIB -> _str($parts[1]); + my $mant_len = CORE::length($mant); + my $expo = $LIB -> _num($parts[3]); + my $len_cmp = $mant_len <=> $expo; + if ($len_cmp <= 0) { + return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant; + } else { + substr $mant, $mant_len - $expo, 0, '.'; + return $parts[0] . $mant; + } + } +} + ############################################################################### # this method returns 0 if the object can be modified, or 1 if not. # We use a fast constant sub() here, to avoid costly calls. Subclasses @@ -4815,7 +5467,9 @@ also provided for Perl operators. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents an integer. +like a number and represents an integer. Anything that is accepted by Perl as a +literal numeric constant should be accepted by this module, except that finite +non-integers return NaN. =over @@ -4825,57 +5479,86 @@ Leading and trailing whitespace is ignored. =item * -Leading zeros are ignored. +Leading zeros are ignored, except for floating point numbers with a binary +exponent, in which case the number is interpreted as an octal floating point +number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0" +gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * -If the string can not be interpreted, NaN is returned. +If the string can not be interpreted, or does not represent a finite integer, +NaN is returned. + +=item * + +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + Input given as scalar numbers might lose precision. Quote your input to ensure that no digits are lost: $x = Math::BigInt->new( 56789012345678901234 ); # bad $x = Math::BigInt->new('56789012345678901234'); # good -Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') -results in 'NaN'. This might change in the future, so use always the following -explicit forms to get a zero or NaN: +Currently, C<Math::BigInt->new()> (no input argument) and +C<Math::BigInt->new("")> return 0. This might change in the future, so always +use the following explicit forms to get a zero: $zero = Math::BigInt->bzero(); - $nan = Math::BigInt->bnan(); =head2 Output @@ -5059,6 +5742,13 @@ The input is accepted as decimal, hexadecimal (with leading '0x') or binary See L</Input> for more info on accepted input formats. +=item from_dec() + + $x = Math::BigInt->from_dec("314159"); # input is decimal + +Interpret input as a decimal. It is equivalent to new(), but does not accept +anything but strings representing finite, decimal numbers. + =item from_hex() $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal @@ -6213,6 +6903,94 @@ needed, for instance in array index operations. =back +=head2 Utility methods + +These utility methods are made public + +=over + +=item dec_str_to_dec_flt_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal floating point +notation. The output consists of five parts joined together: the sign of the +significand, the absolute value of the significand as the smallest possible +integer, the letter "e", the sign of the exponent, and the absolute value of the +exponent. If the input is invalid, nothing is returned. + + $str2 = $class -> dec_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 31400.00e-4 +314e-2 + -0.00012300e8 -123e+2 + 0 +0e+0 + +=item hex_str_to_dec_flt_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal floating +point notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> hex_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 0xff +255e+0 + +Some examples + +=item oct_str_to_dec_flt_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> oct_str_to_dec_flt_str($str1); + +=item bin_str_to_dec_flt_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> bin_str_to_dec_flt_str($str1); + +=item dec_str_to_dec_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal notation. If the +number represents an integer, the output consists of a sign and the absolute +value. If the number represents a non-integer, the output consists of a sign, +the integer part of the number, the decimal point ".", and the fraction part of +the number without any trailing zeros. If the input is invalid, nothing is +returned. + +=item hex_str_to_dec_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item oct_str_to_dec_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item bin_str_to_dec_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal notation. The output +has the same format as that of L</dec_str_to_dec_str()>. + +=back + =head1 ACCURACY and PRECISION Math::BigInt and Math::BigFloat have full support for accuracy and precision @@ -6613,8 +7391,8 @@ are much faster than the default library. =head3 The default library -The default library is L<Math::BigInt::Calc>, which is implemented in -pure Perl and hence does not require a compiler. +The default library is L<Math::BigInt::Calc>, which is implemented in pure Perl +and hence does not require a compiler. =head3 Specifying a library @@ -6637,8 +7415,8 @@ Multiple libraries can be specified by separating them by a comma, e.g., use Math::BigInt try => 'GMP,Pari'; -If you request a specific set of libraries and do not allow fallback, specify -them using "only", +If you request a specific set of libraries and do not allow fallback to the +default library, specify them using "only", use Math::BigInt only => 'GMP,Pari'; @@ -6652,34 +7430,16 @@ if this also fails, reverts to Math::BigInt::Calc: use Math::BigInt try => 'Foo,Math::BigInt::Bar'; -=head3 The fallback library - -The library that is used is the first library that was successfully loaded. The -fallback library is the most recent library that was successfully loaded, or the -default library, if no library has been successfully loaded. - -In the following example, assume "Pari" can be loaded, but "Foo" can't. Since -"Pari" can be loaded, it is used. Since "Foo" can't be loaded, "Pari" is used as -the fallback library, since it is the most recently successfully loaded library. - - use Math::BigInt; # "Calc" (default) is used - use Math::BigInt try => "Pari"; # "Pari" is used - use Math::BigFloat try => "Foo"; # fallback to "Pari" - -As shown, multiple libraries can be loaded, and the library in used can be -changed. However, all library loading should be done before any objects are -created. Mixing objects that use different backend libraries won't work. - -=head3 What library to use? +=head3 Which library to use? B<Note>: General purpose packages should not be explicit about the library to use; let the script author decide which is best. -L<Math::BigInt::GMP> and L<Math::BigInt::Pari> are in cases involving big -numbers much faster than L<Math::BigInt::Calc>. However it is slower when -dealing with very small numbers (less than about 20 digits) and when converting -very large numbers to decimal (for instance for printing, rounding, calculating -their length in decimal etc.). +L<Math::BigInt::GMP>, L<Math::BigInt::Pari>, and L<Math::BigInt::GMPz> are in +cases involving big numbers much faster than L<Math::BigInt::Calc>. However +these libraries are slower when dealing with very small numbers (less than about +20 digits) and when converting very large numbers to decimal (for instance for +printing, rounding, calculating their length in decimal etc.). So please select carefully what library you want to use. @@ -6689,6 +7449,16 @@ internal format. See the respective math library module documentation for further details. +=head3 Loading multiple libraries + +The first library that is successfully loaded is the one that will be used. Any +further attempts at loading a different module will be ignored. This is to avoid +the situation where module A requires math library X, and module B requires math +library Y, causing modules A and B to be incompatible. For example, + + use Math::BigInt; # loads default "Calc" + use Math::BigFloat only => "GMP"; # ignores "GMP" + =head2 SIGN The sign is either '+', '-', 'NaN', '+inf' or '-inf'. @@ -6749,49 +7519,69 @@ Examples for converting: my $x = Math::BigInt->new('0b1'.'01' x 123); print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal -and binary constants in the given scope are converted to C<Math::BigInt>. This -conversion happens at compile time. +After C<use Math::BigInt ':constant'> all numeric literals in the given scope +are converted to C<Math::BigInt> objects. This conversion happens at compile +time. Every non-integer is convert to a NaN. -In particular, +For example, - perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' + perl -MMath::BigInt=:constant -le 'print 2**150' -prints the integer value of C<2**100>. Note that without conversion of -constants the expression 2**100 is calculated using Perl scalars. +prints the exact value of C<2**150>. Note that without conversion of constants +to objects the expression C<2**150> is calculated using Perl scalars, which +leads to an inaccurate result. -Please note that strings and floating point constants are not affected, so that +Please note that strings are not affected, so that use Math::BigInt qw/:constant/; - $x = 1234567890123456789012345678901234567890 - + 123456789123456789; - $y = '1234567890123456789012345678901234567890' - + '123456789123456789'; + $x = "1234567890123456789012345678901234567890" + + "123456789123456789"; -does not give you what you expect. You need an explicit Math::BigInt->new() -around one of the operands. You should also quote large constants to protect +does give you what you expect. You need an explicit Math::BigInt->new() around +at least one of the operands. You should also quote large constants to prevent loss of precision: use Math::BigInt; - $x = Math::BigInt->new('1234567889123456789123456789123456789'); + $x = Math::BigInt->new("1234567889123456789123456789123456789"); + +Without the quotes Perl first converts the large number to a floating point +constant at compile time, and then converts the result to a Math::BigInt object +at run time, which results in an inaccurate result. + +=head2 Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. + +Hexadecimal floating point literals: + + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 + +Octal floating point literals (with "0" prefix): -Without the quotes Perl would convert the large number to a floating point -constant at compile time and then hand the result to Math::BigInt, which -results in an truncated result or a NaN. + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -This also applies to integers that look like floating point constants: +Octal floating point literals (with "0o" prefix) (requires v5.34.0): - use Math::BigInt ':constant'; + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - print ref(123e2),"\n"; - print ref(123.2e2),"\n"; +Binary floating point literals: -prints nothing but newlines. Use either L<bignum> or L<Math::BigFloat> to get -this to work. + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 =head1 PERFORMANCE diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 61a5f63acd..1269f644bf 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -7,7 +7,7 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; our @ISA = ('Math::BigInt::Lib'); @@ -87,7 +87,8 @@ sub config { } sub _base_len { - my $class = shift; + #my $class = shift; # $class is not used + shift; if (@_) { # if called as setter ... my ($base_len, $use_int) = @_; @@ -402,10 +403,10 @@ sub _add { # For each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry. Trades one # "$j++" for having to shift arrays. - my $i; + my $car = 0; my $j = 0; - for $i (@$y) { + for my $i (@$y) { $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0; $j++; } @@ -451,10 +452,9 @@ sub _sub { my ($c, $sx, $sy, $s) = @_; my $car = 0; - my $i; my $j = 0; if (!$s) { - for $i (@$sx) { + for my $i (@$sx) { last unless defined $sy->[$j] || $car; $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++; @@ -462,7 +462,7 @@ sub _sub { # might leave leading zeros, so fix that return __strip_zeros($sx); } - for $i (@$sx) { + for my $i (@$sx) { # We can't do an early out if $x < $y, since we need to copy the high # chunks from $y. Found by Bob Mathews. #last unless defined $sy->[$j] || $car; @@ -517,13 +517,13 @@ sub _mul_use_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } @@ -578,13 +578,13 @@ sub _mul_no_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $rem, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $rem, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $rem = $prod % $BASE; $car = ($prod - $rem) / $BASE; @@ -2127,7 +2127,7 @@ sub _as_oct { my $x1 = $c->_copy($x); - my $x1000 = [ 0100000 ]; + my $x1000 = [ 1 << 15 ]; # 15 bits = 32768 = 0100000 my $es = ''; my $xr; @@ -2143,7 +2143,7 @@ sub _from_oct { # convert a octal number to decimal (string, return ref to array) my ($c, $os) = @_; - my $m = $c->_new(010000000000); # 30 bits at a time (<32 bits!) + my $m = $c->_new(1 << 30); # 30 bits at a time (<32 bits!) my $d = 10; # 10 octal digits at a time my $mul = $c->_one(); @@ -2219,7 +2219,7 @@ sub _modinv { # modulo zero if ($c->_is_zero($y)) { - return undef, undef; + return; } # modulo one @@ -2250,7 +2250,7 @@ sub _modinv { } # if the gcd is not 1, then return NaN - return (undef, undef) unless $c->_is_one($a); + return unless $c->_is_one($a); ($v, $sign == 1 ? '+' : '-'); } @@ -2393,6 +2393,27 @@ together with 'use_int', the current value for the base length is used. =back +=head1 METHODS + +This overview constains only the methods that are specific to +C<Math::BigInt::Calc>. For the other methods, see L<Math::BigInt::Lib>. + +=over 4 + +=item _base_len() + +Specify the desired base length and whether to enable "use integer" in the +computations. + + Math::BigInt::Calc -> _base_len($base_len, $use_int); + +Note that it is better to specify the base length and whether to use integers as +options when the module is loaded, for example like this + + use Math::BigInt::Calc base_len => 6, use_int => 1; + +=back + =head1 SEE ALSO L<Math::BigInt::Lib> for a description of the API. diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm index ee5577c6dd..ac570af3f1 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; use Carp; @@ -352,6 +352,56 @@ sub _dec { $class -> _sub($x, $class -> _one()); } +# Signed addition. If the flag is false, $xa might be modified, but not $ya. If +# the false is true, $ya might be modified, but not $xa. + +sub _sadd { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + my ($za, $zs); + + # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + + if ($xs eq $ys) { + if ($flag) { + $za = $class -> _add($ya, $xa); + } else { + $za = $class -> _add($xa, $ya); + } + $zs = $class -> _is_zero($za) ? '+' : $xs; + return $za, $zs; + } + + my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y) + + if ($acmp == 0) { # x = -y or -x = y + $za = $class -> _zero(); + $zs = '+'; + return $za, $zs; + } + + if ($acmp > 0) { # abs(x) > abs(y) + $za = $class -> _sub($xa, $ya, $flag); + $zs = $xs; + } else { # abs(x) < abs(y) + $za = $class -> _sub($ya, $xa, !$flag); + $zs = $ys; + } + return $za, $zs; +} + +# Signed subtraction. If the flag is false, $xa might be modified, but not $ya. +# If the false is true, $ya might be modified, but not $xa. + +sub _ssub { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + + # Swap sign of second operand and let _sadd() do the job. + $ys = $ys eq '+' ? '-' : '+'; + $class -> _sadd($xa, $xs, $ya, $ys, $flag); +} + ############################################################################## # testing @@ -2140,24 +2190,38 @@ arbitrarily large. =item CLASS-E<gt>_add(OBJ1, OBJ2) -Returns the result of adding OBJ2 to OBJ1. +Addition. Returns the result of adding OBJ2 to OBJ1. =item CLASS-E<gt>_mul(OBJ1, OBJ2) -Returns the result of multiplying OBJ2 and OBJ1. +Multiplication. Returns the result of multiplying OBJ2 and OBJ1. =item CLASS-E<gt>_div(OBJ1, OBJ2) -In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and -truncating the result to an integer. In list context, return the quotient and -the remainder. +Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2 +and truncating the result to an integer. In list context, return the quotient +and the remainder. =item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG) =item CLASS-E<gt>_sub(OBJ1, OBJ2) -Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted, -OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. +Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false +or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. + +=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with +sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); + +=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to +OBJ1 with sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); =item CLASS-E<gt>_dec(OBJ) diff --git a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm index c9ec01e129..9955f205dc 100644 --- a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm +++ b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # for testing subclassing Math::BigFloat diff --git a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm index c6ef25d2f1..30e1a14fdf 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::BareCalc; @@ -12,6 +12,7 @@ our $VERSION = '1.999803'; use Math::BigInt::Calc 1.9998; our @ISA = qw(Math::BigInt::Calc); -print "# BareCalc using Calc v", Math::BigInt::Calc -> VERSION, "\n"; +print "# Math::BigInt::BareCalc v", $VERSION, " using", + " Math::BigInt::Calc v", Math::BigInt::Calc -> VERSION, "\n"; 1; diff --git a/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm index cb24e25ac5..5ff98bf19a 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Lib::TestUtil; diff --git a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm index 5acdf1c24d..56b5e509dd 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Subclass; diff --git a/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t b/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t new file mode 100644 index 0000000000..67edea9bf3 --- /dev/null +++ b/cpan/Math-BigInt/t/_bin_parts_to_lib_parts.t @@ -0,0 +1,88 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 36; + +use Math::BigInt; + +my $LIB = Math::BigInt -> config('lib'); + +sub try { + my ($in0, $in1, $in2, $in3, $in4, $out0, $out1, $out2, $out3) = @_; + + my @out; + my $test = q|@out = Math::BigInt -> _bin_parts_to_lib_parts| + . qq|("$in0", "$in1", "$in2", "$in3", $in4)|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 5; + + is(scalar(@out), 4, 'number of output arguments'); + is($out[0], $out0, 'sign of the significand'); + is($LIB -> _str($out[1]), $out1, 'absolute value of the significand'); + is($out[2], $out2, 'sign of the exponent'); + is($LIB -> _str($out[3]), $out3, 'absolute value of the exponent'); + }; +} + +note("binary"); + +try qw< + 0 + 0 >, 1, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 1, qw< + 0 + 0 >; + +try qw< + 1010 + 0 >, 1, qw< + 1 + 1 >; +try qw< + 1111 + 0 >, 1, qw< + 15 + 0 >; +try qw< + 0.1 + 0 >, 1, qw< + 5 - 1 >; + +try qw< + 10 - 8 >, 1, qw< + 78125 - 7 >; +try qw< + 10 + 8 >, 1, qw< + 512 + 0 >; + +try qw< + 11000000001100 - 0 >, 1, qw< + 123 + 2 >; +try qw< + 1100000000110000 - 2 >, 1, qw< + 123 + 2 >; + +try qw< + .00110011 + 5 >, 1, qw< + 6375 - 3 >; + +try qw< - 1100.0011 + 2 >, 1, qw< - 4875 - 2 >; + +note("octal"); + +try qw< + 0 + 0 >, 3, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 3, qw< + 0 + 0 >; +try qw< + 12 + 0 >, 3, qw< + 1 + 1 >; +try qw< + 17 + 0 >, 3, qw< + 15 + 0 >; +try qw< + 0.4 + 0 >, 3, qw< + 5 - 1 >; +try qw< + 2 - 8 >, 3, qw< + 78125 - 7 >; +try qw< + 2 + 8 >, 3, qw< + 512 + 0 >; +try qw< + 30014 - 0 >, 3, qw< + 123 + 2 >; +try qw< + 14006 + 1 >, 3, qw< + 123 + 2 >; +try qw< + 12300 + 0 >, 3, qw< + 5312 + 0 >; + +note("hexadecimal"); + +try qw< + 0 + 0 >, 4, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, 4, qw< + 0 + 0 >; + +try qw< + a + 0 >, 4, qw< + 1 + 1 >; +try qw< + f + 0 >, 4, qw< + 15 + 0 >; +try qw< + 0.8 + 0 >, 4, qw< + 5 - 1 >; + +try qw< + 2 - 8 >, 4, qw< + 78125 - 7 >; +try qw< + 2 + 8 >, 4, qw< + 512 + 0 >; + +try qw< + 300c - 0 >, 4, qw< + 123 + 2 >; +try qw< + 1.806 + 13 >, 4, qw< + 123 + 2 >; +try qw< + c030 - 2 >, 4, qw< + 123 + 2 >; + +try qw< + 0.0625 + 16 >, 4, qw< + 1573 + 0 >; + +try qw< + .0123 + 0 >, 4, qw< + 44403076171875 - 16 >; +try qw< + 12300 + 0 >, 4, qw< + 74496 + 0 >; + +try qw< + .00120034 + 5 >, 4, qw< + 87894499301910400390625 - 25 >; + +try qw< - 1200.0034 + 2 >, 4, qw< - 18432003173828125 - 12 >; diff --git a/cpan/Math-BigInt/t/_bin_str_to_str_parts.t b/cpan/Math-BigInt/t/_bin_str_to_str_parts.t new file mode 100644 index 0000000000..f8faa76fc9 --- /dev/null +++ b/cpan/Math-BigInt/t/_bin_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _bin_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0110:+:.011:+:0 +0110.0:+:110:+:0 +0110.0110:+:110.011:+:0 + +0b1.p0:+:1:+:0 + +00.0011001100P0056007800:+:.00110011:+:56007800 + ++1__1__.__1__1__p+5__6__:+:11.11:+:56 ++1__1__.__1__1__p-5__6__:+:11.11:-:56 +-1__1__.__1__1__p+5__6__:-:11.11:+:56 +-1__1__.__1__1__p-5__6__:-:11.11:-:56 + +1__1__.__1__1__p5__6__:+:11.11:+:56 +1__1__.__1__1__p-5__6__:+:11.11:-:56 +-1__1__.__1__1__p5__6__:-:11.11:+:56 + +-0b__1__1__.__1__1__p-1__1__:-:11.11:-:11 +-0B__1__1__.__1__1__P-1__1__:-:11.11:-:11 diff --git a/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t b/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t new file mode 100644 index 0000000000..dd4f4a4137 --- /dev/null +++ b/cpan/Math-BigInt/t/_dec_parts_to_lib_parts.t @@ -0,0 +1,69 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 30; + +use Math::BigInt; + +my $LIB = Math::BigInt -> config('lib'); + +sub try { + my ($in0, $in1, $in2, $in3, $out0, $out1, $out2, $out3) = @_; + + my @out; + my $test = q|@out = Math::BigInt -> _dec_parts_to_lib_parts| + . qq|("$in0", "$in1", "$in2", "$in3")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 5; + + is(scalar(@out), 4, 'number of output arguments'); + is($out[0], $out0, 'sign of the significand'); + is($LIB -> _str($out[1]), $out1, 'absolute value of the significand'); + is($out[2], $out2, 'sign of the exponent'); + is($LIB -> _str($out[3]), $out3, 'absolute value of the exponent'); + }; +} + +try qw< + 0 + 0 >, qw< + 0 + 0 >; +try qw< + 00.000 - 0000 >, qw< + 0 + 0 >; + +try qw< + 0.01230 + 5 >, qw< + 123 + 1 >; +try qw< + 0.1230 + 5 >, qw< + 123 + 2 >; +try qw< + 1.230 + 5 >, qw< + 123 + 3 >; +try qw< + 12.30 + 5 >, qw< + 123 + 4 >; +try qw< + 123.0 + 5 >, qw< + 123 + 5 >; +try qw< + 1230.0 + 5 >, qw< + 123 + 6 >; + +try qw< + 0.01230 + 2 >, qw< + 123 - 2 >; +try qw< + 0.1230 + 2 >, qw< + 123 - 1 >; +try qw< + 1.230 + 2 >, qw< + 123 + 0 >; +try qw< + 12.30 + 2 >, qw< + 123 + 1 >; +try qw< + 123.0 + 2 >, qw< + 123 + 2 >; +try qw< + 1230.0 + 2 >, qw< + 123 + 3 >; + +try qw< + 0.01230 - 2 >, qw< + 123 - 6 >; +try qw< + 0.1230 - 2 >, qw< + 123 - 5 >; +try qw< + 1.230 - 2 >, qw< + 123 - 4 >; +try qw< + 12.30 - 2 >, qw< + 123 - 3 >; +try qw< + 123.0 - 2 >, qw< + 123 - 2 >; +try qw< + 1230.0 - 2 >, qw< + 123 - 1 >; + +try qw< + 0.01230 - 4 >, qw< + 123 - 8 >; +try qw< + 0.1230 - 4 >, qw< + 123 - 7 >; +try qw< + 1.230 - 4 >, qw< + 123 - 6 >; +try qw< + 12.30 - 4 >, qw< + 123 - 5 >; +try qw< + 123.0 - 4 >, qw< + 123 - 4 >; +try qw< + 1230.0 - 4 >, qw< + 123 - 3 >; + +try qw< + .0123 + 0 >, qw< + 123 - 4 >; +try qw< + 12300 + 0 >, qw< + 123 + 2 >; + +try qw< + .00120034 + 5 >, qw< + 120034 - 3 >; + +try qw< - 1200.0034 + 2 >, qw< - 12000034 - 2 >; diff --git a/cpan/Math-BigInt/t/_dec_str_to_str_parts.t b/cpan/Math-BigInt/t/_dec_str_to_str_parts.t new file mode 100644 index 0000000000..d94d8cd464 --- /dev/null +++ b/cpan/Math-BigInt/t/_dec_str_to_str_parts.t @@ -0,0 +1,57 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 16; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _dec_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0e-0:+:0:+:0 +0e-7:+:0:+:0 +0e+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +1.e0:+:1:+:0 + +00.0012003400E0056007800:+:.00120034:+:56007800 + ++1__2__.__3__4__e+5__6__:+:12.34:+:56 ++1__2__.__3__4__e-5__6__:+:12.34:-:56 +-1__2__.__3__4__e+5__6__:-:12.34:+:56 +-1__2__.__3__4__e-5__6__:-:12.34:-:56 + +1__2__.__3__4__e5__6__:+:12.34:+:56 +1__2__.__3__4__e-5__6__:+:12.34:-:56 +-1__2__.__3__4__e5__6__:-:12.34:+:56 diff --git a/cpan/Math-BigInt/t/_e_math.t b/cpan/Math-BigInt/t/_e_math.t index 1c136a565e..3cf917bb01 100644 --- a/cpan/Math-BigInt/t/_e_math.t +++ b/cpan/Math-BigInt/t/_e_math.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test the helper math routines in Math::BigFloat diff --git a/cpan/Math-BigInt/t/_hex_str_to_str_parts.t b/cpan/Math-BigInt/t/_hex_str_to_str_parts.t new file mode 100644 index 0000000000..02bdd1345a --- /dev/null +++ b/cpan/Math-BigInt/t/_hex_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _hex_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +0x1.p0:+:1:+:0 + +00.0012003400P0056007800:+:.00120034:+:56007800 + ++1__2__.__3__4__p+5__6__:+:12.34:+:56 ++1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p+5__6__:-:12.34:+:56 +-1__2__.__3__4__p-5__6__:-:12.34:-:56 + +1__2__.__3__4__p5__6__:+:12.34:+:56 +1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p5__6__:-:12.34:+:56 + +-0x__a__b__.__c__d__p-1__2__:-:ab.cd:-:12 +-0X__A__B__.__C__D__P-1__2__:-:AB.CD:-:12 diff --git a/cpan/Math-BigInt/t/_oct_str_to_str_parts.t b/cpan/Math-BigInt/t/_oct_str_to_str_parts.t new file mode 100644 index 0000000000..c6431f261c --- /dev/null +++ b/cpan/Math-BigInt/t/_oct_str_to_str_parts.t @@ -0,0 +1,58 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 18; + +use Math::BigInt; + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0, $out1, $out2, $out3) = split /:/; + my ($ss, $sa, $es, $ea); + + my $test = q|($ss, $sa, $es, $ea) = | + . qq|Math::BigInt -> _oct_str_to_str_parts("$in0")|; + + eval $test; + die $@ if $@; # this should never happen + + subtest $test => sub { + plan tests => 4; + is($ss, $out0, 'sign of the significand'); + is($sa, $out1, 'absolute value of the significand'); + is($es, $out2, 'sign of the exponent'); + is($ea, $out3, 'absolute value of the exponent'); + }; +} + +__DATA__ + +0:+:0:+:0 +0p-0:+:0:+:0 +0p-7:+:0:+:0 +0p+7:+:0:+:0 + +0.0120:+:.012:+:0 +0120.0:+:120:+:0 +0120.0340:+:120.034:+:0 + +01.p0:+:1:+:0 + +00.0012003400P0056007800:+:.00120034:+:56007800 + ++0__1__2__.__3__4__p+5__6__:+:12.34:+:56 ++0__1__2__.__3__4__p-5__6__:+:12.34:-:56 +-0__1__2__.__3__4__p+5__6__:-:12.34:+:56 +-0__1__2__.__3__4__p-5__6__:-:12.34:-:56 + +01__2__.__3__4__p5__6__:+:12.34:+:56 +1__2__.__3__4__p-5__6__:+:12.34:-:56 +-1__2__.__3__4__p5__6__:-:12.34:+:56 + +-0o__1__2__.__3__4__p-5__6__:-:12.34:-:56 +-0O__1__2__.__3__4__P-5__6__:-:12.34:-:56 diff --git a/cpan/Math-BigInt/t/alias.inc b/cpan/Math-BigInt/t/alias.inc index 3b381e18e2..a3f3857fc9 100644 --- a/cpan/Math-BigInt/t/alias.inc +++ b/cpan/Math-BigInt/t/alias.inc @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/backermann-mbi.t b/cpan/Math-BigInt/t/backermann-mbi.t index 45fcac6dbd..cc32dd1df0 100644 --- a/cpan/Math-BigInt/t/backermann-mbi.t +++ b/cpan/Math-BigInt/t/backermann-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bare_mbf.t b/cpan/Math-BigInt/t/bare_mbf.t index 7c1a121454..3d94a6cb07 100644 --- a/cpan/Math-BigInt/t/bare_mbf.t +++ b/cpan/Math-BigInt/t/bare_mbf.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076; +use Test::More tests => 3070; use lib 't'; diff --git a/cpan/Math-BigInt/t/bare_mbi.t b/cpan/Math-BigInt/t/bare_mbi.t index 3ab9f991bb..f3509cfa45 100644 --- a/cpan/Math-BigInt/t/bare_mbi.t +++ b/cpan/Math-BigInt/t/bare_mbi.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292; # tests in require'd file +use Test::More tests => 4280; # tests in require'd file use lib 't'; diff --git a/cpan/Math-BigInt/t/bare_mif.t b/cpan/Math-BigInt/t/bare_mif.t index 3946d1524a..ed2c27cf36 100644 --- a/cpan/Math-BigInt/t/bare_mif.t +++ b/cpan/Math-BigInt/t/bare_mif.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes under Math::BigInt::BareCalc diff --git a/cpan/Math-BigInt/t/bdigitsum-mbi.t b/cpan/Math-BigInt/t/bdigitsum-mbi.t index 45c9bd7256..0991191317 100644 --- a/cpan/Math-BigInt/t/bdigitsum-mbi.t +++ b/cpan/Math-BigInt/t/bdigitsum-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bdstr-mbf.t b/cpan/Math-BigInt/t/bdstr-mbf.t index 8b13bd4403..950ae6f279 100644 --- a/cpan/Math-BigInt/t/bdstr-mbf.t +++ b/cpan/Math-BigInt/t/bdstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bdstr-mbi.t b/cpan/Math-BigInt/t/bdstr-mbi.t index d369ec9f8f..68671619cf 100644 --- a/cpan/Math-BigInt/t/bdstr-mbi.t +++ b/cpan/Math-BigInt/t/bdstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bestr-mbf.t b/cpan/Math-BigInt/t/bestr-mbf.t index fcb11078b3..12277a5272 100644 --- a/cpan/Math-BigInt/t/bestr-mbf.t +++ b/cpan/Math-BigInt/t/bestr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bestr-mbi.t b/cpan/Math-BigInt/t/bestr-mbi.t index 1d391d4e35..8c4c0bd518 100644 --- a/cpan/Math-BigInt/t/bestr-mbi.t +++ b/cpan/Math-BigInt/t/bestr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bfib-mbi.t b/cpan/Math-BigInt/t/bfib-mbi.t index 3b24eca823..91e7aafad5 100644 --- a/cpan/Math-BigInt/t/bfib-mbi.t +++ b/cpan/Math-BigInt/t/bfib-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/big_pi_e.t b/cpan/Math-BigInt/t/big_pi_e.t index 66705da1ae..8e2aa11281 100644 --- a/cpan/Math-BigInt/t/big_pi_e.t +++ b/cpan/Math-BigInt/t/big_pi_e.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test bpi() and bexp() diff --git a/cpan/Math-BigInt/t/bigfltpm.inc b/cpan/Math-BigInt/t/bigfltpm.inc index 0f5e9e4e83..0b25505849 100644 --- a/cpan/Math-BigInt/t/bigfltpm.inc +++ b/cpan/Math-BigInt/t/bigfltpm.inc @@ -183,9 +183,9 @@ while (<DATA>) { $x = Math::BigInt->new(1200); $y = $CLASS->new($x); is($y, 1200, - q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $y|); + qq|\$x = Math::BigInt->new(1200); \$y = $CLASS->new(\$x); # check \$y|); is($x, 1200, - q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $x|); + qq|\$x = Math::BigInt->new(1200); \$y = $CLASS->new(\$x); # check \$x|); ############################################################################### # Really huge, big, ultra-mega-biggy-monster exponents. Technically, the @@ -698,9 +698,6 @@ invalid:NaN 123:123 -123.4567:-123.4567 # invalid inputs -1__2:NaN -1E1__2:NaN -11__2E2:NaN .2E-3.:NaN 1e3e4:NaN # strange, but valid diff --git a/cpan/Math-BigInt/t/bigfltpm.t b/cpan/Math-BigInt/t/bigfltpm.t index fb68c05530..d2c7300b05 100644 --- a/cpan/Math-BigInt/t/bigfltpm.t +++ b/cpan/Math-BigInt/t/bigfltpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 19; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/bigintc-import.t b/cpan/Math-BigInt/t/bigintc-import.t index 161328e595..a2b75be17c 100644 --- a/cpan/Math-BigInt/t/bigintc-import.t +++ b/cpan/Math-BigInt/t/bigintc-import.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; @@ -12,7 +12,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc->_base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt/t/bigintc.t b/cpan/Math-BigInt/t/bigintc.t index 87384f7968..cf589ad14f 100644 --- a/cpan/Math-BigInt/t/bigintc.t +++ b/cpan/Math-BigInt/t/bigintc.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test Math::BigInt::Calc @@ -14,7 +14,7 @@ my ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT) = Math::BigInt::Calc -> _base_len(); -diag(<<"EOF"); +note(<<"EOF"); BASE_LEN = $BASE_LEN BASE = $BASE diff --git a/cpan/Math-BigInt/t/bigintpm.inc b/cpan/Math-BigInt/t/bigintpm.inc index d59a3f1c68..61d3ab2f40 100644 --- a/cpan/Math-BigInt/t/bigintpm.inc +++ b/cpan/Math-BigInt/t/bigintpm.inc @@ -1232,7 +1232,6 @@ NaN:-inf: 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 -0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input @@ -1245,7 +1244,6 @@ NaN:-inf: 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 -0x__123:NaN 0x9:9 0x11:17 0x21:33 @@ -1298,10 +1296,6 @@ abc:NaN # only one underscore between two digits _123:NaN _123_:NaN -123_:NaN -1__23:NaN -1E1__2:NaN -1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN diff --git a/cpan/Math-BigInt/t/bigintpm.t b/cpan/Math-BigInt/t/bigintpm.t index 7c97920cc5..3b78f2e1af 100644 --- a/cpan/Math-BigInt/t/bigintpm.t +++ b/cpan/Math-BigInt/t/bigintpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292 # tests in require'd file +use Test::More tests => 4280 # tests in require'd file + 20; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/bigints.t b/cpan/Math-BigInt/t/bigints.t index 1a08f255c5..b02a44bce7 100644 --- a/cpan/Math-BigInt/t/bigints.t +++ b/cpan/Math-BigInt/t/bigints.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/biglog.t b/cpan/Math-BigInt/t/biglog.t index d6d695ccb9..6045a6f8c3 100644 --- a/cpan/Math-BigInt/t/biglog.t +++ b/cpan/Math-BigInt/t/biglog.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test blog function (and bpow, since it uses blog), as well as bexp(). diff --git a/cpan/Math-BigInt/t/bigroot.t b/cpan/Math-BigInt/t/bigroot.t index 3280c7068c..4a62bdc5f6 100644 --- a/cpan/Math-BigInt/t/bigroot.t +++ b/cpan/Math-BigInt/t/bigroot.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test broot function (and bsqrt() function, since it is used by broot()). diff --git a/cpan/Math-BigInt/t/blucas-mbi.t b/cpan/Math-BigInt/t/blucas-mbi.t index 17b9017fbf..9a9215929f 100644 --- a/cpan/Math-BigInt/t/blucas-mbi.t +++ b/cpan/Math-BigInt/t/blucas-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnok-mbf.t b/cpan/Math-BigInt/t/bnok-mbf.t index edeaad86ac..d8b915121b 100644 --- a/cpan/Math-BigInt/t/bnok-mbf.t +++ b/cpan/Math-BigInt/t/bnok-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnok-mbi.t b/cpan/Math-BigInt/t/bnok-mbi.t index 9fd3ab2e72..26fe2ffa67 100644 --- a/cpan/Math-BigInt/t/bnok-mbi.t +++ b/cpan/Math-BigInt/t/bnok-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnstr-mbf.t b/cpan/Math-BigInt/t/bnstr-mbf.t index d21051a915..9e03a5bf48 100644 --- a/cpan/Math-BigInt/t/bnstr-mbf.t +++ b/cpan/Math-BigInt/t/bnstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bnstr-mbi.t b/cpan/Math-BigInt/t/bnstr-mbi.t index 361166c6db..ee4eec385e 100644 --- a/cpan/Math-BigInt/t/bnstr-mbi.t +++ b/cpan/Math-BigInt/t/bnstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bpi-mbf.t b/cpan/Math-BigInt/t/bpi-mbf.t new file mode 100644 index 0000000000..38b9350b2d --- /dev/null +++ b/cpan/Math-BigInt/t/bpi-mbf.t @@ -0,0 +1,53 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use Math::BigFloat; +use Scalar::Util qw< refaddr >; + +my $x; + +################################################################################ + +note('class method'); + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigFloat -> bpi(); +is($x, '3.141592653589793238462643383279502884197', + '$x = Math::BigFloat -> bpi();'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigFloat -> bpi(10); +is($x, '3.141592654', + '$x = Math::BigFloat -> bpi(10);'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); + +################################################################################ + +note('instance method'); + +my $y; + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigFloat -> new(100); +$y = $x -> bpi(); +is($x, '3.141592653589793238462643383279502884197', + '$x = Math::BigFloat -> new(100); $y = $x -> bpi();'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigFloat -> new(100); +$y = $x -> bpi(10); +is($x, '3.141592654', + '$x = Math::BigFloat -> new(100); $y = $x -> bpi(10);'); +is(ref($x), "Math::BigFloat", '$x is a Math::BigFloat'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); diff --git a/cpan/Math-BigInt/t/bpi-mbi.t b/cpan/Math-BigInt/t/bpi-mbi.t new file mode 100644 index 0000000000..6fa66687de --- /dev/null +++ b/cpan/Math-BigInt/t/bpi-mbi.t @@ -0,0 +1,103 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 24; + +use Math::BigInt; +use Scalar::Util qw< refaddr >; + +my $x; + +################################################################################ + +note('class method, without upgrading'); + +$x = Math::BigInt -> bpi(); +is($x, '3', '$x = Math::BigInt -> bpi()'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); + +$x = Math::BigInt -> bpi(10); +is($x, '3', '$x = Math::BigInt -> bpi(10)'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); + +note('class method, with upgrading'); + +require Math::BigFloat; +Math::BigInt -> upgrade('Math::BigFloat'); + +# When no accuracy is specified, default accuracy shall be used. + +$x = Math::BigInt -> bpi(); +is($x, '3.141592653589793238462643383279502884197', '$x = Math::BigInt -> bpi()'); +is(ref($x), "Math::BigFloat", + '$x is a Math::BigFloat'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigInt -> bpi(10); +is($x, '3.141592654', '$x = Math::BigInt -> bpi(10)'); +is(ref($x), "Math::BigFloat", + '$x is a Math::BigFloat'); + +################################################################################ + +Math::BigInt -> upgrade(undef); + +note('instance method, without upgrading'); + +my $y; + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(); +is($x, '3', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(10); +is($x, '3', + '$x = Math::BigInt -> new(100); $y = $x -> bpi(10);'); +is(ref($x), 'Math::BigInt', + '$x is a Math::BigInt'); +is(refaddr($x), refaddr($y), '$x and $y are the same object'); + +note('instance method, with upgrading'); + +require Math::BigFloat; +Math::BigInt -> upgrade('Math::BigFloat'); + +# When no accuracy is specified, default accuracy shall be used. + +# When upgrading is in effect, a new object is returned. + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(); +is($x, '100', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($x), "Math::BigInt", + '$x is a Math::BigInt'); +is($y, '3.141592653589793238462643383279502884197', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($y), "Math::BigFloat", + '$y is a Math::BigFloat'); +isnt(refaddr($x), refaddr($y), '$x and $y are not the same object'); + +# When accuracy is specified, it shall be used. + +$x = Math::BigInt -> new(100); +$y = $x -> bpi(10); +is($x, '100', + '$x = Math::BigInt -> new(100); $y = $x -> bpi(10);'); +is(ref($x), "Math::BigInt", + '$x is a Math::BigInt'); +is($y, '3.141592654', + '$x = Math::BigInt -> new(100); $y = $x -> bpi();'); +is(ref($y), "Math::BigFloat", + '$y is a Math::BigFloat'); +isnt(refaddr($x), refaddr($y), '$x and $y are not the same object'); diff --git a/cpan/Math-BigInt/t/bsstr-mbf.t b/cpan/Math-BigInt/t/bsstr-mbf.t index 89faab1784..3c18e6c64f 100644 --- a/cpan/Math-BigInt/t/bsstr-mbf.t +++ b/cpan/Math-BigInt/t/bsstr-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/bsstr-mbi.t b/cpan/Math-BigInt/t/bsstr-mbi.t index 1422522d06..1093aa2821 100644 --- a/cpan/Math-BigInt/t/bsstr-mbi.t +++ b/cpan/Math-BigInt/t/bsstr-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/buparrow-mbi.t b/cpan/Math-BigInt/t/buparrow-mbi.t index c2eb2eec61..f2583418f9 100644 --- a/cpan/Math-BigInt/t/buparrow-mbi.t +++ b/cpan/Math-BigInt/t/buparrow-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/calling-class-methods.t b/cpan/Math-BigInt/t/calling-class-methods.t index 27ada2eb0c..c623d6fb0d 100644 --- a/cpan/Math-BigInt/t/calling-class-methods.t +++ b/cpan/Math-BigInt/t/calling-class-methods.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test calling conventions, and :constant overloading @@ -51,7 +51,7 @@ while (<DATA>) { my @args = split /:/, $_, 99; $expected = pop @args; foreach my $class (qw/ - Math::BigInt Math::BigFloat + Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test /) { diff --git a/cpan/Math-BigInt/t/calling-constant.t b/cpan/Math-BigInt/t/calling-constant.t new file mode 100644 index 0000000000..13d6b52ae8 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-constant.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether :constant works or not + +$try = qq|use $class 0, "bgcd", ":constant";| + . q| $x = 2**150; bgcd($x); $x = "$x";|; +$expected = eval $try; +is($expected, "1427247692705959881058285969449495136382746624", $try); diff --git a/cpan/Math-BigInt/t/calling-instance-methods.t b/cpan/Math-BigInt/t/calling-instance-methods.t index 30421da67b..4ccdf96d00 100644 --- a/cpan/Math-BigInt/t/calling-instance-methods.t +++ b/cpan/Math-BigInt/t/calling-instance-methods.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test calling conventions, and :constant overloading @@ -51,7 +51,7 @@ while (<DATA>) { my @args = split /:/, $_, 99; $expected = pop @args; foreach my $class (qw/ - Math::BigInt Math::BigFloat + Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test /) { diff --git a/cpan/Math-BigInt/t/calling-lib1.t b/cpan/Math-BigInt/t/calling-lib1.t new file mode 100644 index 0000000000..9cdc3ce663 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-lib1.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) + +$try = qq|use $class 0, "lib" => "Scalar";| + . q| $x = 2**10; $x = "$x";|; +$expected = eval $try; +is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/calling-lib2.t b/cpan/Math-BigInt/t/calling-lib2.t new file mode 100644 index 0000000000..1d8a5dde31 --- /dev/null +++ b/cpan/Math-BigInt/t/calling-lib2.t @@ -0,0 +1,18 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; +use lib 't'; + +use Test::More tests => 1; + +my ($x, $expected, $try); + +my $class = 'Math::BigInt'; + +# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) + +$try = qq|use $class 0, "lib" => "$class\::Scalar";| + . q| $x = 2**10; $x = "$x";|; +$expected = eval $try; +is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/calling.t b/cpan/Math-BigInt/t/calling.t deleted file mode 100644 index ae584205d0..0000000000 --- a/cpan/Math-BigInt/t/calling.t +++ /dev/null @@ -1,70 +0,0 @@ -#!perl - -# test calling conventions, and :constant overloading - -use strict; -use warnings; -use lib 't'; - -my $VERSION = '1.999823'; # adjust manually to match latest release - -use Test::More tests => 5; - -############################################################################## - -package Math::BigInt::Test; - -use Math::BigInt; -our @ISA = qw/Math::BigInt/; # subclass of MBI -use overload; - -############################################################################## - -package Math::BigFloat::Test; - -use Math::BigFloat; -our @ISA = qw/Math::BigFloat/; # subclass of MBF -use overload; - -############################################################################## - -package main; - -use Math::BigInt try => 'Calc'; -use Math::BigFloat; - -my ($x, $expected, $try); - -my $class = 'Math::BigInt'; - -# test whether use Math::BigInt qw/VERSION/ works -$try = "use $class " . ($VERSION . '1') . ";"; -$try .= ' $x = $class->new(123); $x = "$x";'; -eval $try; -like($@, qr/ ^ Math::BigInt \s+ ( version \s+ )? \S+ \s+ required--this \s+ - is \s+ only \s+ version \s+ \S+ /x, - $try); - -# test whether fallback to calc works -$try = qq|use $class $VERSION, "try", "foo, bar, ";| - . qq| $class\->config("lib");|; -$expected = eval $try; -like($expected, qr/^Math::BigInt::(Fast)?Calc\z/, $try); - -# test whether constant works or not, also test for qw($VERSION) -# bgcd() is present in subclass, too -$try = qq|use $class $VERSION, "bgcd", ":constant";| - . q| $x = 2**150; bgcd($x); $x = "$x";|; -$expected = eval $try; -is($expected, "1427247692705959881058285969449495136382746624", $try); - -# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) -$try = qq|use $class $VERSION, "lib", "Scalar";| - . q| $x = 2**10; $x = "$x";|; -$expected = eval $try; -is($expected, "1024", $try); - -$try = qq|use $class $VERSION, "lib", "$class\::Scalar";| - . q| $x = 2**10; $x = "$x";|; -$expected = eval $try; -is($expected, "1024", $try); diff --git a/cpan/Math-BigInt/t/config.t b/cpan/Math-BigInt/t/config.t index e472404a1b..25fd92a154 100644 --- a/cpan/Math-BigInt/t/config.t +++ b/cpan/Math-BigInt/t/config.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/const-mbf.t b/cpan/Math-BigInt/t/const-mbf.t new file mode 100644 index 0000000000..d6231ae2ff --- /dev/null +++ b/cpan/Math-BigInt/t/const-mbf.t @@ -0,0 +1,314 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "170"; + +use Math::BigFloat ":constant"; + +my $class = "Math::BigFloat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "0.999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999.9", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "3.140625", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "3.140625", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} diff --git a/cpan/Math-BigInt/t/const-mbi.t b/cpan/Math-BigInt/t/const-mbi.t new file mode 100644 index 0000000000..17c30c217d --- /dev/null +++ b/cpan/Math-BigInt/t/const-mbi.t @@ -0,0 +1,235 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "118"; + +use Math::BigInt ":constant"; + +my $class = "Math::BigInt"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} diff --git a/cpan/Math-BigInt/t/const_mbf.t b/cpan/Math-BigInt/t/const_mbf.t deleted file mode 100644 index 37524a357b..0000000000 --- a/cpan/Math-BigInt/t/const_mbf.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl - -# test Math::BigFloat constants alone (w/o Math::BigInt loading) - -use strict; -use warnings; - -use Test::More tests => 2; - -use Math::BigFloat ':constant'; - -is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', - "1.0 / 3.0 = 0.3333333333333333333333333333333333333333"); - -# Math::BigInt was not loaded with ':constant', so only floats are handled -is(ref(2 ** 2), '', "2 ** 2 is a scalar"); diff --git a/cpan/Math-BigInt/t/constant.t b/cpan/Math-BigInt/t/constant.t deleted file mode 100644 index 1f760d6280..0000000000 --- a/cpan/Math-BigInt/t/constant.t +++ /dev/null @@ -1,46 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 7; - -use Math::BigInt ':constant'; - -is(2 ** 255, - '578960446186580977117854925043439539266' - . '34992332820282019728792003956564819968', - '2 ** 255'); - -{ - no warnings 'portable'; # protect against "non-portable" warnings - - # hexadecimal constants - is(0x123456789012345678901234567890, - Math::BigInt->new('0x123456789012345678901234567890'), - 'hexadecimal constant 0x123456789012345678901234567890'); - - # binary constants - is(0b01010100011001010110110001110011010010010110000101101101, - Math::BigInt->new('0b0101010001100101011011000111' - . '0011010010010110000101101101'), - 'binary constant 0b0101010001100101011011000111' - . '0011010010010110000101101101'); -} - -use Math::BigFloat ':constant'; -is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', - '1.0 / 3.0 = 0.3333333333333333333333333333333333333333'); - -# stress-test Math::BigFloat->import() - -Math::BigFloat->import(qw/:constant/); -pass('Math::BigFloat->import(qw/:constant/);'); - -Math::BigFloat->import(qw/:constant upgrade Math::BigRat/); -pass('Math::BigFloat->import(qw/:constant upgrade Math::BigRat/);'); - -Math::BigFloat->import(qw/upgrade Math::BigRat :constant/); -pass('Math::BigFloat->import(qw/upgrade Math::BigRat :constant/);'); - -# all tests done diff --git a/cpan/Math-BigInt/t/downgrade.t b/cpan/Math-BigInt/t/downgrade.t index ce8a24ff56..ea7c4b584e 100644 --- a/cpan/Math-BigInt/t/downgrade.t +++ b/cpan/Math-BigInt/t/downgrade.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/dparts-mbf.t b/cpan/Math-BigInt/t/dparts-mbf.t index 90a29dd753..43bdd22b76 100644 --- a/cpan/Math-BigInt/t/dparts-mbf.t +++ b/cpan/Math-BigInt/t/dparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/dparts-mbi.t b/cpan/Math-BigInt/t/dparts-mbi.t index 4488b2e597..0b4ba38267 100644 --- a/cpan/Math-BigInt/t/dparts-mbi.t +++ b/cpan/Math-BigInt/t/dparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/eparts-mbf.t b/cpan/Math-BigInt/t/eparts-mbf.t index 0c84ac6662..a612461fa9 100644 --- a/cpan/Math-BigInt/t/eparts-mbf.t +++ b/cpan/Math-BigInt/t/eparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/eparts-mbi.t b/cpan/Math-BigInt/t/eparts-mbi.t index 5c84e28c2d..783f716e5c 100644 --- a/cpan/Math-BigInt/t/eparts-mbi.t +++ b/cpan/Math-BigInt/t/eparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_base-mbi.t b/cpan/Math-BigInt/t/from_base-mbi.t index 88912cba71..1f664e1652 100644 --- a/cpan/Math-BigInt/t/from_base-mbi.t +++ b/cpan/Math-BigInt/t/from_base-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_base_num-mbi.t b/cpan/Math-BigInt/t/from_base_num-mbi.t index b407787274..aad7c6d18b 100644 --- a/cpan/Math-BigInt/t/from_base_num-mbi.t +++ b/cpan/Math-BigInt/t/from_base_num-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_bin-mbf.t b/cpan/Math-BigInt/t/from_bin-mbf.t index 577f8c1a80..a24f1bfd4d 100644 --- a/cpan/Math-BigInt/t/from_bin-mbf.t +++ b/cpan/Math-BigInt/t/from_bin-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_bin-mbi.t b/cpan/Math-BigInt/t/from_bin-mbi.t index 96aa8b3b35..da8300726b 100644 --- a/cpan/Math-BigInt/t/from_bin-mbi.t +++ b/cpan/Math-BigInt/t/from_bin-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_hex-mbf.t b/cpan/Math-BigInt/t/from_hex-mbf.t index cff00bfdf3..8a9f3cf012 100644 --- a/cpan/Math-BigInt/t/from_hex-mbf.t +++ b/cpan/Math-BigInt/t/from_hex-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_hex-mbi.t b/cpan/Math-BigInt/t/from_hex-mbi.t index 280cf3c74a..200253134f 100644 --- a/cpan/Math-BigInt/t/from_hex-mbi.t +++ b/cpan/Math-BigInt/t/from_hex-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_ieee754-mbf.t b/cpan/Math-BigInt/t/from_ieee754-mbf.t index 99dd6e1e07..8edb904ba4 100644 --- a/cpan/Math-BigInt/t/from_ieee754-mbf.t +++ b/cpan/Math-BigInt/t/from_ieee754-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_oct-mbf.t b/cpan/Math-BigInt/t/from_oct-mbf.t index 921ca6878a..2fff2a0ba3 100644 --- a/cpan/Math-BigInt/t/from_oct-mbf.t +++ b/cpan/Math-BigInt/t/from_oct-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/from_oct-mbi.t b/cpan/Math-BigInt/t/from_oct-mbi.t index 5107fd1fb0..3ec700ee88 100644 --- a/cpan/Math-BigInt/t/from_oct-mbi.t +++ b/cpan/Math-BigInt/t/from_oct-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/inf_nan.t b/cpan/Math-BigInt/t/inf_nan.t index f297c1d9d9..9634396b71 100644 --- a/cpan/Math-BigInt/t/inf_nan.t +++ b/cpan/Math-BigInt/t/inf_nan.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test inf/NaN handling all in one place # Thanx to Jarkko for the excellent explanations and the tables diff --git a/cpan/Math-BigInt/t/isa.t b/cpan/Math-BigInt/t/isa.t index b99babc783..984d048b98 100644 --- a/cpan/Math-BigInt/t/isa.t +++ b/cpan/Math-BigInt/t/isa.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/lib_load-mbf-mbi.t b/cpan/Math-BigInt/t/lib_load-mbf-mbi.t new file mode 100644 index 0000000000..e18476ed49 --- /dev/null +++ b/cpan/Math-BigInt/t/lib_load-mbf-mbi.t @@ -0,0 +1,72 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use lib "t"; + +# First load Math::BigFloat with Math::BigInt::Calc. + +use Math::BigFloat lib => "Calc"; + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + 'ref Math::BigFloat -> bzero() -> {_m}'); + +# Math::BigInt will know that we loaded Math::BigInt::Calc. + +require Math::BigInt; + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); + +# Now load Math::BigFloat again with a different lib. + +Math::BigFloat -> import(lib => "BareCalc"); + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + 'ref Math::BigFloat -> bzero() -> {_m}'); + +# See if Math::BigInt knows about Math::BigInt::BareCalc. + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + "Math::BigInt is using library Math::BigInt::Calc"); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); + +# See that Math::BigInt supports "only". + +eval { Math::BigInt -> import("only" => "Calc") }; +subtest 'Math::BigInt -> import("only" => "Calc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); +}; + +# See that Math::BigInt supports "try". + +eval { Math::BigInt -> import("try" => "BareCalc") }; +subtest 'Math::BigInt -> import("try" => "BareCalc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + "ref Math::BigInt -> bzero() -> {value}"); +} diff --git a/cpan/Math-BigInt/t/lib_load-mbi-mbf.t b/cpan/Math-BigInt/t/lib_load-mbi-mbf.t new file mode 100644 index 0000000000..8868667fe3 --- /dev/null +++ b/cpan/Math-BigInt/t/lib_load-mbi-mbf.t @@ -0,0 +1,72 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 10; + +use lib "t"; + +# First load Math::BigInt with Math::BigInt::Calc. + +use Math::BigInt lib => "Calc"; + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + 'ref Math::BigInt -> bzero() -> {value}'); + +# Math::BigFloat will know that we loaded Math::BigInt::Calc. + +require Math::BigFloat; + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); + +# Now load Math::BigInt again with a different lib. + +Math::BigInt -> import(lib => "BareCalc"); + +is(Math::BigInt -> config("lib"), "Math::BigInt::Calc", + 'Math::BigInt -> config("lib")'); + +is(ref Math::BigInt -> bzero() -> {value}, "Math::BigInt::Calc", + 'ref Math::BigInt -> bzero() -> {value}'); + +# See if Math::BigFloat knows about Math::BigInt::BareCalc. + +is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + "Math::BigFloat is using library Math::BigInt::Calc"); + +is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); + +# See that Math::BigFloat supports "only". + +eval { Math::BigFloat -> import("only" => "Calc") }; +subtest 'Math::BigFloat -> import("only" => "Calc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); +}; + +# See that Math::BigFloat supports "try". + +eval { Math::BigFloat -> import("try" => "BareCalc") }; +subtest 'Math::BigFloat -> import("try" => "BareCalc")' => sub { + plan tests => 3; + + is($@, "", '$@ is empty'); + is(Math::BigFloat -> config("lib"), "Math::BigInt::Calc", + 'Math::BigFloat -> config("lib")'); + is(ref Math::BigFloat -> bzero() -> {_m}, "Math::BigInt::Calc", + "ref Math::BigFloat -> bzero() -> {_m}"); +} diff --git a/cpan/Math-BigInt/t/lib_load.t b/cpan/Math-BigInt/t/lib_load.t deleted file mode 100644 index 68871e2244..0000000000 --- a/cpan/Math-BigInt/t/lib_load.t +++ /dev/null @@ -1,32 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 4; - -use lib 't'; - -# first load Math::BigInt with Math::BigInt::Calc -use Math::BigInt lib => 'Calc'; - -# Math::BigFloat will remember that we loaded Math::BigInt::Calc -require Math::BigFloat; -is(Math::BigFloat->config("lib"), 'Math::BigInt::Calc', - 'Math::BigFloat got Math::BigInt::Calc'); - -# now load Math::BigInt again with a different lib -Math::BigInt->import(lib => 'BareCalc'); - -# and finally test that Math::BigFloat knows about Math::BigInt::BareCalc - -is(Math::BigFloat->config("lib"), 'Math::BigInt::BareCalc', - 'Math::BigFloat was notified'); - -# See that Math::BigFloat supports "only" -eval { Math::BigFloat->import('only' => 'Calc') }; -is(Math::BigFloat->config("lib"), 'Math::BigInt::Calc', '"only" worked'); - -# See that Math::BigFloat supports "try" -eval { Math::BigFloat->import('try' => 'BareCalc') }; -is(Math::BigFloat->config("lib"), 'Math::BigInt::BareCalc', '"try" worked'); diff --git a/cpan/Math-BigInt/t/mbf_ali.t b/cpan/Math-BigInt/t/mbf_ali.t index 3999aa7e82..b96d2051b5 100644 --- a/cpan/Math-BigInt/t/mbf_ali.t +++ b/cpan/Math-BigInt/t/mbf_ali.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/mbi_ali.t b/cpan/Math-BigInt/t/mbi_ali.t index 45ed6c4dc6..7e3e0a063f 100644 --- a/cpan/Math-BigInt/t/mbi_ali.t +++ b/cpan/Math-BigInt/t/mbi_ali.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/mbi_rand.t b/cpan/Math-BigInt/t/mbi_rand.t index fce5e20cdd..eae6e39e02 100644 --- a/cpan/Math-BigInt/t/mbi_rand.t +++ b/cpan/Math-BigInt/t/mbi_rand.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/mbimbf.t b/cpan/Math-BigInt/t/mbimbf.t index d9167e1807..23599ddb6a 100644 --- a/cpan/Math-BigInt/t/mbimbf.t +++ b/cpan/Math-BigInt/t/mbimbf.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes diff --git a/cpan/Math-BigInt/t/nan_cmp.t b/cpan/Math-BigInt/t/nan_cmp.t index c84be9003e..adaf906226 100644 --- a/cpan/Math-BigInt/t/nan_cmp.t +++ b/cpan/Math-BigInt/t/nan_cmp.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that overloaded compare works when NaN are involved diff --git a/cpan/Math-BigInt/t/new-mbf.t b/cpan/Math-BigInt/t/new-mbf.t index 0400390c35..d4fa8b6017 100644 --- a/cpan/Math-BigInt/t/new-mbf.t +++ b/cpan/Math-BigInt/t/new-mbf.t @@ -1,9 +1,11 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 100; +use Test::More tests => 112; + +use Scalar::Util qw< refaddr >; my $class; @@ -35,6 +37,110 @@ while (<DATA>) { } +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + no warnings "numeric"; + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); +# is($x, "0", 'output arg has the right value'); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + no warnings "uninitialized"; + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new($x) +# +# In this case, when $x isa Math::BigFloat, only the sign and value should be +# copied from $x, not the accuracy or precision. + +SKIP: { + skip "This test reveals a bug that has not been fixed yet", 2; + + my ($a, $p, $x, $y); + + $a = $class -> accuracy(); # get original + $class -> accuracy(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> accuracy(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> accuracy(), 4711, 'object has the global accuracy'); + $class -> accuracy($a); # reset + + $p = $class -> precision(); # get original + $class -> precision(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> precision(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> precision(), 4711, 'object has the global precision'); + $class -> precision($p); # reset +} + +# Make sure that library thingies are indeed copied. + +{ + my ($x, $y); + + $x = $class -> new("314"); # create object + $y = $class -> new($x); # create new object + subtest 'library thingy is copied' => sub { + my @keys = ('_m', '_e'); + plan tests => scalar @keys; + for my $key (@keys) { + isnt(refaddr($y -> {$key}), refaddr($x -> {$key}), + 'library thingy is a copy'); + } + }; +} + +# Other tests where we must use the scientific notation in the output. + +for my $str (qw/ + 1e+4294967296 + 1e+18446744073709551616 + 1e+79228162514264337593543950336 + 1e+340282366920938463463374607431768211456 + 1e+1461501637330902918203684832716283019655932542976 + 1e+6277101735386680763835789423207666416102355444464034512896 + /) +{ + my $x; + $x = $class -> new($str); + subtest $str, sub { + plan tests => 2, + + is(ref($x), $class, "output arg is a $class"); + is($x -> bnstr(), $str, 'output arg has the right value'); + } +} + __END__ NaN:NaN diff --git a/cpan/Math-BigInt/t/new-mbi.t b/cpan/Math-BigInt/t/new-mbi.t new file mode 100644 index 0000000000..07d826d4ca --- /dev/null +++ b/cpan/Math-BigInt/t/new-mbi.t @@ -0,0 +1,279 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 106; + +use Scalar::Util qw< refaddr >; + +my $class; + +BEGIN { $class = 'Math::BigInt'; } +BEGIN { use_ok($class); } + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($in0, $out0) = split /:/; + my $x; + my $test = qq|\$x = $class -> new("$in0");|; + my $desc = $test; + + eval $test; + die $@ if $@; # this should never happen + + subtest $desc, sub { + plan tests => 2, + + # Check output. + + is(ref($x), $class, "output arg is a $class"); + is($x, $out0, 'output arg has the right value'); + }; + +} + +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + no warnings "numeric"; + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + #is($x, "0", 'output arg has the right value'); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + no warnings "uninitialized"; + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new($x) +# +# In this case, when $x isa Math::BigInt, only the sign and value should be +# copied from $x, not the accuracy or precision. + +{ + my ($a, $p, $x, $y); + + $a = $class -> accuracy(); # get original + $class -> accuracy(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> accuracy(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> accuracy(), 4711, 'object has the global accuracy'); + $class -> accuracy($a); # reset + + $p = $class -> precision(); # get original + $class -> precision(4711); # set new global value + $x = $class -> new("314"); # create object + $x -> precision(41); # set instance value + $y = $class -> new($x); # create new object + is($y -> precision(), 4711, 'object has the global precision'); + $class -> precision($p); # reset +} + +# Make sure that library thingies are indeed copied. + +{ + my ($x, $y); + + $x = $class -> new("314"); # create object + $y = $class -> new($x); # create new object + subtest 'library thingy is copied' => sub { + my @keys = ('value'); + plan tests => scalar @keys; + for my $key (@keys) { + isnt(refaddr($y -> {$key}), refaddr($x -> {$key}), + 'library thingy is a copy'); + } + }; +} + +__END__ + +NaN:NaN +inf:inf +infinity:inf ++inf:inf ++infinity:inf +-inf:-inf +-infinity:-inf + +# This is the same data as in from_bin-mbf.t, except that some of them are +# commented out, since new() only treats input as binary if it has a "0b" or +# "0B" prefix, possibly with a leading "+" or "-" sign. Duplicates from above +# are also commented out. + +0b1p+0:1 +0b.1p+1:1 +0b.01p+2:1 +0b.001p+3:1 +0b.0001p+4:1 +0b10p-1:1 +0b100p-2:1 +0b1000p-3:1 + +-0b1p+0:-1 + +0b0p+0:0 +0b0p+7:0 +0b0p-7:0 +0b0.p+0:0 +0b.0p+0:0 +0b0.0p+0:0 + +0b1100101011111110:51966 +0B1100101011111110:51966 +b1100101011111110:51966 +B1100101011111110:51966 +#1100101011111110:51966 + +0b1.1001p+3:NaN +0b10010.001101p-1:NaN +-0b.11110001001101010111100110111101111p+31:NaN +0b10.0100011010001010110011110001001101p+34:39093746765 + +0b.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN + +# This is more or less the same data as in from_oct-mbf.t, except that some of +# them are commented out, since new() does not consider a number with just a +# leading zero to be an octal number. Duplicates from above are also commented +# out. + +# Without "0o" prefix. + +001p+0:1 +00.4p+1:1 +00.2p+2:1 +00.1p+3:1 +00.04p+4:1 +02p-1:1 +04p-2:1 +010p-3:1 + +-01p+0:-1 + +00p+0:0 +00p+7:0 +00p-7:0 +00.p+0:0 +00.0p+0:0 + +#145376:51966 +#0145376:51966 +#00145376:51966 + +03.1p+2:NaN +022.15p-1:NaN +-00.361152746757p+32:NaN +044.3212636115p+30:39093746765 + +0.p+0:NaN +.p+0:NaN + +# With "0o" prefix. + +0o01p+0:1 +0o0.4p+1:1 +0o0.2p+2:1 +0o0.1p+3:1 +0o0.04p+4:1 +0o02p-1:1 +0o04p-2:1 +0o010p-3:1 + +-0o1p+0:-1 + +0o0p+0:0 +0o0p+7:0 +0o0p-7:0 +0o0.p+0:0 +0o.0p+0:0 +0o0.0p+0:0 + +0o145376:51966 +0O145376:51966 +o145376:51966 +O145376:51966 + +0o3.1p+2:NaN +0o22.15p-1:NaN +-0o0.361152746757p+32:NaN +0o44.3212636115p+30:39093746765 + +0o.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN + +# This is the same data as in from_hex-mbf.t, except that some of them are +# commented out, since new() only treats input as hexadecimal if it has a "0x" +# or "0X" prefix, possibly with a leading "+" or "-" sign. + +0x1p+0:1 +0x.8p+1:1 +0x.4p+2:1 +0x.2p+3:1 +0x.1p+4:1 +0x2p-1:1 +0x4p-2:1 +0x8p-3:1 + +-0x1p+0:-1 + +0x0p+0:0 +0x0p+7:0 +0x0p-7:0 +0x0.p+0:0 +0x.0p+0:0 +0x0.0p+0:0 + +0xcafe:51966 +0Xcafe:51966 +xcafe:51966 +Xcafe:51966 +#cafe:51966 + +0x1.9p+3:NaN +0x12.34p-1:NaN +-0x.789abcdefp+32:NaN +0x12.3456789ap+31:39093746765 + +0x.p+0:NaN + +#NaN:NaN +#+inf:NaN +#-inf:NaN diff --git a/cpan/Math-BigInt/t/new_overloaded.t b/cpan/Math-BigInt/t/new_overloaded.t index 011f54fc78..b5a4f274e4 100644 --- a/cpan/Math-BigInt/t/new_overloaded.t +++ b/cpan/Math-BigInt/t/new_overloaded.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Math::BigFloat->new had a bug where it would assume any object is a # Math::BigInt which broke overloaded non-Math::BigInt objects. diff --git a/cpan/Math-BigInt/t/nparts-mbf.t b/cpan/Math-BigInt/t/nparts-mbf.t index a680628122..0c558ad3be 100644 --- a/cpan/Math-BigInt/t/nparts-mbf.t +++ b/cpan/Math-BigInt/t/nparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/nparts-mbi.t b/cpan/Math-BigInt/t/nparts-mbi.t index c2f41f3a08..a970535339 100644 --- a/cpan/Math-BigInt/t/nparts-mbi.t +++ b/cpan/Math-BigInt/t/nparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/objectify_mbf.t b/cpan/Math-BigInt/t/objectify_mbf.t index 258ed7b196..8ea7abe1e0 100644 --- a/cpan/Math-BigInt/t/objectify_mbf.t +++ b/cpan/Math-BigInt/t/objectify_mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigFloat or subclass thereof. diff --git a/cpan/Math-BigInt/t/objectify_mbi.t b/cpan/Math-BigInt/t/objectify_mbi.t index 8bb3571969..8efb4520c7 100644 --- a/cpan/Math-BigInt/t/objectify_mbi.t +++ b/cpan/Math-BigInt/t/objectify_mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigInt or subclass thereof. diff --git a/cpan/Math-BigInt/t/req_mbf0.t b/cpan/Math-BigInt/t/req_mbf0.t index f8af78727f..976cb0c263 100644 --- a/cpan/Math-BigInt/t/req_mbf0.t +++ b/cpan/Math-BigInt/t/req_mbf0.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bzero() works diff --git a/cpan/Math-BigInt/t/req_mbf1.t b/cpan/Math-BigInt/t/req_mbf1.t index f9b7cc48e2..74ad48bca0 100644 --- a/cpan/Math-BigInt/t/req_mbf1.t +++ b/cpan/Math-BigInt/t/req_mbf1.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bone() works diff --git a/cpan/Math-BigInt/t/req_mbfa.t b/cpan/Math-BigInt/t/req_mbfa.t index 1a83b1cca6..a436aa27a2 100644 --- a/cpan/Math-BigInt/t/req_mbfa.t +++ b/cpan/Math-BigInt/t/req_mbfa.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then bnan() works diff --git a/cpan/Math-BigInt/t/req_mbfi.t b/cpan/Math-BigInt/t/req_mbfi.t index 9db1e9ab84..69c82c0f08 100644 --- a/cpan/Math-BigInt/t/req_mbfi.t +++ b/cpan/Math-BigInt/t/req_mbfi.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then binf() works diff --git a/cpan/Math-BigInt/t/req_mbfn.t b/cpan/Math-BigInt/t/req_mbfn.t index ffeb8b3b0e..eef0e011af 100644 --- a/cpan/Math-BigInt/t/req_mbfn.t +++ b/cpan/Math-BigInt/t/req_mbfn.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigFloat and then new() works diff --git a/cpan/Math-BigInt/t/req_mbfw.t b/cpan/Math-BigInt/t/req_mbfw.t index db095677c0..2e7ece75b2 100644 --- a/cpan/Math-BigInt/t/req_mbfw.t +++ b/cpan/Math-BigInt/t/req_mbfw.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that requiring Math::BigFloat and then calling import() works diff --git a/cpan/Math-BigInt/t/require.t b/cpan/Math-BigInt/t/require.t index 3c34db6885..32fde97158 100644 --- a/cpan/Math-BigInt/t/require.t +++ b/cpan/Math-BigInt/t/require.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # check that simple requiring Math::BigInt works diff --git a/cpan/Math-BigInt/t/round.t b/cpan/Math-BigInt/t/round.t index 4110626c3d..e92b57fd40 100644 --- a/cpan/Math-BigInt/t/round.t +++ b/cpan/Math-BigInt/t/round.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding with non-integer A and P parameters diff --git a/cpan/Math-BigInt/t/rt-16221.t b/cpan/Math-BigInt/t/rt-16221.t index d531046085..ccd66a5e38 100644 --- a/cpan/Math-BigInt/t/rt-16221.t +++ b/cpan/Math-BigInt/t/rt-16221.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # # Verify that # - Math::BigInt::objectify() calls as_int() (or as_number(), as a fallback) diff --git a/cpan/Math-BigInt/t/sparts-mbf.t b/cpan/Math-BigInt/t/sparts-mbf.t index 1e16763b8a..b1a7a4a87e 100644 --- a/cpan/Math-BigInt/t/sparts-mbf.t +++ b/cpan/Math-BigInt/t/sparts-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/sparts-mbi.t b/cpan/Math-BigInt/t/sparts-mbi.t index 86620b7faf..5d1dab333f 100644 --- a/cpan/Math-BigInt/t/sparts-mbi.t +++ b/cpan/Math-BigInt/t/sparts-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/sub_ali.t b/cpan/Math-BigInt/t/sub_ali.t index 2f145b4e23..4b125db344 100644 --- a/cpan/Math-BigInt/t/sub_ali.t +++ b/cpan/Math-BigInt/t/sub_ali.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test that the new alias names work diff --git a/cpan/Math-BigInt/t/sub_mbf.t b/cpan/Math-BigInt/t/sub_mbf.t index 472ad9445e..08845c7b5c 100644 --- a/cpan/Math-BigInt/t/sub_mbf.t +++ b/cpan/Math-BigInt/t/sub_mbf.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 6; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/sub_mbi.t b/cpan/Math-BigInt/t/sub_mbi.t index 65ea327a5a..ae2855f054 100644 --- a/cpan/Math-BigInt/t/sub_mbi.t +++ b/cpan/Math-BigInt/t/sub_mbi.t @@ -1,9 +1,9 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4292 # tests in require'd file +use Test::More tests => 4280 # tests in require'd file + 5; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/sub_mif.t b/cpan/Math-BigInt/t/sub_mif.t index 250db3f189..8e9cad4f10 100644 --- a/cpan/Math-BigInt/t/sub_mif.t +++ b/cpan/Math-BigInt/t/sub_mif.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes diff --git a/cpan/Math-BigInt/t/to_base-mbi.t b/cpan/Math-BigInt/t/to_base-mbi.t index c97e2887e1..61f2ae7850 100644 --- a/cpan/Math-BigInt/t/to_base-mbi.t +++ b/cpan/Math-BigInt/t/to_base-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/to_base_num-mbi.t b/cpan/Math-BigInt/t/to_base_num-mbi.t index 4c66b91ed2..821aefb896 100644 --- a/cpan/Math-BigInt/t/to_base_num-mbi.t +++ b/cpan/Math-BigInt/t/to_base_num-mbi.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/to_ieee754-mbf.t b/cpan/Math-BigInt/t/to_ieee754-mbf.t index ef79870d0d..7994b705a1 100644 --- a/cpan/Math-BigInt/t/to_ieee754-mbf.t +++ b/cpan/Math-BigInt/t/to_ieee754-mbf.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/trap.t b/cpan/Math-BigInt/t/trap.t index 05af8821b4..28d75cf6d8 100644 --- a/cpan/Math-BigInt/t/trap.t +++ b/cpan/Math-BigInt/t/trap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # test that config ( trap_nan => 1, trap_inf => 1) really works/dies diff --git a/cpan/Math-BigInt/t/upgrade.inc b/cpan/Math-BigInt/t/upgrade.inc index 92e85a043b..ce5771eef3 100644 --- a/cpan/Math-BigInt/t/upgrade.inc +++ b/cpan/Math-BigInt/t/upgrade.inc @@ -430,7 +430,6 @@ NaN:-inf: 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 -0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input @@ -443,7 +442,6 @@ NaN:-inf: 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 -0x__123:NaN 0x9:9 0x11:17 0x21:33 @@ -493,10 +491,6 @@ abc:NaN # only one underscore between two digits _123:NaN _123_:NaN -123_:NaN -1__23:NaN -1E1__2:NaN -1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN diff --git a/cpan/Math-BigInt/t/upgrade.t b/cpan/Math-BigInt/t/upgrade.t index b161a8fe2e..fa72e8da2a 100644 --- a/cpan/Math-BigInt/t/upgrade.t +++ b/cpan/Math-BigInt/t/upgrade.t @@ -1,9 +1,9 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 2146 # tests in require'd file +use Test::More tests => 2134 # tests in require'd file + 2; # tests in this file use Math::BigInt upgrade => 'Math::BigFloat'; diff --git a/cpan/Math-BigInt/t/upgrade2.t b/cpan/Math-BigInt/t/upgrade2.t index 5009d61678..8b8c03691d 100644 --- a/cpan/Math-BigInt/t/upgrade2.t +++ b/cpan/Math-BigInt/t/upgrade2.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigInt/t/upgradef.t b/cpan/Math-BigInt/t/upgradef.t index d79297ba75..d76e97c74b 100644 --- a/cpan/Math-BigInt/t/upgradef.t +++ b/cpan/Math-BigInt/t/upgradef.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- use strict; use warnings; @@ -16,7 +16,7 @@ use overload; sub isa { my ($self, $class) = @_; - return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these + return if $class =~ /^Math::Big(Int|Float$)/; # we aren't one of these UNIVERSAL::isa($self, $class); } @@ -43,8 +43,8 @@ $LIB = "Math::BigInt::Calc"; # backend is(Math::BigFloat->upgrade(), $EXPECTED_CLASS, qq|Math::BigFloat->upgrade()|); -is(Math::BigFloat->downgrade() || '', '', - qq/Math::BigFloat->downgrade() || ''/); +is(Math::BigFloat->downgrade(), undef, + qq|Math::BigFloat->downgrade()|); $x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123); diff --git a/cpan/Math-BigInt/t/use.t b/cpan/Math-BigInt/t/use.t index d04a11afc1..a84e3dff21 100644 --- a/cpan/Math-BigInt/t/use.t +++ b/cpan/Math-BigInt/t/use.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# -*- mode: perl; -*- # use Module(); doesn't call import() - thanx for cpan testers David. M. Town # and Andreas Marcel Riechert for spotting it. It is fixed by the same code diff --git a/cpan/Math-BigInt/t/use_lib1.t b/cpan/Math-BigInt/t/use_lib1.t index 6c80a6af47..eb12b91fff 100644 --- a/cpan/Math-BigInt/t/use_lib1.t +++ b/cpan/Math-BigInt/t/use_lib1.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigFloat lib => 'BareCalc'; # loads "BareCalc" is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', "Math::BigInt->config('lib')"); diff --git a/cpan/Math-BigInt/t/use_lib2.t b/cpan/Math-BigInt/t/use_lib2.t index dc03e1f1e0..d3a7b45165 100644 --- a/cpan/Math-BigInt/t/use_lib2.t +++ b/cpan/Math-BigInt/t/use_lib2.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,10 +9,10 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigInt; # loads "Calc" +use Math::BigFloat lib => 'BareCalc'; # ignores "BareCalc" -is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', +is(Math::BigInt->config('lib'), 'Math::BigInt::Calc', "Math::BigInt->config('lib')"); is(Math::BigFloat->new(123)->badd(123), 246, diff --git a/cpan/Math-BigInt/t/use_lib3.t b/cpan/Math-BigInt/t/use_lib3.t index 2dcd72bdcd..bcf7967d19 100644 --- a/cpan/Math-BigInt/t/use_lib3.t +++ b/cpan/Math-BigInt/t/use_lib3.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt lib => 'BareCalc'; +use Math::BigInt lib => 'BareCalc'; # ignores "BareCalc" use Math::BigFloat; is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', diff --git a/cpan/Math-BigInt/t/use_lib4.t b/cpan/Math-BigInt/t/use_lib4.t index d5739c3776..190d7bbf17 100644 --- a/cpan/Math-BigInt/t/use_lib4.t +++ b/cpan/Math-BigInt/t/use_lib4.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent, except this, since the later overrides @@ -10,10 +10,10 @@ use lib 't'; use Test::More tests => 2; -use Math::BigInt lib => 'BareCalc'; -use Math::BigFloat lib => 'Calc'; +use Math::BigInt lib => 'BareCalc'; # loads "BareCalc" +use Math::BigFloat lib => 'Calc'; # ignores "Calc" -is(Math::BigInt->config('lib'), 'Math::BigInt::Calc', +is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', "Math::BigInt->config('lib')"); is(Math::BigFloat->new(123)->badd(123), 246, diff --git a/cpan/Math-BigInt/t/use_lib5.t b/cpan/Math-BigInt/t/use_lib5.t index 1c122dd134..9fff6c8593 100644 --- a/cpan/Math-BigInt/t/use_lib5.t +++ b/cpan/Math-BigInt/t/use_lib5.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,7 +9,7 @@ use lib 't'; use Test::More tests => 2; -use Math::BigFloat lib => 'BareCalc'; +use Math::BigFloat lib => 'BareCalc'; # loads "BareCalc" use Math::BigInt; is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', diff --git a/cpan/Math-BigInt/t/use_lib6.t b/cpan/Math-BigInt/t/use_lib6.t index 7271ca419d..cd0aea7774 100644 --- a/cpan/Math-BigInt/t/use_lib6.t +++ b/cpan/Math-BigInt/t/use_lib6.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent @@ -9,9 +9,8 @@ use lib 't'; use Test::More tests => 1; -use Math::BigInt lib => 'BareCalc'; -eval "use Math::BigFloat only => 'foobar';"; +use Math::BigInt lib => 'BareCalc'; # loads "BareCalc" +eval "use Math::BigFloat only => 'foobar';"; # ignores "foobar" -my $regex = "Couldn't load the specified math lib" - . ".*and fallback.*is disallowed"; -like($@, qr/$regex/); +is(Math::BigInt->config('lib'), 'Math::BigInt::BareCalc', + "Math::BigInt->config('lib')"); diff --git a/cpan/Math-BigInt/t/use_mbfw.t b/cpan/Math-BigInt/t/use_mbfw.t index 06d9c286eb..3b19c55c97 100644 --- a/cpan/Math-BigInt/t/use_mbfw.t +++ b/cpan/Math-BigInt/t/use_mbfw.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that using Math::BigFloat with "with" and "lib" at the same time works # broken in versions up to v1.63 diff --git a/cpan/Math-BigInt/t/with_sub.t b/cpan/Math-BigInt/t/with_sub.t index 75af3a3ec0..2f007ad616 100644 --- a/cpan/Math-BigInt/t/with_sub.t +++ b/cpan/Math-BigInt/t/with_sub.t @@ -1,11 +1,11 @@ -#!perl +# -*- mode: perl; -*- # Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass'; use strict; use warnings; -use Test::More tests => 3076 # tests in require'd file +use Test::More tests => 3070 # tests in require'd file + 1; # tests in this file use Math::BigFloat with => 'Math::BigInt::Subclass', diff --git a/cpan/Math-BigRat/lib/Math/BigRat.pm b/cpan/Math-BigRat/lib/Math/BigRat.pm index e799abd58b..5f3af33b3e 100644 --- a/cpan/Math-BigRat/lib/Math/BigRat.pm +++ b/cpan/Math-BigRat/lib/Math/BigRat.pm @@ -16,11 +16,12 @@ use 5.006; use strict; use warnings; -use Carp qw< carp croak >; +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; -use Math::BigFloat 1.999718; +use Math::BigFloat (); -our $VERSION = '0.2617'; +our $VERSION = '0.2620'; our @ISA = qw(Math::BigFloat); @@ -793,12 +794,21 @@ sub badd { ($class, $x, $y, @r) = objectify(2, @_); } - # +inf + +inf => +inf, -inf + -inf => -inf - return $x->binf(substr($x->{sign}, 0, 1)) - if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; - - # +inf + -inf or -inf + +inf => NaN - return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + unless ($x -> is_finite() && $y -> is_finite()) { + if ($x -> is_nan() || $y -> is_nan()) { + return $x -> bnan(@r); + } elsif ($x -> is_inf("+")) { + return $x -> bnan(@r) if $y -> is_inf("-"); + return $x -> binf("+", @r); + } elsif ($x -> is_inf("-")) { + return $x -> bnan(@r) if $y -> is_inf("+"); + return $x -> binf("-", @r); + } elsif ($y -> is_inf("+")) { + return $x -> binf("+", @r); + } elsif ($y -> is_inf("-")) { + return $x -> binf("-", @r); + } + } # 1 1 gcd(3, 4) = 1 1*3 + 1*4 7 # - + - = --------- = -- @@ -1115,6 +1125,20 @@ sub binc { $x->bnorm()->round(@r); } +sub binv { + my $x = shift; + my @r = @_; + + return $x if $x->modify('binv'); + + return $x if $x -> is_nan(); + return $x -> bzero() if $x -> is_inf(); + return $x -> binf("+") if $x -> is_zero(); + + ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n}); + $x -> round(@r); +} + ############################################################################## # is_foo methods (the rest is inherited) @@ -1206,6 +1230,35 @@ sub parts { ($n, $d); } +sub dparts { + my $x = shift; + my $class = ref $x; + + croak("dparts() is an instance method") unless $class; + + if ($x -> is_nan()) { + return $class -> bnan(), $class -> bnan() if wantarray; + return $class -> bnan(); + } + + if ($x -> is_inf()) { + return $class -> binf($x -> sign()), $class -> bzero() if wantarray; + return $class -> binf($x -> sign()); + } + + # 355/113 => 3 + 16/113 + + my ($q, $r) = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d}); + + my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q)); + return $int unless wantarray; + + my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r), + $LIB -> _str($x -> {_d})); + + return $int, $frc; +} + sub length { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); @@ -1353,11 +1406,11 @@ sub blog { # $x->blog(undef) signals that the base is Euler's number. if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { - # E.g., Math::BigFloat->blog(256, 2) + # E.g., Math::BigRat->blog(256, 2) ($class, $x, $base, @r) = defined $_[2] ? objectify(2, @_) : objectify(1, @_); } else { - # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2) + # E.g., Math::BigRat::blog(256, 2) or $x->blog(2) ($class, $x, $base, @r) = defined $_[1] ? objectify(2, @_) : objectify(1, @_); } @@ -1398,6 +1451,24 @@ sub blog { return $x -> binf($sign); } + # Now take care of the cases where $x and/or $base is 1/N. + # + # log(1/N) / log(B) = -log(N)/log(B) + # log(1/N) / log(1/B) = log(N)/log(B) + # log(N) / log(1/B) = -log(N)/log(B) + + my $neg = 0; + if ($x -> numerator() -> is_one()) { + $x -> binv(); + $neg = !$neg; + } + if (defined(blessed($base)) && $base -> isa($class)) { + if ($base -> numerator() -> is_one()) { + $base = $base -> copy() -> binv(); + $neg = !$neg; + } + } + # At this point we are done handling all exception cases and trivial cases. $base = Math::BigFloat -> new($base) if defined $base; @@ -1411,7 +1482,7 @@ sub blog { $x -> {_n} = $xtmp -> {_n}; $x -> {_d} = $xtmp -> {_d}; - return $x; + return $neg ? $x -> bneg() : $x; } sub bexp { @@ -1813,9 +1884,9 @@ sub bcmp { if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { # $x is NaN and/or $y is NaN - return undef if $x->{sign} eq $nan || $y->{sign} eq $nan; + return if $x->{sign} eq $nan || $y->{sign} eq $nan; # $x and $y are both either +inf or -inf - return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; # $x = +inf and $y < +inf return +1 if $x->{sign} eq '+inf'; # $x = -inf and $y > -inf @@ -1860,9 +1931,9 @@ sub bacmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; - return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; + return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; } @@ -1953,7 +2024,17 @@ sub numify { # Non-finite number. - return $x->bstr() if $x->{sign} !~ /^[+-]$/; + if ($x -> is_nan()) { + require Math::Complex; + my $inf = $Math::Complex::Inf; + return $inf - $inf; + } + + if ($x -> is_inf()) { + require Math::Complex; + my $inf = $Math::Complex::Inf; + return $x -> is_negative() ? -$inf : $inf; + } # Finite number. @@ -2029,18 +2110,27 @@ sub as_oct { sub from_hex { my $class = shift; - $class->new(@_); + # The relationship should probably go the otherway, i.e, that new() calls + # from_hex(). Fixme! + my ($x, @r) = @_; + $x =~ s|^\s*(?:0?[Xx]_*)?|0x|; + $class->new($x, @r); } sub from_bin { my $class = shift; - $class->new(@_); + # The relationship should probably go the otherway, i.e, that new() calls + # from_bin(). Fixme! + my ($x, @r) = @_; + $x =~ s|^\s*(?:0?[Bb]_*)?|0b|; + $class->new($x, @r); } sub from_oct { my $class = shift; + # Why is this different from from_hex() and from_bin()? Fixme! my @parts; for my $c (@_) { push @parts, Math::BigInt->from_oct($c); @@ -2053,53 +2143,97 @@ sub from_oct { sub import { my $class = shift; - my @a; - my $lib = ''; - my $try = 'try'; + my @a; # unrecognized arguments + my $lib_param = ''; + my $lib_value = ''; + + while (@_) { + my $param = shift; + + # Enable overloading of constants. + + if ($param eq ':constant') { + overload::constant + + integer => sub { + $class -> new(shift); + }, - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + float => sub { + $class -> new(shift); + }, - if ($_[$i] eq ':constant') { - # this rest causes overlord er load to step in - overload::constant float => sub { $class->new(shift); }; + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; } - #elsif ($_[$i] eq 'upgrade') { - # # this causes upgrading - # $upgrade = $_[$i+1]; # or undef to disable - # $i++; - #} + # Upgrading. - elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - elsif ($_[$i] =~ /^(lib|try|only)\z/) { - $lib = $_[$i+1] || ''; - $try = $1; # "lib", "try" or "only" - $i++; + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] eq 'with') { - # this argument is no longer used - # $LIB = $_[$i+1] || 'Calc'; - # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; - $i++; + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - else { - push @a, $_[$i]; + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { + # alternative library + $lib_param = $param; # "lib", "try", or "only" + $lib_value = shift; + next; } + + if ($param eq 'with') { + # alternative class for our private parts() + # XXX: no longer supported + # $LIB = shift() || 'Calc'; + # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; + shift; + next; + } + + # Unrecognized parameter. + + push @a, $param; } require Math::BigInt; my @import = ('objectify'); - push @import, $try, $lib if $lib ne ''; + push @import, $lib_param, $lib_value if $lib_param ne ''; Math::BigInt -> import(@import); # find out which one was actually loaded @@ -2211,6 +2345,10 @@ Returns a copy of the denominator (the part under the line) as positive BigInt. Return a list consisting of (signed) numerator and (unsigned) denominator as BigInts. +=item dparts() + +Returns the integer part and the fraction part. + =item numify() my $y = $x->numify(); @@ -2525,6 +2663,12 @@ does floored division (F-division), returning an integer $q and a remainder $r so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>. +=item binv() + + $x->binv(); + +Inverse of $x. + =item bdec() $x->bdec(); @@ -2705,6 +2849,70 @@ supported. =back +=head1 NUMERIC LITERALS + +After C<use Math::BigRat ':constant'> all numeric literals in the given scope +are converted to C<Math::BigRat> objects. This conversion happens at compile +time. Every non-integer is convert to a NaN. + +For example, + + perl -MMath::BigRat=:constant -le 'print 2**150' + +prints the exact value of C<2**150>. Note that without conversion of constants +to objects the expression C<2**150> is calculated using Perl scalars, which +leads to an inaccurate result. + +Please note that strings are not affected, so that + + use Math::BigRat qw/:constant/; + + $x = "1234567890123456789012345678901234567890" + + "123456789123456789"; + +does give you what you expect. You need an explicit Math::BigRat->new() around +at least one of the operands. You should also quote large constants to prevent +loss of precision: + + use Math::BigRat; + + $x = Math::BigRat->new("1234567889123456789123456789123456789"); + +Without the quotes Perl first converts the large number to a floating point +constant at compile time, and then converts the result to a Math::BigRat object +at run time, which results in an inaccurate result. + +=head2 Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. + +Hexadecimal floating point literals: + + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 + +Octal floating point literals (with "0" prefix): + + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 + +Octal floating point literals (with "0o" prefix) (requires v5.34.0): + + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 + +Binary floating point literals: + + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 + =head1 BUGS Please report any bugs or feature requests to diff --git a/cpan/Math-BigRat/t/badd-mbr.t b/cpan/Math-BigRat/t/badd-mbr.t new file mode 100644 index 0000000000..1f96200736 --- /dev/null +++ b/cpan/Math-BigRat/t/badd-mbr.t @@ -0,0 +1,164 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 173; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($xval, $yval, $zval) = split /:/; + my ($x, $y, $got, @got); + + for my $context_is_scalar (0, 1) { + for my $y_is_scalar (0, 1) { + + my $test = qq|\$x = $class -> new("$xval");|; + + $test .= $y_is_scalar + ? qq| \$y = "$yval";| + : qq| \$y = $class -> new("$yval");|; + + $test .= $context_is_scalar + ? qq| \$got = \$x -> badd(\$y);| + : qq| \@got = \$x -> badd(\$y);|; + + my $desc = "badd() in "; + $desc .= $context_is_scalar ? "scalar context" : "list context"; + $desc .= $y_is_scalar ? " with y as scalar" : " with y as object"; + + subtest $desc, + sub { + plan tests => $context_is_scalar ? 7 : 8; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + if ($context_is_scalar) { + + # Check output. + + is(ref($got), $class, + "'$test' output arg is a $class"); + + is($got -> bstr(), $zval, + "'$test' output arg has the right value"); + + } else { + + # Check number of output arguments. + + cmp_ok(scalar @got, '==', 1, + "'$test' gives one output arg"); + + # Check output. + + is(ref($got[0]), $class, + "'$test' output arg is a $class"); + + is($got[0] -> bstr(), $zval, + "'$test' output arg has the right value"); + } + + # Check the invocand. + + is(ref($x), $class, + "'$test' invocand is still a $class"); + + is($x -> bstr(), $zval, + "'$test' invocand has the right value"); + + # Check the input argument. + + if ($y_is_scalar) { + + is(ref($y), '', + "'$test' second input arg is still a scalar"); + + is($y, $yval, + "'$test' second input arg is unmodified"); + + } else { + + is(ref($y), $class, + "'$test' second input arg is still a $class"); + + is($y -> bstr(), $yval, + "'$test' second input arg is unmodified"); + } + }; + } + } +} + +__DATA__ + +# x and/or y is NaN + +NaN:NaN:NaN + +NaN:-inf:NaN +NaN:-3:NaN +NaN:0:NaN +NaN:3:NaN +NaN:inf:NaN + +-inf:NaN:NaN +-3:NaN:NaN +0:NaN:NaN +3:NaN:NaN +inf:NaN:NaN + +# x = inf + +inf:-inf:NaN +inf:-3:inf +inf:-2:inf +inf:-1:inf +inf:0:inf +inf:1:inf +inf:2:inf +inf:3:inf +inf:inf:inf + +# x = -inf + +-inf:-inf:-inf +-inf:-3:-inf +-inf:-2:-inf +-inf:-1:-inf +-inf:0:-inf +-inf:1:-inf +-inf:2:-inf +-inf:3:-inf +-inf:inf:NaN + +# y = inf + +-3:inf:inf +-2:inf:inf +-1:inf:inf +0:inf:inf +1:inf:inf +2:inf:inf +3:inf:inf + +# y = -inf + +-3:-inf:-inf +-2:-inf:-inf +-1:-inf:-inf +0:-inf:-inf +1:-inf:-inf +2:-inf:-inf +3:-inf:-inf diff --git a/cpan/Math-BigRat/t/big_ap.t b/cpan/Math-BigRat/t/big_ap.t index 1ac46e5d9f..dd114be707 100644 --- a/cpan/Math-BigRat/t/big_ap.t +++ b/cpan/Math-BigRat/t/big_ap.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test that accuracy() and precision() in BigInt/BigFloat do not disturb # the rounding force in BigRat. diff --git a/cpan/Math-BigRat/t/bigfltrt.t b/cpan/Math-BigRat/t/bigfltrt.t index 856318614f..27a17b2d81 100644 --- a/cpan/Math-BigRat/t/bigfltrt.t +++ b/cpan/Math-BigRat/t/bigfltrt.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/bigrat.t b/cpan/Math-BigRat/t/bigrat.t index fec6afd568..8c31cfe2dc 100644 --- a/cpan/Math-BigRat/t/bigrat.t +++ b/cpan/Math-BigRat/t/bigrat.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 202; +use Test::More tests => 201; # basic testing of Math::BigRat @@ -346,7 +346,8 @@ $x = $mbr->new('-7/5')->bsstr(); is($x, '-7/5'); ############################################################################## -# numify() + +note("numify()"); my @array = qw/1 2 3 4 5 6 7 8 9/; $x = $mbr->new('8/8'); @@ -367,23 +368,60 @@ is($array[$x], 6); $x = $mbr->new('-8/1'); is($array[$x], 2); # -8 => 2 -$x = $mbr->new('33/8'); -is($x->numify() * 1000, 4125); - -$x = $mbr->new('-33/8'); -is($x->numify() * 1000, -4125); - -$x = $mbr->new('inf'); -is($x->numify(), 'inf'); +require Math::Complex; -$x = $mbr->new('-inf'); -is($x->numify(), '-inf'); +my $inf = $Math::Complex::Inf; +my $nan = $inf - $inf; -$x = $mbr->new('NaN'); -is($x->numify(), 'NaN'); +sub isnumeric { + my $value = shift; + ($value ^ $value) eq "0"; +} -$x = $mbr->new('4/3'); -is($x->numify(), 4/3); +subtest qq|$mbr -> new("33/8") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("33/8") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", 4.125, '$x has the right value'); +}; + +subtest qq|$mbr -> new("-33/8") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("-33/8") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", -4.125, '$x has the right value'); +}; + +subtest qq|$mbr -> new("inf") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("inf") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", $inf, '$x has the right value'); +}; + +subtest qq|$mbr -> new("-inf") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("-inf") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "==", -$inf, '$x has the right value'); +}; + +subtest qq|$mbr -> new("NaN") -> numify()| => sub { + plan tests => 3; + + $x = $mbr -> new("NaN") -> numify(); + is(ref($x), "", '$x is a scalar'); + ok(isnumeric($x), '$x is numeric'); + cmp_ok($x, "!=", $nan, '$x has the right value'); # Note: NaN != NaN +}; ############################################################################## # as_hex(), as_bin(), as_oct() diff --git a/cpan/Math-BigRat/t/bigratpm.inc b/cpan/Math-BigRat/t/bigratpm.inc index b3015360b8..9d5f77ed09 100644 --- a/cpan/Math-BigRat/t/bigratpm.inc +++ b/cpan/Math-BigRat/t/bigratpm.inc @@ -318,9 +318,6 @@ NaN:1:NaN 5/2:2.5 3/2:1.5 5/4:1.25 -NaN:NaN -+inf:inf --inf:-inf &fnan abc:NaN @@ -361,10 +358,6 @@ inf/-5:-inf -inf/-5:inf 123:123 -123.4567:-1234567/10000 -# invalid inputs -1__2:NaN -1E1__2:NaN -11__2E2:NaN #1.E3:NaN .2E-3.:NaN #1e3e4:NaN diff --git a/cpan/Math-BigRat/t/bigratpm.t b/cpan/Math-BigRat/t/bigratpm.t index 40f9f6eb8a..d6d9641b21 100644 --- a/cpan/Math-BigRat/t/bigratpm.t +++ b/cpan/Math-BigRat/t/bigratpm.t @@ -1,9 +1,9 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 905; +use Test::More tests => 899; use Math::BigRat lib => 'Calc'; diff --git a/cpan/Math-BigRat/t/bigratup.t b/cpan/Math-BigRat/t/bigratup.t index f424486a52..1f9bf49c29 100644 --- a/cpan/Math-BigRat/t/bigratup.t +++ b/cpan/Math-BigRat/t/bigratup.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # Test whether $Math::BigInt::upgrade breaks our neck diff --git a/cpan/Math-BigRat/t/binv-mbr.t b/cpan/Math-BigRat/t/binv-mbr.t new file mode 100644 index 0000000000..dfba7fd652 --- /dev/null +++ b/cpan/Math-BigRat/t/binv-mbr.t @@ -0,0 +1,89 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 21; + +use Scalar::Util qw< refaddr >; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($xval, $yval) = split /:/; + my ($x, $got, @got); + + for my $context_is_scalar (0, 1) { + + my $test = qq|\$x = $class -> new("$xval");|; + + $test .= $context_is_scalar + ? qq| \$got = \$x -> binv();| + : qq| \@got = \$x -> binv();|; + + my $desc = "binv() in "; + $desc .= $context_is_scalar ? "scalar context" : "list context"; + + subtest $desc, + sub { + plan tests => $context_is_scalar ? 4 : 5; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + if ($context_is_scalar) { + + # Check output. + + is(ref($got), $class, + "'$test' output arg is a $class"); + + is($x -> bstr(), $yval, + "'$test' output arg has the right value"); + + is(refaddr($got), refaddr($x), + "'$test' output arg is the invocand"); + + } else { + + # Check number of output arguments. + + cmp_ok(scalar(@got), '==', 1, + "'$test' gives one output arg"); + + # Check output. + + is(ref($got[0]), $class, + "'$test' output arg is a $class"); + + is($got[0] -> bstr(), $yval, + "'$test' output arg has the right value"); + + is(refaddr($got[0]), refaddr($x), + "'$test' output arg is the invocand"); + } + }; + } +} + +__DATA__ + +NaN:NaN +inf:0 +5:1/5 +2:1/2 +1:1 +0:inf +-1:-1 +-2:-1/2 +-5:-1/5 +-inf:0 diff --git a/cpan/Math-BigRat/t/bitwise.t b/cpan/Math-BigRat/t/bitwise.t index 6bd499fa51..490b0f3dcf 100644 --- a/cpan/Math-BigRat/t/bitwise.t +++ b/cpan/Math-BigRat/t/bitwise.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/bnok-mbr.t b/cpan/Math-BigRat/t/bnok-mbr.t index 2328297497..7de6365d91 100644 --- a/cpan/Math-BigRat/t/bnok-mbr.t +++ b/cpan/Math-BigRat/t/bnok-mbr.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; diff --git a/cpan/Math-BigRat/t/const-mbr.t b/cpan/Math-BigRat/t/const-mbr.t new file mode 100644 index 0000000000..672882d3be --- /dev/null +++ b/cpan/Math-BigRat/t/const-mbr.t @@ -0,0 +1,319 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "171"; + +use Math::BigRat ":constant"; + +my $class = "Math::BigRat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix requires v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), $class, "value is a $class"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), $class, "value is a $class"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999" . + "/1000000000000000000000000000000000000000000000000000000000000000000000000", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "9999999999999999999999999999999999999999999999999999999999999999999999999" + . "/10", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "201/64", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "201/64", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +is(1.0 / 3.0, "1/3", + "1.0 / 3.0 = 1/3"); diff --git a/cpan/Math-BigRat/t/dparts-mbr.t b/cpan/Math-BigRat/t/dparts-mbr.t new file mode 100644 index 0000000000..454bf59a0f --- /dev/null +++ b/cpan/Math-BigRat/t/dparts-mbr.t @@ -0,0 +1,67 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 17; + +my $class; + +BEGIN { + $class = 'Math::BigRat'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($x_str, $int_str, $frc_str) = split /:/; + my $test; + + $test = qq|\$x = $class -> new("$x_str");| + . qq| (\$i, \$f) = \$x -> dparts();|; + + subtest $test => sub { + plan tests => 5; + + my $x = $class -> new($x_str); + my ($int_got, $frc_got) = $x -> dparts(); + + is(ref($int_got), $class, "class of integer part"); + is(ref($frc_got), $class, "class of fraction part"); + + is($int_got, $int_str, "value of integer part"); + is($frc_got, $frc_str, "value of fraction part"); + is($x, $x_str, "input is unmodified"); + }; + + $test = qq|\$x = $class -> new("$x_str");| + . qq| \$i = \$x -> dparts();|; + + subtest $test => sub { + plan tests => 3, + + my $x = $class -> new($x_str); + my $int_got = $x -> dparts(); + + isa_ok($int_got, $class); + + is($int_got, $int_str, "value of integer part"); + is($x, $x_str, "input is unmodified"); + }; +} + +__DATA__ + +NaN:NaN:NaN + +inf:inf:0 +-inf:-inf:0 + +-9/4:-2:-1/4 +-1:-1:0 +0:0:0 +1:1:0 +9/4:2:1/4 diff --git a/cpan/Math-BigRat/t/hang.t b/cpan/Math-BigRat/t/hang.t index 21b9304cbd..3e8637749e 100644 --- a/cpan/Math-BigRat/t/hang.t +++ b/cpan/Math-BigRat/t/hang.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test for bug #34584: hang in exp(1/2) diff --git a/cpan/Math-BigRat/t/new-mbr.t b/cpan/Math-BigRat/t/new-mbr.t index dad99428d1..24da7a8356 100644 --- a/cpan/Math-BigRat/t/new-mbr.t +++ b/cpan/Math-BigRat/t/new-mbr.t @@ -1,21 +1,25 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; -use Math::BigRat; +use Test::More tests => 8; + +my $class; + +BEGIN { $class = 'Math::BigRat'; } +BEGIN { use_ok($class); } use Scalar::Util qw< refaddr >; # CPAN RT #132712. -my $q1 = Math::BigRat -> new("-1/2"); +my $q1 = $class -> new("-1/2"); my ($n, $d) = $q1 -> parts(); my $n_orig = $n -> copy(); my $d_orig = $d -> copy(); -my $q2 = Math::BigRat -> new($n, $d); +my $q2 = $class -> new($n, $d); cmp_ok($n, "==", $n_orig, "The value of the numerator hasn't changed"); @@ -26,3 +30,39 @@ isnt(refaddr($n), refaddr($n_orig), "The addresses of the numerators have changed"); isnt(refaddr($d), refaddr($d_orig), "The addresses of the denominators have changed"); + +# new() + +{ + my $x = $class -> new(); + subtest qq|\$x = $class -> new();|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} + +# new("") + +{ + my $x = $class -> new(""); + subtest qq|\$x = $class -> new("");|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "NaN", 'output arg has the right value'); + }; +} + +# new(undef) + +{ + my $x = $class -> new(undef); + subtest qq|\$x = $class -> new(undef);|, => sub { + plan tests => 2; + + is(ref($x), $class, "output arg is a $class"); + is($x, "0", 'output arg has the right value'); + }; +} diff --git a/cpan/Math-BigRat/t/requirer.t b/cpan/Math-BigRat/t/requirer.t index 6788783a29..4e2fadb969 100644 --- a/cpan/Math-BigRat/t/requirer.t +++ b/cpan/Math-BigRat/t/requirer.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check that simple requiring BigRat works diff --git a/cpan/Math-BigRat/t/rt121139.t b/cpan/Math-BigRat/t/rt121139.t index b0cd214ad3..97f28a9060 100644 --- a/cpan/Math-BigRat/t/rt121139.t +++ b/cpan/Math-BigRat/t/rt121139.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # check for cpan rt #121139 diff --git a/cpan/Math-BigRat/t/trap.t b/cpan/Math-BigRat/t/trap.t index bab85d4e5d..a61abb9b45 100644 --- a/cpan/Math-BigRat/t/trap.t +++ b/cpan/Math-BigRat/t/trap.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- # test that config( trap_nan => 1, trap_inf => 1) really works/dies diff --git a/cpan/bignum/gentest/scope-nested-const.sh b/cpan/bignum/gentest/scope-nested-const.sh new file mode 100644 index 0000000000..9dde4a52c5 --- /dev/null +++ b/cpan/bignum/gentest/scope-nested-const.sh @@ -0,0 +1,78 @@ +#!/bin/sh +# -*- mode: cperl; coding: utf-8-unix; -*- + +eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}' + if 0; + +#!perl +#line 9 + +use strict; +use warnings; + +use Algorithm::Combinatorics 'permutations'; + +my $data = [ + ['bigint', 'Math::BigInt' ], + ['bignum', 'Math::BigFloat'], + ['bigrat', 'Math::BigRat' ], + ]; + +print <<"EOF"; +#!perl + +use strict; +use warnings; + +use Test::More tests => 48; +EOF + +my $iter = permutations([0, 1, 2]); +while (my $idxs = $iter -> next()) { + + my $p0 = $data -> [ $idxs -> [0] ][0]; + my $c0 = $data -> [ $idxs -> [0] ][1]; + my $p1 = $data -> [ $idxs -> [1] ][0]; + my $c1 = $data -> [ $idxs -> [1] ][1]; + my $p2 = $data -> [ $idxs -> [2] ][0]; + my $c2 = $data -> [ $idxs -> [2] ][1]; + + print <<"EOF"; + +note "\\n$p0 -> $p1 -> $p2\\n\\n"; + +{ + note "use $p0;"; + use $p0; + is(ref(1), "$c0"); + + { + note "use $p1;"; + use $p1; + is(ref(1), "$c1"); + + { + note "use $p2;"; + use $p2; + is(ref(1), "$c2"); + + note "no $p2;"; + no $p2; + is(ref(1), ""); + } + + is(ref(1), "$c1"); + + note "no $p1;"; + no $p1; + is(ref(1), ""); + } + + is(ref(1), "$c0"); + + note "no $p0;"; + no $p0; + is(ref(1), ""); +} +EOF +} diff --git a/cpan/bignum/gentest/scope-nested-hex-oct.sh b/cpan/bignum/gentest/scope-nested-hex-oct.sh new file mode 100644 index 0000000000..c91a454906 --- /dev/null +++ b/cpan/bignum/gentest/scope-nested-hex-oct.sh @@ -0,0 +1,86 @@ +#!/bin/sh +# -*- mode: cperl; coding: utf-8-unix; -*- + +eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}' + if 0; + +#!perl +#line 9 + +use strict; +use warnings; + +use Algorithm::Combinatorics 'permutations'; + +my $data = [ + ['bigint', 'Math::BigInt' ], + ['bignum', 'Math::BigFloat'], + ['bigrat', 'Math::BigRat' ], + ]; + +print <<"EOF"; +#!perl + +use strict; +use warnings; + +use Test::More tests => 96; +EOF + +my $iter = permutations([0, 1, 2]); +while (my $idxs = $iter -> next()) { + + my $p0 = $data -> [ $idxs -> [0] ][0]; + my $c0 = $data -> [ $idxs -> [0] ][1]; + my $p1 = $data -> [ $idxs -> [1] ][0]; + my $c1 = $data -> [ $idxs -> [1] ][1]; + my $p2 = $data -> [ $idxs -> [2] ][0]; + my $c2 = $data -> [ $idxs -> [2] ][1]; + + print <<"EOF"; + +note "\\n$p0 -> $p1 -> $p2\\n\\n"; + +{ + note "use $p0;"; + use $p0; + is(ref(hex("1")), "$c0", 'ref(hex("1"))'); + is(ref(oct("1")), "$c0", 'ref(oct("1"))'); + + { + note "use $p1;"; + use $p1; + is(ref(hex("1")), "$c1", 'ref(hex("1"))'); + is(ref(oct("1")), "$c1", 'ref(oct("1"))'); + + { + note "use $p2;"; + use $p2; + is(ref(hex("1")), "$c2", 'ref(hex("1"))'); + is(ref(oct("1")), "$c2", 'ref(oct("1"))'); + + note "no $p2;"; + no $p2; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "$c1", 'ref(hex("1"))'); + is(ref(oct("1")), "$c1", 'ref(oct("1"))'); + + note "no $p1;"; + no $p1; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "$c0", 'ref(hex("1"))'); + is(ref(oct("1")), "$c0", 'ref(oct("1"))'); + + note "no $p0;"; + no $p0; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} +EOF +} diff --git a/cpan/bignum/lib/Math/BigFloat/Trace.pm b/cpan/bignum/lib/Math/BigFloat/Trace.pm index 2ff54e3015..01126a17ca 100644 --- a/cpan/bignum/lib/Math/BigFloat/Trace.pm +++ b/cpan/bignum/lib/Math/BigFloat/Trace.pm @@ -1,58 +1,76 @@ -#!perl +# -*- mode: perl; -*- package Math::BigFloat::Trace; -require 5.010; use strict; use warnings; use Exporter; use Math::BigFloat; -our ($accuracy, $precision, $round_mode, $div_scale); - our @ISA = qw(Exporter Math::BigFloat); -our $VERSION = '0.53'; +our $VERSION = '0.63'; use overload; # inherit overload from Math::BigFloat # Globals -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; - my $self = Math::BigFloat->new($value, $a, $p, $round_mode); - # remember, downgrading may return a BigInt, so don't meddle with class - # bless $self, $class; + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigFloat new '%s' => '%s' (%s)\n", + $value, $self, ref($self); - print "MBF new '$value' => '$self' (", ref($self), ")"; return $self; } sub import { - print "MBF import ", join(' ', @_); - my $self = shift; + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, - # we catch the constants, the rest goes go BigFloat - my @a = (); - foreach (@_) { - push @a, $_ if $_ ne ':constant'; + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; } - overload::constant float => sub { $self->new(shift); }; - Math::BigFloat->import(@a); # need it for subclasses -# $self->export_to_level(1,$self,@_); # need this ? + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? } 1; diff --git a/cpan/bignum/lib/Math/BigInt/Trace.pm b/cpan/bignum/lib/Math/BigInt/Trace.pm index 833927c1f4..2fbd6aae32 100644 --- a/cpan/bignum/lib/Math/BigInt/Trace.pm +++ b/cpan/bignum/lib/Math/BigInt/Trace.pm @@ -1,48 +1,76 @@ -#!perl +# -*- mode: perl; -*- package Math::BigInt::Trace; -require 5.010; use strict; use warnings; use Exporter; use Math::BigInt; -our ($accuracy, $precision, $round_mode, $div_scale); - our @ISA = qw(Exporter Math::BigInt); -our $VERSION = '0.53'; +our $VERSION = '0.63'; use overload; # inherit overload from Math::BigInt # Globals -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; + my $a = $accuracy; $a = $_[0] if defined $_[0]; + my $p = $precision; $p = $_[1] if defined $_[1]; - my $self = Math::BigInt->new($value, $a, $p, $round_mode); - bless $self, $class; - print "MBI new '$value' => '$self' (", ref($self), ")"; + + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigInt new '%s' => '%s' (%s)\n", + $value, $self, ref($self); + return $self; } sub import { - print "MBI import ", join(' ', @_); - my $self = shift; - Math::BigInt::import($self, @_); # need it for subclasses -# $self->export_to_level(1, $self, @_); # need this ? - @_ = (); + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + } + + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? } 1; diff --git a/cpan/bignum/lib/Math/BigRat/Trace.pm b/cpan/bignum/lib/Math/BigRat/Trace.pm new file mode 100644 index 0000000000..8d370c7df5 --- /dev/null +++ b/cpan/bignum/lib/Math/BigRat/Trace.pm @@ -0,0 +1,76 @@ +# -*- mode: perl; -*- + +package Math::BigRat::Trace; + +use strict; +use warnings; + +use Exporter; +use Math::BigRat; + +our @ISA = qw(Exporter Math::BigRat); + +our $VERSION = '0.63'; + +use overload; # inherit overload from Math::BigRat + +# Globals +our $accuracy = undef; +our $precision = undef; +our $round_mode = 'even'; +our $div_scale = 40; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift; + + my $a = $accuracy; + $a = $_[0] if defined $_[0]; + + my $p = $precision; + $p = $_[1] if defined $_[1]; + + my $self = $class -> SUPER::new($value, $a, $p, $round_mode); + + printf "Math::BigRat new '%s' => '%s' (%s)\n", + $value, $self, ref($self); + + return $self; +} + +sub import { + my $class = shift; + + printf "%s -> import(%s)\n", $class, join(", ", @_); + + # we catch the constants, the rest goes to parent + + my $constant = grep { $_ eq ':constant' } @_; + my @a = grep { $_ ne ':constant' } @_; + + if ($constant) { + overload::constant + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + } + + $class -> SUPER::import(@a); # need it for subclasses + #$self -> export_to_level(1, $class, @_); # need this ? +} + +1; diff --git a/cpan/bignum/lib/bigint.pm b/cpan/bignum/lib/bigint.pm index 060ff4dda4..d0e3799e07 100644 --- a/cpan/bignum/lib/bigint.pm +++ b/cpan/bignum/lib/bigint.pm @@ -1,10 +1,11 @@ package bigint; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; our @ISA = qw( Exporter ); @@ -12,94 +13,40 @@ our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; +use Math::BigInt; -############################################################################## +my $obj_class = "Math::BigInt"; -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bigint::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - return Math::BigInt->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +############################################################################## - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bigint\-\>$name, not a valid method"); +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -sub upgrade { - $Math::BigInt::upgrade; +sub precision { + my $self = shift; + $obj_class -> precision(@_); } -sub _binary_constant { - # this takes a binary/hexadecimal/octal constant string and returns it - # as string suitable for new. Basically it converts octal to decimal, and - # passes every thing else unmodified back. - my $string = shift; - - return Math::BigInt->new($string) if $string =~ /^0[bx]/; +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); +} - # so it must be an octal constant - Math::BigInt->from_oct($string); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); } -sub _float_constant { - # this takes a floating point constant string and returns it truncated to - # integer. For instance, '4.5' => '4', '1.234e2' => '123' etc - my $float = shift; - - # some simple cases first - return $float if ($float =~ /^[+-]?[0-9]+$/); # '+123','-1','0' etc - return $float - if ($float =~ /^[+-]?[0-9]+\.?[eE]\+?[0-9]+$/); # 123e2, 123.e+2 - return '0' if ($float =~ /^[+-]?[0]*\.[0-9]+$/); # .2, 0.2, -.1 - if ($float =~ /^[+-]?[0-9]+\.[0-9]*$/) { # 1., 1.23, -1.2 etc - $float =~ s/\..*//; - return $float; - } - my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($float); - return $float if !defined $mis; # doesn't look like a number to me - my $ec = int($$ev); - my $sign = $$mis; - $sign = '' if $sign eq '+'; - if ($$es eq '-') { - # ignore fraction part entirely - if ($ec >= length($$miv)) { # 123.23E-4 - return '0'; - } - return $sign . substr($$miv, 0, length($$miv) - $ec); # 1234.45E-2 = 12 - } - # xE+y - if ($ec >= length($$mfv)) { - $ec -= length($$mfv); - return $sign.$$miv.$$mfv if $ec == 0; # 123.45E+2 => 12345 - return $sign.$$miv.$$mfv.'E'.$ec; # 123.45e+3 => 12345e1 - } - $mfv = substr($$mfv, 0, $ec); - $sign.$$miv.$mfv; # 123.45e+1 => 1234 +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); } -sub unimport { - $^H{bigint} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -108,6 +55,81 @@ sub in_effect { $hinthash->{bigint}; } +sub _float_constant { + my $str = shift; + + # We can't pass input directly to new() because of the way it handles the + # combination of non-integers with no upgrading. Such cases are by + # Math::BigInt returned as NaN, but we truncate to an integer. + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + my $pos = index($nstr, 'e'); + my $expo_sgn = substr($nstr, $pos + 1, 1); + my $sign = substr($nstr, 0, 1); + my $mant = substr($nstr, 1, $pos - 1); + my $mant_len = CORE::length($mant); + my $expo = substr($nstr, $pos + 2); + + if ($expo_sgn eq '-') { + my $upgrade = $obj_class -> upgrade(); + return $upgrade -> new($nstr) if defined $upgrade; + + if ($mant_len <= $expo) { + return $obj_class -> bzero(); # underflow + } else { + $mant = substr $mant, 0, $mant_len - $expo; # truncate + return $obj_class -> new($sign . $mant); + } + } else { + $mant .= "0" x $expo; # pad with zeros + return $obj_class -> new($sign . $mant); + } + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# # the following two routines are for "use bigint qw/hex oct/;": @@ -126,9 +148,9 @@ sub _hex_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_hex($chrs); + $x = $obj_class -> from_hex($chrs); } else { - $x = Math::BigInt -> bzero(); + $x = $obj_class -> bzero(); } # Warn about trailing garbage. @@ -166,7 +188,7 @@ sub _oct_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_bin($chrs); + $x = $obj_class -> from_bin($chrs); } # Warn about trailing garbage. @@ -187,7 +209,7 @@ sub _oct_core { my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; - $x = Math::BigInt -> from_oct($chrs); + $x = $obj_class -> from_oct($chrs); } # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it @@ -227,16 +249,20 @@ my ($prev_oct, $prev_hex, $overridden); if (LEXICAL) { eval <<'.' } sub _hex(_) { my $hh = (caller 0)[10]; - return $prev_hex ? &$prev_hex($_[0]) : CORE::hex($_[0]) - unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat}; - _hex_core($_[0]); + return $$hh{bigint} ? bigint::_hex_core($_[0]) + : $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); } sub _oct(_) { my $hh = (caller 0)[10]; - return $prev_oct ? &$prev_oct($_[0]) : CORE::oct($_[0]) - unless $$hh{bigint}||$$hh{bignum}||$$hh{bigrat}; - _oct_core($_[0]); + return $$hh{bigint} ? bigint::_oct_core($_[0]) + : $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); } . @@ -247,128 +273,153 @@ sub _override { no warnings 'redefine'; *CORE::GLOBAL::oct = \&_oct; *CORE::GLOBAL::hex = \&_hex; - $overridden++; + $overridden = 1; +} + +sub unimport { + $^H{bigint} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); } sub import { - my $self = shift; + my $class = shift; $^H{bigint} = 1; # we are in effect + $^H{bignum} = undef; + $^H{bigrat} = undef; # for newer Perls always override hex() and oct() with a lexical version: if (LEXICAL) { _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($ver, $trace); # version? trace? - my ($a, $p); # accuracy, precision - for (my $i = 0; $i < $l; $i++, $j++) { - if ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(v|version)$/) { + + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? trace? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; + } + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; + } + + if ($param =~ /^(v|version)$/) { $ver = 1; - splice @a, $j, 1; - $j--; - } elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; - } elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/) { - die ("unknown option $_[$i]"); + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - } else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; + } + + croak("Unknown option '$param'"); } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import); - bigint->accuracy($a) if defined $a; - bigint->precision($p) if defined $p; + $obj_class -> import(@import); + if ($ver) { - print "bigint\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # we take care of floating point constants, since BigFloat isn't available - # and BigInt doesn't like them: - overload::constant float => - sub { - Math::BigInt->new(_float_constant(shift)); - }; - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - _binary_constant(shift); - }; - # if another big* was already loaded: - my ($package) = caller(); + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN, e and PI - } + overload::constant + + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); + }; } -sub inf () { Math::BigInt->binf(); } -sub NaN () { Math::BigInt->bnan(); } +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } + +sub PI () { $obj_class -> new(3); } +sub e () { $obj_class -> new(2); } + +sub bpi ($) { $obj_class -> new(3); } -sub PI () { Math::BigInt->new(3); } -sub e () { Math::BigInt->new(2); } -sub bpi ($) { Math::BigInt->new(3); } sub bexp ($$) { - my $x = Math::BigInt->new($_[0]); - $x->bexp($_[1]); + my $x = $obj_class -> new(shift); + $x -> bexp(@_); } 1; @@ -379,44 +430,82 @@ __END__ =head1 NAME -bigint - Transparent BigInteger support for Perl +bigint - transparent big integer support for Perl =head1 SYNOPSIS use bigint; - $x = 2 + 4.5,"\n"; # BigInt 6 - print 2 ** 512,"\n"; # really is what you think it is - print inf + 42,"\n"; # inf - print NaN * 7,"\n"; # NaN - print hex("0x1234567890123490"),"\n"; # Perl v5.10.0 or later + $x = 2 + 4.5; # Math::BigInt 6 + print 2 ** 512; # Math::BigInt 134...096 + print inf + 42; # Math::BigInt inf + print NaN * 7; # Math::BigInt NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bigint; - print 2 ** 256,"\n"; # a normal Perl scalar now + print 2 ** 256; # a normal Perl scalar now } - # Import into current package: + # for older Perls, import into current package: use bigint qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION +All numeric literal in the given scope are converted to Math::BigInt objects. +Numeric literal that represent non-integers are truncated to an integer. All +results of expressions are also truncated to integer. + All operators (including basic math operations) except the range operator C<..> -are overloaded. Integer constants are created as proper BigInts. +are overloaded. -Floating point constants are truncated to integer. All parts and results of -expressions are also truncated. +Unlike the L<integer> pragma, the C<bigint> pragma creates integers that are +only limited in their size by the available memory. -Unlike L<integer>, this pragma creates integer constants that are only -limited in their size by the available memory and CPU time. +So, the following: + + use bigint; + $x = 1234; + +creates a Math::BigInt and stores a reference to in $x. This happens +transparently and behind your back, so to speak. + +You can see this with the following: + + perl -Mbigint -le 'print ref(1234)' + +Since numbers are actually objects, you can call all the usual methods from +Math::BigFloat on them. This even works to some extent on expressions: + + perl -Mbigint -le '$x = 1234; print $x->bdec()' + perl -Mbigint -le 'print 1234->copy()->binc();' + perl -Mbigint -le 'print 1234->copy()->binc->badd(6);' + perl -Mbigint -le 'print +(1234)->copy()->binc()' + +(Note that print doesn't do what you expect if the expression starts with +'(' hence the C<+>) + +You can even chain the operations together as usual: + + perl -Mbigint -le 'print 1234->copy()->binc->badd(6);' + 1241 + +Please note the following does not work as expected (prints nothing), since +overloading of '..' is not yet possible in Perl (as of v5.8.0): + + perl -Mbigint -le 'for (1..2) { print ref($_); }' =head2 use integer vs. use bigint -There is one small difference between C<use integer> and C<use bigint>: the -former will not affect assignments to variables and the return value of -some functions. C<bigint> truncates these results to integer too: +There are some difference between C<use integer> and C<use bigint>. + +Whereas C<use integer> is limited to what can be handled as a Perl scalar, C<use +bigint> can handle arbitrarily large integers. + +Also, C<use integer> does affect assignments to variables and the return value +of some functions. C<use bigint> truncates these results to integer: # perl -Minteger -wle 'print 3.2' 3.2 @@ -436,9 +525,9 @@ some functions. C<bigint> truncates these results to integer too: # perl -Minteger -wle 'print exp(1) + 0' 2 -In practice this makes seldom a difference as B<parts and results> of -expressions will be truncated anyway, but this can, for instance, affect the -return value of subroutines: +In practice this seldom makes a difference for small integers as B<parts and +results> of expressions are truncated anyway, but this can, for instance, affect +the return value of subroutines: sub three_integer { use integer; return 3.2; } sub three_bigint { use bigint; return 3.2; } @@ -447,16 +536,15 @@ return value of subroutines: =head2 Options -bigint recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +C<bigint> recognizes some options that can be passed while loading it via +C<use>. The following options exist: -=over 2 +=over 4 =item a or accuracy This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +than or equal to zero. See Math::BigInt's bround() method for details. perl -Mbigint=a,2 -le 'print 12345+1' @@ -465,54 +553,45 @@ Note that setting precision and accuracy at the same time is not possible. =item p or precision This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, and -are <B>ignored</B> since all operations happen in integer space. -A positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer and are ignore like negative values. - -See Math::BigInt's bfround() function for details. +integer. Negative values mean a fixed number of digits after the dot, and are +ignored since all operations happen in integer space. A positive value rounds to +this digit left from the dot. 0 means round to integer. See Math::BigInt's +bfround() method for details. - perl -Mbignum=p,5 -le 'print 123456789+123' + perl -mbigint=p,5 -le 'print 123456789+123' Note that setting precision and accuracy at the same time is not possible. =item t or trace -This enables a trace mode and is primarily for debugging bigint or -Math::BigInt. - -=item hex +This enables a trace mode and is primarily for debugging. -Override the built-in hex() method with a version that can handle big -integers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bigint pragma is active. - -=item oct - -Override the built-in oct() method with a version that can handle big -integers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigint pragma is active. - -=item l, lib, try or only +=item l, lib, try, or only Load a different math lib, see L<Math Library>. + perl -Mbigint=l,GMP -e 'print 2 ** 512' perl -Mbigint=lib,GMP -e 'print 2 ** 512' perl -Mbigint=try,GMP -e 'print 2 ** 512' perl -Mbigint=only,GMP -e 'print 2 ** 512' -Currently there is no way to specify more than one library on the command -line. This means the following does not work: +=item hex - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bigint> pragma is active. -This will be hopefully fixed soon ;) +=item oct + +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bigint> pragma is active. =item v or version -This prints out the name and version of all modules used and then exits. +this prints out the name and version of the modules and then exits. perl -Mbigint=v @@ -520,59 +599,36 @@ This prints out the name and version of all modules used and then exits. =head2 Math Library -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: use bigint lib => 'Calc'; -You can change this by using: +you can change this by using: - use bignum lib => 'GMP'; + use bigint lib => 'GMP'; -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: use bigint lib => 'Foo,Math::BigInt::Bar'; -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: - use bignum try => 'GMP'; + use bigint try => 'GMP'; If you want the code to die instead of falling back, use C<only> instead: - use bignum only => 'GMP'; - -Please see respective module documentation for further details. - -=head2 Internal Format + use bigint only => 'GMP'; -The numbers are stored as objects, and their internals might change at anytime, -especially between math operations. The objects also might belong to different -classes, like Math::BigInt, or Math::BigInt::Lite. Mixing them together, even -with normal scalars is not extraordinary, but normal and expected. - -You should not depend on the internal format, all accesses must go through -accessor methods. E.g. looking at $x->{sign} is not a good idea since there -is no guaranty that the object in question has such a hash key, nor is a hash -underneath at all. - -=head2 Sign - -The sign is either '+', '-', 'NaN', '+inf' or '-inf'. -You can access it with the sign() method. - -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +Please see the respective module documentation for further details. =head2 Method calls -Since all numbers are now objects, you can use all functions that are part of -the BigInt API. You can only use the bxxx() notation, and not the fxxx() -notation, though. +Since all numbers are now objects, you can use all methods that are part of the +Math::BigInt API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -580,14 +636,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -603,12 +659,12 @@ Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigInt for further details. =head2 Methods -=over 2 +=over 4 =item inf() @@ -624,24 +680,23 @@ handle bareword C<NaN> properly. # perl -Mbigint=e -wle 'print e' -Returns Euler's number C<e>, aka exp(1). Note that under bigint, this is -truncated to an integer, and hence simple '2'. +Returns Euler's number C<e>, aka exp(1). Note that under C<bigint>, this is +truncated to an integer, i.e., 2. =item PI # perl -Mbigint=PI -wle 'print PI' -Returns PI. Note that under bigint, this is truncated to an integer, and hence -simple '3'. +Returns PI. Note that under C<bigint>, this is truncated to an integer, i.e., 3. =item bexp() - bexp($power,$accuracy); + bexp($power, $accuracy); -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. -Note that under bigint, the result is truncated to an integer. +Note that under C<bigint>, the result is truncated to an integer. Example: @@ -651,8 +706,8 @@ Example: bpi($accuracy); -Returns PI to the wanted accuracy. Note that under bigint, this is truncated -to an integer, and hence simple '3'. +Returns PI to the wanted accuracy. Note that under C<bigint>, this is truncated +to an integer, i.e., 3. Example: @@ -661,7 +716,7 @@ Example: =item upgrade() Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. +C<Math::BigInt-E<gt>upgrade()>. =item in_effect() @@ -670,7 +725,7 @@ C<$Math::BigInt::upgrade>. print "in effect\n" if bigint::in_effect; # true { no bigint; - print "in effect\n" if bigint::in_effect; # false + print "in effect\n" if bigint::in_effect; # false } Returns true or false if C<bigint> is in effect in the current scope. @@ -681,39 +736,45 @@ This method only works on Perl v5.9.4 or later. =head1 CAVEATS -=over 2 +=over 4 + +=item Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bigint> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> objects. +C<bigint> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigInt> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: - use bignum; + use bigint; my $x = "900000000000000009"; my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigint> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> objects, use a literal number in the expression: +outputs C<0> on default 32-bit builds, since C<bigint> never sees the string +literals. To ensure the expression is all treated as C<Math::BigInt> objects, +use a literal number in the expression: print +(0+$x) - $y; -=item ranges +=item Ranges -Perl does not allow overloading of ranges, so you can neither safely use -ranges with bigint endpoints, nor is the iterator variable a bigint. +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bigint> endpoints, nor is the iterator variable a C<Math::BigInt>. use 5.010; for my $i (12..13) { for my $j (20..21) { say $i ** $j; # produces a floating-point number, - # not a big integer + # not an object } } @@ -723,11 +784,11 @@ This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bigint> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bigint>: use bigint qw/hex oct/; @@ -748,17 +809,6 @@ Compare this to: =back -=head1 MODULES USED - -C<bigint> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. - -The following modules are currently used by bigint: - - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - =head1 EXAMPLES Some cool command line examples to impress the Python crowd ;) You might want @@ -767,19 +817,16 @@ to compare them to the results under -Mbignum or -Mbigrat: perl -Mbigint -le 'print sqrt(33)' perl -Mbigint -le 'print 2*255' perl -Mbigint -le 'print 4.5+2*255' - perl -Mbigint -le 'print 3/7 + 5/7 + 8/3' perl -Mbigint -le 'print 123->is_odd()' - perl -Mbigint -le 'print log(2)' - perl -Mbigint -le 'print 2 ** 0.5' - perl -Mbigint=a,65 -le 'print 2 ** 0.2' - perl -Mbignum=a,65,l,GMP -le 'print 7 ** 7777' + perl -Mbigint=l,GMP -le 'print 7 ** 7777' =head1 BUGS -For information about bugs and how to report them, see the BUGS section in the -documentation available with the perldoc command. - - perldoc bignum +Please report any bugs or feature requests to +C<bug-bignum at rt.cpan.org>, or through the web interface at +L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). +We will be notified, and then you'll automatically be notified of +progress on your bug as I make changes. =head1 SUPPORT @@ -787,10 +834,31 @@ You can find documentation for this module with the perldoc command. perldoc bigint -For more information, see the SUPPORT section in the documentation available -with the perldoc command. +You can also look for information at: + +=over 4 + +=item * GitHub + +L<https://github.com/pjacklam/p5-bignum> - perldoc bignum +=item * RT: CPAN's request tracker + +L<https://rt.cpan.org/Dist/Display.html?Name=bignum> + +=item * MetaCPAN + +L<https://metacpan.org/release/bignum> + +=item * CPAN Testers Matrix + +L<http://matrix.cpantesters.org/?dist=bignum> + +=item * CPAN Ratings + +L<https://cpanratings.perl.org/dist/bignum> + +=back =head1 LICENSE diff --git a/cpan/bignum/lib/bignum.pm b/cpan/bignum/lib/bignum.pm index fb390fc6a0..a0c07a4d42 100644 --- a/cpan/bignum/lib/bignum.pm +++ b/cpan/bignum/lib/bignum.pm @@ -1,62 +1,52 @@ package bignum; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; -our @ISA = qw( bigint ); +our @ISA = qw( Exporter ); our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; -use bigint (); +use Math::BigFloat; + +my $obj_class = "Math::BigFloat"; ############################################################################## -BEGIN { - *inf = \&bigint::inf; - *NaN = \&bigint::NaN; - *hex = \&bigint::hex; - *oct = \&bigint::oct; +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bignum::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - Math::BigInt->$name($_[0]); - return Math::BigFloat->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +sub precision { + my $self = shift; + $obj_class -> precision(@_); +} - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bignum\-\>$name, not a valid method"); +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); } -sub unimport { - $^H{bignum} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); +} + +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); +} + +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -65,157 +55,364 @@ sub in_effect { $hinthash->{bignum}; } +sub _float_constant { + my $str = shift; + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + return $obj_class -> new($nstr); + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# +# the following two routines are for "use bignum qw/hex oct/;": + +use constant LEXICAL => $] > 5.009004; + +# Internal function with the same semantics as CORE::hex(). This function is +# not used directly, but rather by other front-end functions. + +sub _hex_core { + my $str = shift; + + # Strip off, clean, and parse as much as we can from the beginning. + + my $x; + if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_hex($chrs); + } else { + $x = $obj_class -> bzero(); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +# Internal function with the same semantics as CORE::oct(). This function is +# not used directly, but rather by other front-end functions. + +sub _oct_core { + my $str = shift; + + $str =~ s/^\s*//; + + # Hexadecimal input. + + return _hex_core($str) if $str =~ /^0?[xX]/; + + my $x; + + # Binary input. + + if ($str =~ /^0?[bB]/) { + + # Strip off, clean, and parse as much as we can from the beginning. + + if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_bin($chrs); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal binary digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; + } + + # Octal input. Strip off, clean, and parse as much as we can from the + # beginning. + + if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_oct($chrs); + } + + # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it + # is more helpful to warn about all invalid digits. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal octal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +{ + my $proto = LEXICAL ? '_' : ';$'; + eval ' +sub hex(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _hex_core($str); +} +. + + eval ' +sub oct(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _oct_core($str); +} +. +} + +############################################################################# +# the following two routines are for Perl 5.9.4 or later and are lexical + +my ($prev_oct, $prev_hex, $overridden); + +if (LEXICAL) { eval <<'.' } +sub _hex(_) { + my $hh = (caller 0)[10]; + return $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $$hh{bigint} ? bigint::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); +} + +sub _oct(_) { + my $hh = (caller 0)[10]; + return $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $$hh{bigint} ? bigint::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); +} +. + +sub _override { + return if $overridden; + $prev_oct = *CORE::GLOBAL::oct{CODE}; + $prev_hex = *CORE::GLOBAL::hex{CODE}; + no warnings 'redefine'; + *CORE::GLOBAL::oct = \&_oct; + *CORE::GLOBAL::hex = \&_hex; + $overridden = 1; +} + +sub unimport { + $^H{bignum} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); +} sub import { - my $self = shift; + my $class = shift; - $^H{bignum} = 1; # we are in effect + $^H{bignum} = 1; # we are in effect + $^H{bigint} = undef; + $^H{bigrat} = undef; - # for newer Perls override hex() and oct() with a lexical version: - if ($] > 5.009004) { - bigint::_override(); + # for newer Perls always override hex() and oct() with a lexical version: + if (LEXICAL) { + _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - my $upgrade = 'Math::BigFloat'; - my $downgrade = 'Math::BigInt'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($ver, $trace); # version? trace? - my ($a, $p); # accuracy, precision - for (my $i = 0; $i < $l; $i++, $j++) { - if ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; - } elsif ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; } - elsif ($_[$i] =~ /^(v|version)$/) { - $ver = 1; - splice @a, $j, 1; - $j--; + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; } - elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] !~ /^(PI|e|bexp|bpi|hex|oct)\z/) { - die ("unknown option $_[$i]"); + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - $upgrade = 'Math::BigFloat::Trace'; - } - else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(v|version)$/) { + $ver = 1; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not - } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import, upgrade => $upgrade); - - if ($trace) { - require Math::BigFloat::Trace; - $class = 'Math::BigFloat::Trace'; - $downgrade = 'Math::BigInt::Trace'; - } - else { - require Math::BigFloat; - $class = 'Math::BigFloat'; + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; + } + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; + } + + croak("Unknown option '$param'"); } - $class->import(':constant', 'downgrade', $downgrade); - bignum->accuracy($a) if defined $a; - bignum->precision($p) if defined $p; + $obj_class -> import(@import); + if ($ver) { - print "bignum\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; - print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - bigint::_binary_constant(shift); + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. + + overload::constant + + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); }; +} - # if another big* was already loaded: - my ($package) = caller(); +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN - } +# This should depend on the current accuracy/precision. Fixme! +sub PI () { $obj_class -> new('3.141592653589793238462643383279502884197'); } +sub e () { $obj_class -> new('2.718281828459045235360287471352662497757'); } + +sub bpi ($) { + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> bpi(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $x; } -sub PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); } -sub e () { Math::BigFloat->new('2.718281828459045235360287471352662497757'); } -sub bpi ($) { Math::BigFloat->bpi(@_); } sub bexp ($$) { - my $x = Math::BigFloat->new($_[0]); - $x->bexp($_[1]); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> new(shift); + $x -> bexp(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $x; } 1; @@ -226,69 +423,49 @@ __END__ =head1 NAME -bignum - Transparent BigNumber support for Perl +bignum - transparent big number support for Perl =head1 SYNOPSIS use bignum; - $x = 2 + 4.5,"\n"; # BigFloat 6.5 - print 2 ** 512 * 0.1,"\n"; # really is what you think it is - print inf * inf,"\n"; # prints inf - print NaN * 3,"\n"; # prints NaN + $x = 2 + 4.5; # Math::BigFloat 6.5 + print 2 ** 512 * 0.1; # Math::BigFloat 134...09.6 + print inf + 42; # Math::BigFloat inf + print NaN * 7; # Math::BigFloat NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bignum; - print 2 ** 256,"\n"; # a normal Perl scalar now + print 2 ** 256; # a normal Perl scalar now } # for older Perls, import into current package: use bignum qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION -All operators (including basic math operations) are overloaded. Integer and -floating-point constants are created as proper BigInts or BigFloats, -respectively. +All numeric literals in the given scope are converted to Math::BigFloat objects. -If you do +All operators (including basic math operations) except the range operator C<..> +are overloaded. - use bignum; - -at the top of your script, Math::BigFloat and Math::BigInt will be loaded -and any constant number will be converted to an object (Math::BigFloat for -floats like 3.1415 and Math::BigInt for integers like 1234). - -So, the following line: +So, the following: + use bignum; $x = 1234; -creates actually a Math::BigInt and stores a reference to in $x. -This happens transparently and behind your back, so to speak. +creates a Math::BigFloat and stores a reference to in $x. This happens +transparently and behind your back, so to speak. You can see this with the following: perl -Mbignum -le 'print ref(1234)' -Don't worry if it says Math::BigInt::Lite, bignum and friends will use Lite -if it is installed since it is faster for some operations. It will be -automatically upgraded to BigInt whenever necessary: - - perl -Mbignum -le 'print ref(2**255)' - -This also means it is a bad idea to check for some specific package, since -the actual contents of $x might be something unexpected. Due to the -transparent way of bignum C<ref()> should not be necessary, anyway. - -Since Math::BigInt and BigFloat also overload the normal math operations, -the following line will still work: - - perl -Mbignum -le 'print ref(1234+1234)' - Since numbers are actually objects, you can call all the usual methods from -BigInt/BigFloat on them. This even works to some extent on expressions: +Math::BigFloat on them. This even works to some extent on expressions: perl -Mbignum -le '$x = 1234; print $x->bdec()' perl -Mbignum -le 'print 1234->copy()->binc();' @@ -303,44 +480,6 @@ You can even chain the operations together as usual: perl -Mbignum -le 'print 1234->copy()->binc->badd(6);' 1241 -Under bignum (or bigint or bigrat), Perl will "upgrade" the numbers -appropriately. This means that: - - perl -Mbignum -le 'print 1234+4.5' - 1238.5 - -will work correctly. These mixed cases don't do always work when using -Math::BigInt or Math::BigFloat alone, or at least not in the way normal Perl -scalars work. - -If you do want to work with large integers like under C<use integer;>, try -C<use bigint;>: - - perl -Mbigint -le 'print 1234.5+4.5' - 1238 - -There is also C<use bigrat;> which gives you big rationals: - - perl -Mbigrat -le 'print 1234+4.1' - 12381/10 - -The entire upgrading/downgrading is still experimental and might not work -as you expect or may even have bugs. You might get errors like this: - - Can't use an undefined value as an ARRAY reference at - /usr/local/lib/perl5/5.8.0/Math/BigInt/Calc.pm line 864 - -This means somewhere a routine got a BigFloat/Lite but expected a BigInt (or -vice versa) and the upgrade/downgrad path was missing. This is a bug, please -report it so that we can fix it. - -You might consider using just Math::BigInt or Math::BigFloat, since they -allow you finer control over what get's done in which module/space. For -instance, simple loop counters will be Math::BigInts under C<use bignum;> and -this is slower than keeping them as Perl scalars: - - perl -Mbignum -le 'for ($i = 0; $i < 10; $i++) { print ref($i); }' - Please note the following does not work as expected (prints nothing), since overloading of '..' is not yet possible in Perl (as of v5.8.0): @@ -348,16 +487,15 @@ overloading of '..' is not yet possible in Perl (as of v5.8.0): =head2 Options -bignum recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +C<bignum> recognizes some options that can be passed while loading it via via +C<use>. The following options exist: -=over 2 +=over 4 =item a or accuracy This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +than or equal to zero. See Math::BigInt's bround() method for details. perl -Mbignum=a,50 -le 'print sqrt(20)' @@ -366,9 +504,9 @@ Note that setting precision and accuracy at the same time is not possible. =item p or precision This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, while -a positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer. See Math::BigInt's bfround() function for details. +integer. Negative values mean a fixed number of digits after the dot, while a +positive value rounds to this digit left from the dot. 0 means round to integer. +See Math::BigInt's bfround() method for details. perl -Mbignum=p,-50 -le 'print sqrt(20)' @@ -376,54 +514,71 @@ Note that setting precision and accuracy at the same time is not possible. =item t or trace -This enables a trace mode and is primarily for debugging bignum or -Math::BigInt/Math::BigFloat. +This enables a trace mode and is primarily for debugging. -=item l or lib +=item l, lib, try, or only Load a different math lib, see L<Math Library>. perl -Mbignum=l,GMP -e 'print 2 ** 512' - -Currently there is no way to specify more than one library on the command -line. This means the following does not work: - - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' - -This will be hopefully fixed soon ;) + perl -Mbignum=lib,GMP -e 'print 2 ** 512' + perl -Mbignum=try,GMP -e 'print 2 ** 512' + perl -Mbignum=only,GMP -e 'print 2 ** 512' =item hex -Override the built-in hex() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bignum pragma is active. +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bignum> pragma is active. =item oct -Override the built-in oct() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigint pragma is active. +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bignum> pragma is active. =item v or version -This prints out the name and version of all modules used and then exits. +this prints out the name and version of the modules and then exits. perl -Mbignum=v =back -=head2 Methods +=head2 Math Library + +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: + + use bignum lib => 'Calc'; + +you can change this by using: + + use bignum lib => 'GMP'; + +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: -Beside import() and AUTOLOAD() there are only a few other methods. + use bignum lib => 'Foo,Math::BigInt::Bar'; + +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: + + use bignum try => 'GMP'; + +If you want the code to die instead of falling back, use C<only> instead: + + use bignum only => 'GMP'; + +Please see respective module documentation for further details. -Since all numbers are now objects, you can use all functions that are part of -the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not -the fxxx() notation, though. This makes it possible that the underlying object -might morph into a different class than BigFloat. +=head2 Method calls -=head2 Caveats +Since all numbers are now objects, you can use all methods that are part of the +Math::BigFloat API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -431,18 +586,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -If you want to make a real copy, use the following: - - $y = $x->copy(); - -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -453,33 +604,35 @@ B<both> the original and the copy being destroyed: $x = 9; $y = $x; print $x->bmul(2), " ", $y,"\n"; # prints 18 18 -Using methods that do not modify, but test the contents works: +Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigFloat for further details. -=over 2 +=head2 Methods + +=over 4 =item inf() -A shortcut to return Math::BigInt->binf(). Useful because Perl does not always +A shortcut to return Math::BigFloat->binf(). Useful because Perl does not always handle bareword C<inf> properly. =item NaN() -A shortcut to return Math::BigInt->bnan(). Useful because Perl does not always +A shortcut to return Math::BigFloat->bnan(). Useful because Perl does not always handle bareword C<NaN> properly. =item e # perl -Mbignum=e -wle 'print e' -Returns Euler's number C<e>, aka exp(1). +Returns Euler's number C<e>, aka exp(1) -=item PI() +=item PI # perl -Mbignum=PI -wle 'print PI' @@ -487,10 +640,10 @@ Returns PI. =item bexp() - bexp($power,$accuracy); + bexp($power, $accuracy); -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. Example: @@ -509,7 +662,7 @@ Example: =item upgrade() Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. +C<Math::BigFloat-E<gt>upgrade()>. =item in_effect() @@ -527,100 +680,67 @@ This method only works on Perl v5.9.4 or later. =back -=head2 Math Library - -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: - - use bignum lib => 'Calc'; - -You can change this by using: - - use bignum lib => 'GMP'; - -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: - - use bignum lib => 'Foo,Math::BigInt::Bar'; - -Please see respective module documentation for further details. - -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: - - use bignum try => 'GMP'; - -If you want the code to die instead of falling back, use C<only> instead: - - use bignum only => 'GMP'; - -=head2 INTERNAL FORMAT - -The numbers are stored as objects, and their internals might change at anytime, -especially between math operations. The objects also might belong to different -classes, like Math::BigInt, or Math::BigFloat. Mixing them together, even -with normal scalars is not extraordinary, but normal and expected. - -You should not depend on the internal format, all accesses must go through -accessor methods. E.g. looking at $x->{sign} is not a bright idea since there -is no guaranty that the object in question has such a hashkey, nor is a hash -underneath at all. - -=head2 SIGN +=head1 CAVEATS -The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored separately. -You can access it with the sign() method. +=over 4 -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +=item Hexadecimal, octal, and binary floating point literals -=head1 CAVEATS - -=over 2 +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bignum> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> or L<Math::BigFloat> -objects. +C<bigrat> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigRat> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: - use bignum; + use bigrat; my $x = "900000000000000009"; my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigrat> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> or C<BigFloat> objects, use a literal number in the -expression: +outputs C<0> on default 32-bit builds, since C<bignum> never sees the string +literals. To ensure the expression is all treated as C<Math::BigFloat> objects, +use a literal number in the expression: print +(0+$x) - $y; +=item Ranges + +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bignum> endpoints, nor is the iterator variable a C<Math::BigFloat>. + + use 5.010; + for my $i (12..13) { + for my $j (20..21) { + say $i ** $j; # produces a floating-point number, + # not an object + } + } + =item in_effect() This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bignum> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bignum>: - use bigint qw/hex oct/; + use bignum qw/hex oct/; print hex("0x1234567890123456"); { - no bigint; + no bignum; print hex("0x1234567890123456"); } @@ -628,44 +748,32 @@ The second call to hex() will warn about a non-portable constant. Compare this to: - use bigint; + use bignum; - # will warn only under older than v5.9.4 + # will warn only under Perl older than v5.9.4 print hex("0x1234567890123456"); =back -=head1 MODULES USED - -C<bignum> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. - -The following modules are currently used by bignum: - - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - Math::BigFloat - =head1 EXAMPLES Some cool command line examples to impress the Python crowd ;) perl -Mbignum -le 'print sqrt(33)' - perl -Mbignum -le 'print 2*255' - perl -Mbignum -le 'print 4.5+2*255' + perl -Mbignum -le 'print 2**255' + perl -Mbignum -le 'print 4.5+2**255' perl -Mbignum -le 'print 3/7 + 5/7 + 8/3' perl -Mbignum -le 'print 123->is_odd()' perl -Mbignum -le 'print log(2)' perl -Mbignum -le 'print exp(1)' perl -Mbignum -le 'print 2 ** 0.5' perl -Mbignum=a,65 -le 'print 2 ** 0.2' - perl -Mbignum=a,65,l,GMP -le 'print 7 ** 7777' + perl -Mbignum=l,GMP -le 'print 7 ** 7777' =head1 BUGS Please report any bugs or feature requests to -C<bug-math-bigint at rt.cpan.org>, or through the web interface at +C<bug-bignum at rt.cpan.org>, or through the web interface at L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. diff --git a/cpan/bignum/lib/bigrat.pm b/cpan/bignum/lib/bigrat.pm index 28a341c489..18f4ff0e2d 100644 --- a/cpan/bignum/lib/bigrat.pm +++ b/cpan/bignum/lib/bigrat.pm @@ -1,63 +1,52 @@ package bigrat; -use 5.010; use strict; use warnings; -our $VERSION = '0.53'; +use Carp qw< carp croak >; + +our $VERSION = '0.63'; use Exporter; -our @ISA = qw( bigint ); +our @ISA = qw( Exporter ); our @EXPORT_OK = qw( PI e bpi bexp hex oct ); our @EXPORT = qw( inf NaN ); use overload; -use bigint (); +use Math::BigRat; + +my $obj_class = "Math::BigRat"; ############################################################################## -BEGIN { - *inf = \&bigint::inf; - *NaN = \&bigint::NaN; - *hex = \&bigint::hex; - *oct = \&bigint::oct; +sub accuracy { + my $self = shift; + $obj_class -> accuracy(@_); } -# These are all alike, and thus faked by AUTOLOAD - -my @faked = qw/round_mode accuracy precision div_scale/; -our ($AUTOLOAD, $_lite); # _lite for testsuite - -sub AUTOLOAD { - my $name = $AUTOLOAD; - - $name =~ s/.*:://; # split package - no strict 'refs'; - foreach my $n (@faked) { - if ($n eq $name) { - *{"bigrat::$name"} = - sub { - my $self = shift; - no strict 'refs'; - if (defined $_[0]) { - Math::BigInt->$name($_[0]); - Math::BigFloat->$name($_[0]); - return Math::BigRat->$name($_[0]); - } - return Math::BigInt->$name(); - }; - return &$name; - } - } +sub precision { + my $self = shift; + $obj_class -> precision(@_); +} - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call bigrat\-\>$name, not a valid method"); +sub round_mode { + my $self = shift; + $obj_class -> round_mode(@_); } -sub unimport { - $^H{bigrat} = undef; # no longer in effect - overload::remove_constant('binary', '', 'float', '', 'integer'); +sub div_scale { + my $self = shift; + $obj_class -> div_scale(@_); +} + +sub upgrade { + my $self = shift; + $obj_class -> upgrade(@_); +} + +sub downgrade { + my $self = shift; + $obj_class -> downgrade(@_); } sub in_effect { @@ -66,150 +55,364 @@ sub in_effect { $hinthash->{bigrat}; } +sub _float_constant { + my $str = shift; + + # See if we can convert the input string to a string using a normalized form + # consisting of the significand as a signed integer, the character "e", and + # the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3". + + my $nstr; + + if ( + # See if it is an octal number. An octal number like '0377' is also + # accepted by the functions parsing decimal and hexadecimal numbers, so + # handle octal numbers before decimal and hexadecimal numbers. + + $str =~ /^0(?:[Oo]|_*[0-7])/ and + $nstr = Math::BigInt -> oct_str_to_dec_flt_str($str) + + or + + # See if it is decimal number. + + $nstr = Math::BigInt -> dec_str_to_dec_flt_str($str) + + or + + # See if it is a hexadecimal number. Every hexadecimal number has a + # prefix, but the functions parsing numbers don't require it, so check + # to see if it actually is a hexadecimal number. + + $str =~ /^0[Xx]/ and + $nstr = Math::BigInt -> hex_str_to_dec_flt_str($str) + + or + + # See if it is a binary numbers. Every binary number has a prefix, but + # the functions parsing numbers don't require it, so check to see if it + # actually is a binary number. + + $str =~ /^0[Bb]/ and + $nstr = Math::BigInt -> bin_str_to_dec_flt_str($str)) + { + return $obj_class -> new($nstr); + } + + # If we get here, there is a bug in the code above this point. + + warn "Internal error: unable to handle literal constant '$str'.", + " This is a bug, so please report this to the module author."; + return $obj_class -> bnan(); +} + ############################################################################# +# the following two routines are for "use bigrat qw/hex oct/;": -sub import { - my $self = shift; +use constant LEXICAL => $] > 5.009004; + +# Internal function with the same semantics as CORE::hex(). This function is +# not used directly, but rather by other front-end functions. + +sub _hex_core { + my $str = shift; + + # Strip off, clean, and parse as much as we can from the beginning. + + my $x; + if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_hex($chrs); + } else { + $x = $obj_class -> bzero(); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +# Internal function with the same semantics as CORE::oct(). This function is +# not used directly, but rather by other front-end functions. + +sub _oct_core { + my $str = shift; + + $str =~ s/^\s*//; + + # Hexadecimal input. + + return _hex_core($str) if $str =~ /^0?[xX]/; + + my $x; + + # Binary input. + + if ($str =~ /^0?[bB]/) { + + # Strip off, clean, and parse as much as we can from the beginning. + + if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_bin($chrs); + } + + # Warn about trailing garbage. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal binary digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; + } - # see also bignum->import() for additional comments + # Octal input. Strip off, clean, and parse as much as we can from the + # beginning. + + if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) { + my $chrs = $2; + $chrs =~ tr/_//d; + $chrs = '0' unless CORE::length $chrs; + $x = $obj_class -> from_oct($chrs); + } + + # Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it + # is more helpful to warn about all invalid digits. + + if (CORE::length($str)) { + require Carp; + Carp::carp(sprintf("Illegal octal digit '%s' ignored", + substr($str, 0, 1))); + } + + return $x; +} + +{ + my $proto = LEXICAL ? '_' : ';$'; + eval ' +sub hex(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _hex_core($str); +} +. + + eval ' +sub oct(' . $proto . ') {' . <<'.'; + my $str = @_ ? $_[0] : $_; + _oct_core($str); +} +. +} + +############################################################################# +# the following two routines are for Perl 5.9.4 or later and are lexical + +my ($prev_oct, $prev_hex, $overridden); + +if (LEXICAL) { eval <<'.' } +sub _hex(_) { + my $hh = (caller 0)[10]; + return $$hh{bigrat} ? bigrat::_hex_core($_[0]) + : $$hh{bignum} ? bignum::_hex_core($_[0]) + : $$hh{bigint} ? bigint::_hex_core($_[0]) + : $prev_hex ? &$prev_hex($_[0]) + : CORE::hex($_[0]); +} + +sub _oct(_) { + my $hh = (caller 0)[10]; + return $$hh{bigrat} ? bigrat::_oct_core($_[0]) + : $$hh{bignum} ? bignum::_oct_core($_[0]) + : $$hh{bigint} ? bigint::_oct_core($_[0]) + : $prev_oct ? &$prev_oct($_[0]) + : CORE::oct($_[0]); +} +. + +sub _override { + return if $overridden; + $prev_oct = *CORE::GLOBAL::oct{CODE}; + $prev_hex = *CORE::GLOBAL::hex{CODE}; + no warnings 'redefine'; + *CORE::GLOBAL::oct = \&_oct; + *CORE::GLOBAL::hex = \&_hex; + $overridden = 1; +} + +sub unimport { + $^H{bigrat} = undef; # no longer in effect + overload::remove_constant('binary', '', 'float', '', 'integer'); +} + +sub import { + my $class = shift; $^H{bigrat} = 1; # we are in effect + $^H{bigint} = undef; + $^H{bignum} = undef; # for newer Perls always override hex() and oct() with a lexical version: - if ($] > 5.009004) { - bigint::_override(); + if (LEXICAL) { + _override(); } - # some defaults - my $lib = ''; - my $lib_kind = 'try'; - my $upgrade = 'Math::BigFloat'; - - my @import = (':constant'); # drive it w/ constant - my @a = @_; - my $l = scalar @_; - my $j = 0; - my ($a, $p); - my ($ver, $trace); # version? trace? - for (my $i = 0; $i < $l ; $i++, $j++) { - if ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i + 1]; # or undef to disable - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; + + my @import = (); + my @a = (); # unrecognized arguments + my $ver; # version? + + while (@_) { + my $param = shift; + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; } - elsif ($_[$i] =~ /^(l|lib|try|only)$/) { - # this causes a different low lib to take care... - $lib_kind = $1; - $lib_kind = 'lib' if $lib_kind eq 'l'; - $lib = $_[$i + 1] || ''; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Accuracy. + + if ($param =~ /^a(ccuracy)?$/) { + $class -> accuracy(shift); + next; } - elsif ($_[$i] =~ /^(a|accuracy)$/) { - $a = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Precision. + + if ($param =~ /^p(recision)?$/) { + $class -> precision(shift); + next; } - elsif ($_[$i] =~ /^(p|precision)$/) { - $p = $_[$i + 1]; - my $s = 2; - $s = 1 if @a - $j < 2; # avoid "can not modify non-existent..." - splice @a, $j, $s; - $j -= $s; - $i++; + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] =~ /^(v|version)$/) { - $ver = 1; - splice @a, $j, 1; - $j--; + + # Backend library. + + if ($param =~ /^(l|lib|try|only)$/) { + push @import, $param eq 'l' ? 'lib' : $param; + push @import, shift() if @_; + next; } - elsif ($_[$i] =~ /^(t|trace)$/) { - $trace = 1; - splice @a, $j, 1; - $j--; + + if ($param =~ /^(v|version)$/) { + $ver = 1; + next; } - elsif ($_[$i] !~ /^(PI|e|bpi|bexp|hex|oct)\z/) { - die ("unknown option $_[$i]"); + + if ($param =~ /^(t|trace)$/) { + $obj_class .= "::Trace"; + eval "require $obj_class"; + die $@ if $@; + next; } - } - my $class; - $_lite = 0; # using M::BI::L ? - if ($trace) { - require Math::BigInt::Trace; - $class = 'Math::BigInt::Trace'; - $upgrade = 'Math::BigFloat::Trace'; - } - else { - # see if we can find Math::BigInt::Lite - if (!defined $a && !defined $p) { # rounding won't work to well - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; - if (eval { require Math::BigInt::Lite; 1 }) { - @import = (); # :constant in Lite, not MBI - Math::BigInt::Lite->import(':constant'); - $_lite = 1; # signal okay - } + + if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) { + push @a, $param; + next; } - require Math::BigInt if $_lite == 0; # not already loaded? - $class = 'Math::BigInt'; # regardless of MBIL or not + + croak("Unknown option '$param'"); } - push @import, $lib_kind => $lib if $lib ne ''; - # Math::BigInt::Trace or plain Math::BigInt - $class->import(@import, upgrade => $upgrade); - require Math::BigFloat; - Math::BigFloat->import(upgrade => 'Math::BigRat', ':constant'); - require Math::BigRat; - Math::BigRat->import(@import); + $obj_class -> import(@import); - bigrat->accuracy($a) if defined $a; - bigrat->precision($p) if defined $p; if ($ver) { - print "bigrat\t\t\t v$VERSION\n"; - print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; - print "Math::BigInt\t\t v$Math::BigInt::VERSION"; - my $config = Math::BigInt->config(); - print " lib => $config->{lib} v$config->{lib_version}\n"; - print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n"; - print "Math::BigRat\t\t v$Math::BigRat::VERSION\n"; + printf "%-31s v%s\n", $class, $class -> VERSION(); + printf " lib => %-23s v%s\n", + $obj_class -> config("lib"), $obj_class -> config("lib_version"); + printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION(); exit; } - # Take care of octal/hexadecimal constants - overload::constant binary => - sub { - bigint::_binary_constant(shift); - }; + $class -> export_to_level(1, $class, @a); # export inf, NaN, etc. - # if another big* was already loaded: - my ($package) = caller(); + overload::constant - no strict 'refs'; - if (!defined *{"${package}::inf"}) { - $self->export_to_level(1, $self, @a); # export inf and NaN - } + # This takes care each number written as decimal integer and within the + # range of what perl can represent as an integer, e.g., "314", but not + # "3141592653589793238462643383279502884197169399375105820974944592307". + + integer => sub { + #printf "Value '%s' handled by the 'integer' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str); + }, + + # This takes care of each number written with a decimal point and/or + # using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal), + # "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and + # "0x3.14p+2" (hexadecimal). + + float => sub { + #printf "# Value '%s' handled by the 'float' sub.\n", $_[0]; + _float_constant(shift); + }, + + # Take care of each number written as an integer (no decimal point or + # exponent) using binary, octal, or hexadecimal notation, e.g., "0b101" + # (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal). + + binary => sub { + #printf "# Value '%s' handled by the 'binary' sub.\n", $_[0]; + my $str = shift; + return $obj_class -> new($str) if $str =~ /^0[XxBb]/; + $obj_class -> from_oct($str); + }; } -sub PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); } -sub e () { Math::BigFloat->new('2.718281828459045235360287471352662497757'); } +sub inf () { $obj_class -> binf(); } +sub NaN () { $obj_class -> bnan(); } + +# This should depend on the current accuracy/precision. Fixme! +sub PI () { $obj_class -> new('3.141592653589793238462643383279502884197'); } +sub e () { $obj_class -> new('2.718281828459045235360287471352662497757'); } sub bpi ($) { - local $Math::BigFloat::upgrade; - Math::BigFloat->bpi(@_); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> bpi(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $obj_class -> new($x); } sub bexp ($$) { - local $Math::BigFloat::upgrade; - my $x = Math::BigFloat->new($_[0]); - $x->bexp($_[1]); + my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ... + Math::BigFloat -> upgrade(undef); # ... and disable + + my $x = Math::BigFloat -> new(shift); + $x -> bexp(@_); + + Math::BigFloat -> upgrade($up); # reset the upgrading + + return $obj_class -> new($x); } 1; @@ -220,162 +423,162 @@ __END__ =head1 NAME -bigrat - Transparent BigNumber/BigRational support for Perl +bigrat - transparent big rational number support for Perl =head1 SYNOPSIS use bigrat; - print 2 + 4.5,"\n"; # BigFloat 6.5 - print 1/3 + 1/4,"\n"; # produces 7/12 + print 2 + 4.5; # Math::BigRat 13/2 + print 1/3 + 1/4; # Math::BigRat 7/12 + print inf + 42; # Math::BigRat inf + print NaN * 7; # Math::BigRat NaN + print hex("0x1234567890123490"); # Perl v5.10.0 or later { no bigrat; - print 1/3,"\n"; # 0.33333... + print 1/3; # 0.33333... } - # Import into current package: + # for older Perls, import into current package: use bigrat qw/hex oct/; - print hex("0x1234567890123490"),"\n"; - print oct("01234567890123490"),"\n"; + print hex("0x1234567890123490"); + print oct("01234567890123490"); =head1 DESCRIPTION -All operators (including basic math operations) are overloaded. Integer and -floating-point constants are created as proper BigInts or BigFloats, -respectively. - -Other than L<bignum>, this module upgrades to Math::BigRat, meaning that -instead of 2.5 you will get 2+1/2 as output. - -=head2 Modules Used - -C<bigrat> is just a thin wrapper around various modules of the Math::BigInt -family. Think of it as the head of the family, who runs the shop, and orders -the others to do the work. +All numeric literal in the given scope are converted to Math::BigRat objects. -The following modules are currently used by bignum: +All operators (including basic math operations) except the range operator C<..> +are overloaded. - Math::BigInt::Lite (for speed, and only if it is loadable) - Math::BigInt - Math::BigFloat - Math::BigRat +So, the following: -=head2 Math Library + use bigrat; + $x = 1234; -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +creates a Math::BigRat and stores a reference to in $x. This happens +transparently and behind your back, so to speak. - use bigrat lib => 'Calc'; +You can see this with the following: -You can change this by using: + perl -Mbigrat -le 'print ref(1234)' - use bignum lib => 'GMP'; +Since numbers are actually objects, you can call all the usual methods from +Math::BigRat on them. This even works to some extent on expressions: -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + perl -Mbigrat -le '$x = 1234; print $x->bdec()' + perl -Mbigrat -le 'print 1234->copy()->binc();' + perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);' + perl -Mbigrat -le 'print +(1234)->copy()->binc()' - use bigrat lib => 'Foo,Math::BigInt::Bar'; +(Note that print doesn't do what you expect if the expression starts with +'(' hence the C<+>) -Using C<lib> warns if none of the specified libraries can be found and -L<Math::BigInt> did fall back to one of the default libraries. -To suppress this warning, use C<try> instead: +You can even chain the operations together as usual: - use bignum try => 'GMP'; + perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);' + 1241 -If you want the code to die instead of falling back, use C<only> instead: +Please note the following does not work as expected (prints nothing), since +overloading of '..' is not yet possible in Perl (as of v5.8.0): - use bignum only => 'GMP'; + perl -Mbigrat -le 'for (1..2) { print ref($_); }' -Please see respective module documentation for further details. +=head2 Options -=head2 Sign +C<bigrat> recognizes some options that can be passed while loading it via +C<use>. The following options exist: -The sign is either '+', '-', 'NaN', '+inf' or '-inf'. +=over 4 -A sign of 'NaN' is used to represent the result when input arguments are not -numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively -minus infinity. You will get '+inf' when dividing a positive number by 0, and -'-inf' when dividing any negative number by 0. +=item a or accuracy -=head2 Methods +This sets the accuracy for all math operations. The argument must be greater +than or equal to zero. See Math::BigInt's bround() method for details. -Since all numbers are not objects, you can use all functions that are part of -the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not -the fxxx() notation, though. This makes you independent on the fact that the -underlying object might morph into a different class than BigFloat. + perl -Mbigrat=a,50 -le 'print sqrt(20)' -=over 2 +Note that setting precision and accuracy at the same time is not possible. -=item inf() +=item p or precision -A shortcut to return Math::BigInt->binf(). Useful because Perl does not always -handle bareword C<inf> properly. +This sets the precision for all math operations. The argument can be any +integer. Negative values mean a fixed number of digits after the dot, while a +positive value rounds to this digit left from the dot. 0 means round to integer. +See Math::BigInt's bfround() method for details. -=item NaN() + perl -Mbigrat=p,-50 -le 'print sqrt(20)' -A shortcut to return Math::BigInt->bnan(). Useful because Perl does not always -handle bareword C<NaN> properly. +Note that setting precision and accuracy at the same time is not possible. -=item e +=item t or trace - # perl -Mbigrat=e -wle 'print e' +This enables a trace mode and is primarily for debugging. -Returns Euler's number C<e>, aka exp(1). +=item l, lib, try, or only -=item PI +Load a different math lib, see L<Math Library>. - # perl -Mbigrat=PI -wle 'print PI' + perl -Mbigrat=l,GMP -e 'print 2 ** 512' + perl -Mbigrat=lib,GMP -e 'print 2 ** 512' + perl -Mbigrat=try,GMP -e 'print 2 ** 512' + perl -Mbigrat=only,GMP -e 'print 2 ** 512' -Returns PI. +=item hex -=item bexp() +Override the built-in hex() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as hex() is lexically overridden in the +current scope whenever the C<bigrat> pragma is active. - bexp($power,$accuracy); +=item oct -Returns Euler's number C<e> raised to the appropriate power, to -the wanted accuracy. +Override the built-in oct() method with a version that can handle big numbers. +This overrides it by exporting it to the current package. Under Perl v5.10.0 and +higher, this is not so necessary, as oct() is lexically overridden in the +current scope whenever the C<bigrat> pragma is active. -Example: +=item v or version - # perl -Mbigrat=bexp -wle 'print bexp(1,80)' +this prints out the name and version of the modules and then exits. -=item bpi() + perl -Mbigrat=v - bpi($accuracy); +=back -Returns PI to the wanted accuracy. +=head2 Math Library -Example: +Math with the numbers is done (by default) by a backend library module called +Math::BigInt::Calc. The default is equivalent to saying: - # perl -Mbigrat=bpi -wle 'print bpi(80)' + use bigrat lib => 'Calc'; -=item upgrade() +you can change this by using: -Return the class that numbers are upgraded to, is in fact returning -C<$Math::BigInt::upgrade>. + use bigrat lib => 'GMP'; -=item in_effect() +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and if this also fails, revert to Math::BigInt::Calc: - use bigrat; + use bigrat lib => 'Foo,Math::BigInt::Bar'; - print "in effect\n" if bigrat::in_effect; # true - { - no bigrat; - print "in effect\n" if bigrat::in_effect; # false - } +Using c<lib> warns if none of the specified libraries can be found and +L<Math::BigInt> fell back to one of the default libraries. To suppress this +warning, use c<try> instead: -Returns true or false if C<bigrat> is in effect in the current scope. + use bigrat try => 'GMP'; -This method only works on Perl v5.9.4 or later. +If you want the code to die instead of falling back, use C<only> instead: -=back + use bigrat only => 'GMP'; -=head2 MATH LIBRARY +Please see the respective module documentation for further details. -Math with the numbers is done (by default) by a module called +=head2 Method calls -=head2 Caveat +Since all numbers are now objects, you can use all methods that are part of the +Math::BigRat API. But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -383,18 +586,14 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; -If you want to make a real copy, use the following: - - $y = $x->copy(); - -Using the copy or the original with overloaded math is okay, e.g. the -following work: +Using the copy or the original with overloaded math is okay, e.g., the following +work: $x = 9; $y = $x; print $x + 1, " ", $y,"\n"; # prints 10 9 -but calling any method that modifies the number directly will result in -B<both> the original and the copy being destroyed: +but calling any method that modifies the number directly will result in B<both> +the original and the copy being destroyed: $x = 9; $y = $x; print $x->badd(1), " ", $y,"\n"; # prints 10 10 @@ -405,94 +604,99 @@ B<both> the original and the copy being destroyed: $x = 9; $y = $x; print $x->bmul(2), " ", $y,"\n"; # prints 18 18 -Using methods that do not modify, but testthe contents works: +Using methods that do not modify, but test that the contents works: $x = 9; $y = $x; $z = 9 if $x->is_zero(); # works fine -See the documentation about the copy constructor and C<=> in overload, as -well as the documentation in BigInt for further details. +See the documentation about the copy constructor and C<=> in overload, as well +as the documentation in Math::BigFloat for further details. -=head2 Options +=head2 Methods -bignum recognizes some options that can be passed while loading it via use. -The options can (currently) be either a single letter form, or the long form. -The following options exist: +=over 4 -=over 2 +=item inf() -=item a or accuracy +A shortcut to return Math::BigRat->binf(). Useful because Perl does not always +handle bareword C<inf> properly. -This sets the accuracy for all math operations. The argument must be greater -than or equal to zero. See Math::BigInt's bround() function for details. +=item NaN() - perl -Mbigrat=a,50 -le 'print sqrt(20)' +A shortcut to return Math::BigRat->bnan(). Useful because Perl does not always +handle bareword C<NaN> properly. -Note that setting precision and accuracy at the same time is not possible. +=item e -=item p or precision + # perl -Mbigrat=e -wle 'print e' -This sets the precision for all math operations. The argument can be any -integer. Negative values mean a fixed number of digits after the dot, while -a positive value rounds to this digit left from the dot. 0 or 1 mean round to -integer. See Math::BigInt's bfround() function for details. +Returns Euler's number C<e>, aka exp(1). - perl -Mbigrat=p,-50 -le 'print sqrt(20)' +=item PI -Note that setting precision and accuracy at the same time is not possible. + # perl -Mbigrat=PI -wle 'print PI' -=item t or trace +Returns PI. -This enables a trace mode and is primarily for debugging bignum or -Math::BigInt/Math::BigFloat. +=item bexp() -=item l or lib + bexp($power, $accuracy); -Load a different math lib, see L<MATH LIBRARY>. +Returns Euler's number C<e> raised to the appropriate power, to the wanted +accuracy. - perl -Mbigrat=l,GMP -e 'print 2 ** 512' +Example: -Currently there is no way to specify more than one library on the command -line. This means the following does not work: + # perl -Mbigrat=bexp -wle 'print bexp(1,80)' - perl -Mbignum=l,GMP,Pari -e 'print 2 ** 512' +=item bpi() -This will be hopefully fixed soon ;) + bpi($accuracy); -=item hex +Returns PI to the wanted accuracy. -Override the built-in hex() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as hex() is lexically -overridden in the current scope whenever the bigrat pragma is active. +Example: -=item oct + # perl -Mbigrat=bpi -wle 'print bpi(80)' -Override the built-in oct() method with a version that can handle big -numbers. This overrides it by exporting it to the current package. Under -Perl v5.10.0 and higher, this is not so necessary, as oct() is lexically -overridden in the current scope whenever the bigrat pragma is active. +=item upgrade() -=item v or version +Return the class that numbers are upgraded to, is in fact returning +C<Math::BigRat-E<gt>upgrade()>. -This prints out the name and version of all modules used and then exits. +=item in_effect() - perl -Mbigrat=v + use bigrat; + + print "in effect\n" if bigrat::in_effect; # true + { + no bigrat; + print "in effect\n" if bigrat::in_effect; # false + } + +Returns true or false if C<bigrat> is in effect in the current scope. + +This method only works on Perl v5.9.4 or later. =back =head1 CAVEATS -=over 2 +=over 4 + +=item Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. =item Operator vs literal overloading -C<bigrat> works by overloading handling of integer and floating point -literals, converting them to L<Math::BigInt> or L<Math::BigRat> -objects. +C<bigrat> works by overloading handling of integer and floating point literals, +converting them to L<Math::BigRat> objects. -This means that arithmetic involving only string values or string -literals will be performed using Perl's built-in operators. +This means that arithmetic involving only string values or string literals are +performed using Perl's built-in operators. For example: @@ -501,30 +705,42 @@ For example: my $y = "900000000000000007"; print $x - $y; -will output C<0> on default 32-bit builds, since C<bigrat> never sees -the string literals. To ensure the expression is all treated as -C<Math::BigInt> or C<Math::BigRat> objects, use a literal number in -the expression: +outputs C<0> on default 32-bit builds, since C<bigrat> never sees the string +literals. To ensure the expression is all treated as C<Math::BigRat> objects, +use a literal number in the expression: print +(0+$x) - $y; +=item Ranges + +Perl does not allow overloading of ranges, so you can neither safely use ranges +with C<bigrat> endpoints, nor is the iterator variable a C<Math::BigRat>. + + use 5.010; + for my $i (12..13) { + for my $j (20..21) { + say $i ** $j; # produces a floating-point number, + # not an object + } + } + =item in_effect() This method only works on Perl v5.9.4 or later. =item hex()/oct() -C<bigint> overrides these routines with versions that can also handle -big integer values. Under Perl prior to version v5.9.4, however, this -will not happen unless you specifically ask for it with the two -import tags "hex" and "oct" - and then it will be global and cannot be -disabled inside a scope with "no bigint": +C<bigrat> overrides these routines with versions that can also handle big +integer values. Under Perl prior to version v5.9.4, however, this will not +happen unless you specifically ask for it with the two import tags "hex" and +"oct" - and then it will be global and cannot be disabled inside a scope with +C<no bigrat>: - use bigint qw/hex oct/; + use bigrat qw/hex oct/; print hex("0x1234567890123456"); { - no bigint; + no bigrat; print hex("0x1234567890123456"); } @@ -532,7 +748,7 @@ The second call to hex() will warn about a non-portable constant. Compare this to: - use bigint; + use bigrat; # will warn only under Perl older than v5.9.4 print hex("0x1234567890123456"); @@ -542,18 +758,19 @@ Compare this to: =head1 EXAMPLES perl -Mbigrat -le 'print sqrt(33)' - perl -Mbigrat -le 'print 2*255' - perl -Mbigrat -le 'print 4.5+2*255' + perl -Mbigrat -le 'print 2**255' + perl -Mbigrat -le 'print 4.5+2**255' perl -Mbigrat -le 'print 3/7 + 5/7 + 8/3' perl -Mbigrat -le 'print 12->is_odd()'; - perl -Mbignum=l,GMP -le 'print 7 ** 7777' + perl -Mbigrat=l,GMP -le 'print 7 ** 7777' =head1 BUGS -For information about bugs and how to report them, see the BUGS section in the -documentation available with the perldoc command. - - perldoc bignum +Please report any bugs or feature requests to +C<bug-bignum at rt.cpan.org>, or through the web interface at +L<https://rt.cpan.org/Ticket/Create.html?Queue=bignum> (requires login). +We will be notified, and then you'll automatically be notified of +progress on your bug as I make changes. =head1 SUPPORT @@ -561,10 +778,31 @@ You can find documentation for this module with the perldoc command. perldoc bigrat -For more information, see the SUPPORT section in the documentation available -with the perldoc command. +You can also look for information at: + +=over 4 + +=item * GitHub + +L<https://github.com/pjacklam/p5-bignum> + +=item * RT: CPAN's request tracker - perldoc bignum +L<https://rt.cpan.org/Dist/Display.html?Name=bignum> + +=item * MetaCPAN + +L<https://metacpan.org/release/bignum> + +=item * CPAN Testers Matrix + +L<http://matrix.cpantesters.org/?dist=bignum> + +=item * CPAN Ratings + +L<https://cpanratings.perl.org/dist/bignum> + +=back =head1 LICENSE @@ -588,7 +826,7 @@ L<Math::BigInt::FastCalc>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. =item * -Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2014-. +Maintained by Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2014-. =back diff --git a/cpan/bignum/t/bigexp.t b/cpan/bignum/t/bigexp.t index 61d39b2b82..61c98465ea 100644 --- a/cpan/bignum/t/bigexp.t +++ b/cpan/bignum/t/bigexp.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for bug #18025: bignum/bigrat can lead to a number that is both 1 and 0 diff --git a/cpan/bignum/t/bigint.t b/cpan/bignum/t/bigint.t index 5a5c00b72c..de9526e07b 100644 --- a/cpan/bignum/t/bigint.t +++ b/cpan/bignum/t/bigint.t @@ -1,139 +1,49 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 66; +use Test::More tests => 15; -use bigint qw/hex oct/; - -############################################################################### -# _constant tests - -foreach (qw/ - 123:123 - 123.4:123 - 1.4:1 - 0.1:0 - -0.1:0 - -1.1:-1 - -123.4:-123 - -123:-123 - 123e2:123e2 - 123e-1:12 - 123e-4:0 - 123e-3:0 - 123.345e-1:12 - 123.456e+2:12345 - 1234.567e+3:1234567 - 1234.567e+4:1234567E1 - 1234.567e+6:1234567E3 - /) -{ - my ($x, $y) = split /:/; - is(bigint::_float_constant("$x"), "$y", - qq|bigint::_float_constant("$x") = $y|); -} - -foreach (qw/ - 0100:64 - 0200:128 - 0x100:256 - 0b1001:9 - /) -{ - my ($x, $y) = split /:/; - is(bigint::_binary_constant("$x"), "$y", - qq|bigint::_binary_constant("$x") = "$y")|); -} +use bigint; ############################################################################### # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigInt', '$x = 5 makes $x a Math::BigInt'); # todo: is(2 + 2.5, 4.5); # should still work # todo: $x = 2 + 3.5; is(ref($x), 'Math::BigFloat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigInt', '$x = 2 ** 255 makes $x a Math::BigInt'); is(12->bfac(), 479001600, '12->bfac() = 479001600'); is(9/4, 2, '9/4 = 2'); -is(4.5 + 4.5, 8, '4.5 + 4.5 = 2'); # truncate -like(ref(4.5 + 4.5), qr/^Math::BigInt/, '4.5 + 4.5 makes a Math::BigInt'); +is(4.5 + 4.5, 8, '4.5 + 4.5 = 8'); # truncate +is(ref(4.5 + 4.5), 'Math::BigInt', '4.5 + 4.5 makes a Math::BigInt'); ############################################################################### # accuracy and precision -is(bigint->accuracy(), undef, 'get accuracy'); -is(bigint->accuracy(12), 12, 'set accuracy to 12'); -is(bigint->accuracy(), 12, 'get accuracy again'); - -is(bigint->precision(), undef, 'get precision'); -is(bigint->precision(12), 12, 'set precision to 12'); -is(bigint->precision(), 12, 'get precision again'); - -is(bigint->round_mode(), 'even', 'get round mode'); -is(bigint->round_mode('odd'), 'odd', 'set round mode'); -is(bigint->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bigint->accuracy(), undef, 'get accuracy'); +bigint->accuracy(12); +is(bigint->accuracy(), 12, 'get accuracy again'); +bigint->accuracy(undef); +is(bigint->accuracy(), undef, 'get accuracy again'); + +is(bigint->precision(), undef, 'get precision'); +bigint->precision(12); +is(bigint->precision(), 12, 'get precision again'); +bigint->precision(undef); +is(bigint->precision(), undef, 'get precision again'); + +is(bigint->round_mode(), 'even', 'get round mode'); +bigint->round_mode('odd'); +is(bigint->round_mode(), 'odd', 'get round mode again'); +bigint->round_mode('even'); +is(bigint->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/bignum.t b/cpan/bignum/t/bignum.t index f66f8f89aa..22ebece6b1 100644 --- a/cpan/bignum/t/bignum.t +++ b/cpan/bignum/t/bignum.t @@ -1,11 +1,11 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 50; +use Test::More tests => 19; use bignum qw/oct hex/; @@ -13,7 +13,7 @@ use bignum qw/oct hex/; # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigFloat', '$x = 5 makes $x a Math::BigFloat'); # :constant is(2 + 2.5, 4.5, '2 + 2.5 = 4.5'); $x = 2 + 3.5; @@ -24,11 +24,8 @@ $x = 2 + 2.1; is(ref($x), 'Math::BigFloat', '$x = 2 + 2.1 makes $x a Math::BigFloat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigFloat', '$x = 2 ** 255 makes $x a Math::BigFloat'); -# see if Math::BigInt constant and upgrading works -is(Math::BigInt::bsqrt("12"), '3.464101615137754587054892683011744733886', - 'Math::BigInt::bsqrt("12")'); is(sqrt(12), '3.464101615137754587054892683011744733886', 'sqrt(12)'); @@ -47,70 +44,20 @@ is(1/3, '0.3333333333333333333333333333333333333333', '1/3'); ############################################################################### # accuracy and precision -is(bignum->accuracy(), undef, 'get accuracy'); -is(bignum->accuracy(12), 12, 'set accuracy to 12'); -is(bignum->accuracy(), 12, 'get accuracy again'); - -is(bignum->precision(), undef, 'get precision'); -is(bignum->precision(12), 12, 'set precision to 12'); -is(bignum->precision(), 12, 'get precision again'); - -is(bignum->round_mode(), 'even', 'get round mode'); -is(bignum->round_mode('odd'), 'odd', 'set round mode'); -is(bignum->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bignum->accuracy(), undef, 'get accuracy'); +bignum->accuracy(12); +is(bignum->accuracy(), 12, 'get accuracy again'); +bignum->accuracy(undef); +is(bignum->accuracy(), undef, 'get accuracy again'); + +is(bignum->precision(), undef, 'get precision'); +bignum->precision(12); +is(bignum->precision(), 12, 'get precision again'); +bignum->precision(undef); +is(bignum->precision(), undef, 'get precision again'); + +is(bignum->round_mode(), 'even', 'get round mode'); +bignum->round_mode('odd'); +is(bignum->round_mode(), 'odd', 'get round mode again'); +bignum->round_mode('even'); +is(bignum->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/bigrat.t b/cpan/bignum/t/bigrat.t index 23f8f81cdf..bbb3fb00e0 100644 --- a/cpan/bignum/t/bigrat.t +++ b/cpan/bignum/t/bigrat.t @@ -1,27 +1,31 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 55; +use Test::More tests => 29;; -use bigrat qw/oct hex/; +use bigrat; ############################################################################### # general tests my $x = 5; -like(ref($x), qr/^Math::BigInt/, '$x = 5 makes $x a Math::BigInt'); # :constant +is(ref($x), 'Math::BigRat', '$x = 5 makes $x a Math::BigRat'); -# todo: is(2 + 2.5, 4.5); # should still work -# todo: $x = 2 + 3.5; is(ref($x), 'Math::BigFloat'); +is(2 + 2.5, 4.5); # should still work +$x = 2 + 3.5; +is(ref($x), 'Math::BigRat', '$x = 2 + 3.5 makes $x a Math::BigRat'); + +is(2 * 2.1, 4.2, '2 * 2.1 = 4.2'); +$x = 2 + 2.1; +is(ref($x), 'Math::BigRat', '$x = 2 + 2.1 makes $x a Math::BigRat'); $x = 2 ** 255; -like(ref($x), qr/^Math::BigInt/, '$x = 2 ** 255 makes $x a Math::BigInt'); +is(ref($x), 'Math::BigRat', '$x = 2 ** 255 makes $x a Math::BigRat'); -# see if Math::BigRat constant works is(1/3, '1/3', qq|1/3 = '1/3'|); is(1/4+1/3, '7/12', qq|1/4+1/3 = '7/12'|); is(5/7+3/7, '8/7', qq|5/7+3/7 = '8/7'|); @@ -46,70 +50,20 @@ is(3/7 / 1.5, '2/7', qq|3/7 / 1.5 = '2/7'|); ############################################################################### # accuracy and precision -is(bigrat->accuracy(), undef, 'get accuracy'); -is(bigrat->accuracy(12), 12, 'set accuracy to 12'); -is(bigrat->accuracy(), 12, 'get accuracy again'); - -is(bigrat->precision(), undef, 'get precision'); -is(bigrat->precision(12), 12, 'set precision to 12'); -is(bigrat->precision(), 12, 'get precision again'); - -is(bigrat->round_mode(), 'even', 'get round mode'); -is(bigrat->round_mode('odd'), 'odd', 'set round mode'); -is(bigrat->round_mode(), 'odd', 'get round mode again'); - -############################################################################### -# hex() and oct() - -my $class = 'Math::BigInt'; - -my @table = - ( - - [ 'hex(1)', 1 ], - [ 'hex(01)', 1 ], - [ 'hex(0x1)', 1 ], - [ 'hex("01")', 1 ], - [ 'hex("0x1")', 1 ], - [ 'hex("0X1")', 1 ], - [ 'hex("x1")', 1 ], - [ 'hex("X1")', 1 ], - [ 'hex("af")', 175 ], - - [ 'oct(1)', 1 ], - [ 'oct(01)', 1 ], - [ 'oct(" 1")', 1 ], - - [ 'oct(0x1)', 1 ], - [ 'oct("0x1")', 1 ], - [ 'oct("0X1")', 1 ], - [ 'oct("x1")', 1 ], - [ 'oct("X1")', 1 ], - [ 'oct(" 0x1")', 1 ], - - [ 'oct(0b1)', 1 ], - [ 'oct("0b1")', 1 ], - [ 'oct("0B1")', 1 ], - [ 'oct("b1")', 1 ], - [ 'oct("B1")', 1 ], - [ 'oct(" 0b1")', 1 ], - - #[ 'oct(0o1)', 1 ], # requires Perl 5.33.8 - [ 'oct("01")', 1 ], - [ 'oct("0o1")', 1 ], - [ 'oct("0O1")', 1 ], - [ 'oct("o1")', 1 ], - [ 'oct("O1")', 1 ], - [ 'oct(" 0o1")', 1 ], - - ); - -for my $entry (@table) { - my ($test, $want) = @$entry; - subtest $test, sub { - plan tests => 2; - my $got = eval $test; - cmp_ok($got, '==', $want, 'the output value is correct'); - is(ref($x), $class, 'the reference type is correct'); - }; -} +is(bigrat->accuracy(), undef, 'get accuracy'); +bigrat->accuracy(12); +is(bigrat->accuracy(), 12, 'get accuracy again'); +bigrat->accuracy(undef); +is(bigrat->accuracy(), undef, 'get accuracy again'); + +is(bigrat->precision(), undef, 'get precision'); +bigrat->precision(12); +is(bigrat->precision(), 12, 'get precision again'); +bigrat->precision(undef); +is(bigrat->precision(), undef, 'get precision again'); + +is(bigrat->round_mode(), 'even', 'get round mode'); +bigrat->round_mode('odd'); +is(bigrat->round_mode(), 'odd', 'get round mode again'); +bigrat->round_mode('even'); +is(bigrat->round_mode(), 'even', 'get round mode again'); diff --git a/cpan/bignum/t/biinfnan.t b/cpan/bignum/t/biinfnan.t deleted file mode 100644 index c3349173fc..0000000000 --- a/cpan/bignum/t/biinfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bigint; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/bir_e_pi.t b/cpan/bignum/t/bir_e_pi.t deleted file mode 100644 index 8305580b04..0000000000 --- a/cpan/bignum/t/bir_e_pi.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### -# test for e() and PI() exports - -use strict; -use warnings; - -use Test::More tests => 4; - -use bigrat qw/e PI bexp bpi/; - -is(e, "2.718281828459045235360287471352662497757", 'e'); -is(PI, "3.141592653589793238462643383279502884197", 'PI'); - -# These tests should actually produce big rationals, but this is not yet -# implemented. - -is(bexp(1, 10), "2.718281828", 'bexp(1, 10)'); -is(bpi(10), "3.141592654", 'bpi(10)'); diff --git a/cpan/bignum/t/bn_lite.t b/cpan/bignum/t/bn_lite.t deleted file mode 100644 index d26fe5ceb7..0000000000 --- a/cpan/bignum/t/bn_lite.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### - -use strict; -use warnings; - -use Test::More; - -if (eval { require Math::BigInt::Lite; 1 }) { - plan tests => 1; - # can use Lite, so let bignum try it - require bignum; - bignum->import(); - # can't get to work a ref(1+1) here, presumable because :constant phase - # already done - is($bignum::_lite, 1, '$bignum::_lite is 1'); -} else { - plan skip_all => "no Math::BigInt::Lite"; -} diff --git a/cpan/bignum/t/bninfnan.t b/cpan/bignum/t/bninfnan.t deleted file mode 100644 index e437ca116b..0000000000 --- a/cpan/bignum/t/bninfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bignum; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/br_lite.t b/cpan/bignum/t/br_lite.t deleted file mode 100644 index 79ac2c655c..0000000000 --- a/cpan/bignum/t/br_lite.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl - -############################################################################### - -use strict; -use warnings; - -use Test::More; - -if (eval { require Math::BigInt::Lite; 1 }) { - plan tests => 1; - # can use Lite, so let bignum try it - require bigrat; - bigrat->import(); - # can't get to work a ref(1+1) here, presumable because :constant phase - # already done - is($bigrat::_lite, 1, '$bigrat::_lite is 1'); -} else { - plan skip_all => "no Math::BigInt::Lite"; -} diff --git a/cpan/bignum/t/brinfnan.t b/cpan/bignum/t/brinfnan.t deleted file mode 100644 index 1be81649ef..0000000000 --- a/cpan/bignum/t/brinfnan.t +++ /dev/null @@ -1,22 +0,0 @@ -#!perl - -use strict; -use warnings; - -use Test::More tests => 66; - -use bigrat; - -#require "t/infnan.inc"; - -# The 'bigint'/'bignum'/'bigrat' pragma is lexical, so we can't 'require' or -# 'do' the included file. Slurp the whole thing and 'eval' it. - -my $file = "t/infnan.inc"; - -open FILE, $file or die "$file: can't open file for reading: $!"; -my $data = do { local $/; <FILE> }; -close FILE or die "$file: can't close file after reading: $!"; - -eval $data; -die $@ if $@; diff --git a/cpan/bignum/t/const-bigint.t b/cpan/bignum/t/const-bigint.t new file mode 100644 index 0000000000..441bbd33a1 --- /dev/null +++ b/cpan/bignum/t/const-bigint.t @@ -0,0 +1,237 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "118"; + +use bigint; + +my $class = "Math::BigInt"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x= 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), $class, "value is a $class"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +like(ref($x), qr/^Math::BigInt(::Lite)?$/, + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 0; +is($x, "0", "integer literal 0"); +like(ref($x), qr/^Math::BigInt(::Lite)?$/, + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), $class, "value is a $class"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), $class, "value is a $class"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), $class, "value is a $class"); +} diff --git a/cpan/bignum/t/const-bignum.t b/cpan/bignum/t/const-bignum.t new file mode 100644 index 0000000000..b9021d6032 --- /dev/null +++ b/cpan/bignum/t/const-bignum.t @@ -0,0 +1,337 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.32.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.32.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "171"; + +use bignum; + +my $class = "Math::BigFloat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Octal literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), "Math::BigFloat", + "value is a Math::BigInt or Math::BigInt::Lite"); +} + +################################################################################ +# The following tests are unique to $class. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "0.999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999.9", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.22.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "3.140625", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "3.140625", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "3.140625", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +is(1.0 / 3.0, "0.3333333333333333333333333333333333333333", + "1.0 / 3.0 = 0.3333333333333333333333333333333333333333"); diff --git a/cpan/bignum/t/const-bigrat.t b/cpan/bignum/t/const-bigrat.t new file mode 100644 index 0000000000..1f3ff6f1fc --- /dev/null +++ b/cpan/bignum/t/const-bigrat.t @@ -0,0 +1,316 @@ +# -*- mode: perl; -*- + +# Binary, octal, and hexadecimal floating point literals were introduced in +# v5.22.0. +# +# - It wasn't until v5.28.0 that binary, octal, and hexadecimal floating point +# literals were converted to the correct value on perls compiled with quadmath +# support. +# +# - It wasn't until v5.34.0 that binary and octal floating point literals worked +# correctly with constant overloading. Before v5.34.0, it seems like the +# second character is always silently converted to an "x", so, e.g., "0b1.1p8" +# is passed to the overload::constant subroutine as "0x1.1p8", and "01.1p+8" +# is passed as "0x.1p+8". +# +# - Octal floating point literals using the "0o" prefix were introduced in +# v5.34.0. + +# Note that all numeric literals that should not be overloaded must be quoted. + +use strict; +use warnings; + +use Test::More tests => "170"; + +use bigrat; + +my $class = "Math::BigRat"; +my $x; + +################################################################################ +# The following tests should be identical for Math::BigInt, Math::BigFloat and +# Math::BigRat. + +# These are handled by "binary". + +$x = 0xff; +is($x, "255", "hexadecimal integer literal 0xff"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Hexadecimal literals using the "0X" prefix require v5.14.0. + skip "perl v5.14.0 required for hexadecimal integer literals" + . " with '0X' prefix", "2" if $] < "5.014"; + + $x = eval "0XFF"; + is($x, "255", "hexadecimal integer literal 0XFF"); + is(ref($x), $class, "value is a $class"); +} + +$x = 0377; +is($x, "255", "octal integer literal 0377"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Octal literals using the "0o" prefix were introduced in v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "4" if $] < "5.034"; + + for my $str (qw/ 0o377 0O377 /) { + $x = eval $str; + is($x, "255", "octal integer literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +$x = 0b11111111; +is($x, "255", "binary integer literal 0b11111111"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +SKIP: { + # Binary literals using the "0B" prefix require v5.14.0. + skip "perl v5.14.0 required for binary integer literals" + . " with '0B' prefix", "2" if $] < "5.014"; + + $x = eval "0B11111111"; + is($x, "255", "binary integer literal 0B11111111"); + is(ref($x), $class, "value is a $class"); +} + +# These are handled by "float". + +$x = 999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "decimal integer literal " . ("9" x 72)); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 1e72 - 1; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999", + "literal 1e72 - 1"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" + "2" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 /) + { + $x = eval $str; + is($x, "314", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0x0.0p+8 0X0.0P+8 /) + { + $x = eval $str; + is($x, "0", "hexadecimal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" + "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0o0.0p+8 0O0.0P+8 + 0o0.0p8 0O0.0P8 + 0o0.0p-8 0O0.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 /) + { + $x = eval $str; + is($x, "314", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 00.0p+8 00.0P+8 + 00.0p8 00.0P8 + 00.0p-8 00.0P-8 /) + { + $x = eval $str; + is($x, "0", "octal floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 /) + { + $x = eval $str; + is($x, "314", "binary floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } + + for my $str (qw/ 0b0p+8 0B0P+8 + 0b0p8 0B0P8 + 0b0p-8 0B0P-8 + /) + { + $x = eval $str; + is($x, "0", "binary floating point literal $str"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + } +} + +# These are handled by "integer". + +$x = 314; +is($x, "314", "integer literal 314"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 0; +is($x, "0", "integer literal 0"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +$x = 2 ** 255; +is($x, + "578960446186580977117854925043439539266" + . "34992332820282019728792003956564819968", + "2 ** 255"); +is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + +# These are handled by "binary". + +{ + no warnings "portable"; # protect against "non-portable" warnings + + # hexadecimal constant + $x = 0x123456789012345678901234567890; + is($x, + "94522879687365475552814062743484560", + "hexadecimal constant 0x123456789012345678901234567890"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + + # octal constant + $x = 012345676543210123456765432101234567654321; + is($x, + "1736132869400711976876385488263403729", + "octal constant 012345676543210123456765432101234567654321"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); + + # binary constant + $x = 0b01010100011001010110110001110011010010010110000101101101; + is($x, + "23755414508757357", + "binary constant 0b0101010001100101011011000111" + . "0011010010010110000101101101"); + is(ref($x), "Math::BigRat", "value is a Math::BigRat"); +} + +################################################################################ +# The following tests are unique to Math::BigRat. + +# These are handled by "float". + +$x = 0.999999999999999999999999999999999999999999999999999999999999999999999999; +is($x, + "999999999999999999999999999999999999999999999999999999999999999999999999/" + . "1000000000000000000000000000000000000000000000000000000000000000000000000", + "decimal floating point literal 0." . ("9" x 72)); +is(ref($x), $class, "value is a $class"); + +$x = 1e72 - 0.1; +is($x, + "9999999999999999999999999999999999999999999999999999999999999999999999999/" + . "10", + "literal 1e72 - 0.1"); +is(ref($x), $class, "value is a $class"); + +# These are handled by "float". + +SKIP: { + # Hexadecimal floating point literals require v5.28.0. + skip "perl v5.28.0 required for hexadecimal floating point literals", + "6" * "2" if $] < "5.028"; + + for my $str (qw/ 0x1.92p+1 0X1.92P+1 + 0x1.92p1 0X1.92P1 + 0x19.2p-3 0X19.2P-3 /) + { + $x = eval $str; + is($x, "201/64", "hexadecimal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0o" prefix require v5.34.0. + skip "perl v5.34.0 required for octal floating point literals" + . " with '0o' prefix", "6" * "2" if $] < "5.034"; + + for my $str (qw/ 0o1.444p+1 0O1.444P+1 + 0o1.444p1 0O1.444P1 + 0o14.44p-2 0O14.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Octal floating point literals using the "0" prefix require v5.32.0. + skip "perl v5.32.0 required for octal floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 01.444p+1 01.444P+1 + 01.444p1 01.444P1 + 014.44p-2 014.44P-2 /) + { + $x = eval $str; + is($x, "201/64", "octal floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} + +SKIP: { + # Binary floating point literals require v5.32.0. + skip "perl v5.32.0 required for binary floating point literals", + "6" * "2" if $] < "5.032"; + + for my $str (qw/ 0b1.1001001p+1 0B1.1001001P+1 + 0b1.1001001p1 0B1.1001001P1 + 0b110.01001p-1 0B110.01001P-1 /) + { + $x = eval $str; + is($x, "201/64", "binary floating point literal $str"); + is(ref($x), $class, "value is a $class"); + } +} diff --git a/cpan/bignum/t/bii_e_pi.t b/cpan/bignum/t/e_pi-bigint.t index d9e20b5641..798da75836 100644 --- a/cpan/bignum/t/bii_e_pi.t +++ b/cpan/bignum/t/e_pi-bigint.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for e() and PI() exports diff --git a/cpan/bignum/t/big_e_pi.t b/cpan/bignum/t/e_pi-bignum.t index 06b4b0860a..08098b0952 100644 --- a/cpan/bignum/t/big_e_pi.t +++ b/cpan/bignum/t/e_pi-bignum.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # test for e() and PI() exports diff --git a/cpan/bignum/t/e_pi-bigrat.t b/cpan/bignum/t/e_pi-bigrat.t new file mode 100644 index 0000000000..bd15821630 --- /dev/null +++ b/cpan/bignum/t/e_pi-bigrat.t @@ -0,0 +1,22 @@ +# -*- mode: perl; -*- + +############################################################################### +# test for e() and PI() exports + +use strict; +use warnings; + +use Test::More tests => 4; + +use bigrat qw/e PI bexp bpi/; + +is(e, "2718281828459045235360287471352662497757/" + . "1000000000000000000000000000000000000000", 'e'); +is(PI, "3141592653589793238462643383279502884197/" + . "1000000000000000000000000000000000000000", 'PI'); + +# These tests should actually produce big rationals, but this is not yet +# implemented. Fixme! + +is(bexp(1, 10), "679570457/250000000", 'bexp(1, 10)'); +is(bpi(10), "1570796327/500000000", 'bpi(10)'); diff --git a/cpan/bignum/t/import-bigint.t b/cpan/bignum/t/import-bigint.t new file mode 100644 index 0000000000..cdef019efa --- /dev/null +++ b/cpan/bignum/t/import-bigint.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bigint; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bigint -> import("l" => "foo") }; +is($@, '', + qq|eval { bigint -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("lib" => "foo") }; +is($@, '', + qq|eval { bigint -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("try" => "foo") }; +is($@, '', + qq|eval { bigint -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("try" => "foo") }; +is($@, '', + qq|eval { bigint -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bigint -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigint -> import("only" => "bar") }; +is($@, "", + qq|eval { bigint -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bigint -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bigint -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/import-bignum.t b/cpan/bignum/t/import-bignum.t new file mode 100644 index 0000000000..e3ed2a50fe --- /dev/null +++ b/cpan/bignum/t/import-bignum.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bignum; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bignum -> import("l" => "foo") }; +is($@, '', + qq|eval { bignum -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("lib" => "foo") }; +is($@, '', + qq|eval { bignum -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("try" => "foo") }; +is($@, '', + qq|eval { bignum -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("try" => "foo") }; +is($@, '', + qq|eval { bignum -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bignum -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bignum -> import("only" => "bar") }; +is($@, "", + qq|eval { bignum -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bignum -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bignum -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/import-bigrat.t b/cpan/bignum/t/import-bigrat.t new file mode 100644 index 0000000000..965e0af9e8 --- /dev/null +++ b/cpan/bignum/t/import-bigrat.t @@ -0,0 +1,63 @@ +# -*- mode: perl; -*- + +# test the "l", "lib", "try" and "only" options: + +use strict; +use warnings; + +use Test::More tests => 21; + +use bigrat; + +# Catch warnings. + +my $WARNINGS; +local $SIG{__WARN__} = sub { + $WARNINGS = $_[0]; +}; + +my $rc; + +$WARNINGS = ""; +$rc = eval { bigrat -> import("l" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("l" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("lib" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("lib" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("try" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("try" => "foo") }; +is($@, '', + qq|eval { bigrat -> import("try" => "foo") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("foo" => "bar") }; +like($@, qr/^Unknown option/, + qq|eval { bigrat -> import("foo" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +$WARNINGS = ""; +$rc = eval { bigrat -> import("only" => "bar") }; +is($@, "", + qq|eval { bigrat -> import("only" => "bar") }|); +is($WARNINGS, "", "no warnings"); + +# test that options are only lowercase (don't see a reason why allow UPPER) + +foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { + $rc = eval { bigrat -> import($_ => "bar") }; + like($@, qr/^Unknown option/i, # should die + qq|eval { bigrat -> import($_ => "bar") }|); +} diff --git a/cpan/bignum/t/in_effect.t b/cpan/bignum/t/in_effect.t index b4507ea54a..28cc7c9dad 100644 --- a/cpan/bignum/t/in_effect.t +++ b/cpan/bignum/t/in_effect.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test in_effect() @@ -6,30 +6,70 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 21; -use bigint; -use bignum; -use bigrat; +{ + use bigint; + + can_ok('bigint', qw/in_effect/); -can_ok('bigint', qw/in_effect/); -can_ok('bignum', qw/in_effect/); -can_ok('bigrat', qw/in_effect/); + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; -SKIP: { - skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + is(bigint::in_effect(), 1, 'bigint in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigint not in effect'); + } - is(bigint::in_effect(), 1, 'bigint in effect'); - is(bignum::in_effect(), 1, 'bignum in effect'); - is(bigrat::in_effect(), 1, 'bigrat in effect'); + { + no bigint; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } } { - no bigint; - no bignum; - no bigrat; + use bignum; + + can_ok('bignum', qw/in_effect/); + + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), 1, 'bignum in effect'); + is(bigrat::in_effect(), undef, 'bigint not in effect'); + } + + { + no bignum; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } +} + +{ + use bigrat; + + can_ok('bigrat', qw/in_effect/); + + SKIP: { + skip('Need at least Perl v5.9.4', 3) if $] < "5.009005"; + + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), 1, 'bigint in effect'); + } + + { + no bigrat; - is(bigint::in_effect(), undef, 'bigint not in effect'); - is(bignum::in_effect(), undef, 'bignum not in effect'); - is(bigrat::in_effect(), undef, 'bigrat not in effect'); + is(bigint::in_effect(), undef, 'bigint not in effect'); + is(bignum::in_effect(), undef, 'bignum not in effect'); + is(bigrat::in_effect(), undef, 'bigrat not in effect'); + } } diff --git a/cpan/bignum/t/infnan-bigint.t b/cpan/bignum/t/infnan-bigint.t new file mode 100644 index 0000000000..92869be2eb --- /dev/null +++ b/cpan/bignum/t/infnan-bigint.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bigint; + +my $class = "Math::BigInt"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan-bignum.t b/cpan/bignum/t/infnan-bignum.t new file mode 100644 index 0000000000..3c4691051d --- /dev/null +++ b/cpan/bignum/t/infnan-bignum.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bignum; + +my $class = "Math::BigFloat"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan-bigrat.t b/cpan/bignum/t/infnan-bigrat.t new file mode 100644 index 0000000000..bd171a89ea --- /dev/null +++ b/cpan/bignum/t/infnan-bigrat.t @@ -0,0 +1,100 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 66; + +use bigrat; + +my $class = "Math::BigRat"; +my $x; + +############################################################################### + +note("inf tests"); + +$x = 1 + inf; +note("\n\n" . $x . "\n\n"); + +$x = 1 + inf; +is(ref($x), $class, "\$x = 1 + inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 + inf; $x->bstr() = "inf"'); + +$x = 1 * inf; +is(ref($x), $class, "\$x = 1 * inf makes a $class"); +is($x->bstr(), "inf", '$x = 1 * inf; $x->bstr() = "inf"'); + +# these don't work without exporting inf() +$x = inf; +is(ref($x), $class, "\$x = inf makes a $class"); +is($x->bstr(), "inf", '$x = inf; $x->bstr() = "inf"'); + +$x = inf + inf; +is(ref($x), $class, "\$x = inf + inf makes a $class"); +is($x->bstr(), "inf", '$x = inf + inf; $x->bstr() = "inf"'); + +$x = inf * inf; +is(ref($x), $class, "\$x = inf * inf makes a $class"); +is($x->bstr(), "inf", '$x = inf * inf; $x->bstr() = "inf"'); + +############################################################################### + +note("NaN tests"); + +$x = 1 + NaN; +is(ref($x), $class, "\$x = 1 + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 + NaN; $x->bstr() = "NaN"'); + +$x = 1 * NaN; +is(ref($x), $class, "\$x = 1 * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = 1 * NaN; $x->bstr() = "NaN"'); + +# these don't work without exporting NaN() +$x = NaN; +is(ref($x), $class, "\$x = NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN; $x->bstr() = "NaN"'); + +$x = NaN + NaN; +is(ref($x), $class, "\$x = NaN + NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + NaN; $x->bstr() = "NaN"'); + +$x = NaN * NaN; +is(ref($x), $class, "\$x = NaN * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * NaN; $x->bstr() = "NaN"'); + +############################################################################### + +note("mixed tests"); + +# these don't work without exporting NaN() or inf() + +$x = NaN + inf; +is(ref($x), $class, "\$x = NaN + inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN + inf; $x->bstr() = "NaN"'); + +$x = NaN * inf; +is(ref($x), $class, "\$x = NaN * inf makes a $class"); +is($x->bstr(), "NaN", '$x = NaN * inf; $x->bstr() = "NaN"'); + +$x = inf * NaN; +is(ref($x), $class, "\$x = inf * NaN makes a $class"); +is($x->bstr(), "NaN", '$x = inf * NaN; $x->bstr() = "NaN"'); + +############################################################################### +# inf and NaN as strings. + +for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { + my $x = 1 + $nan; + is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"|); + is(ref($x), $class, "\$x is a $class"); +} + +for my $inf (qw/ inf inF iNf iNF Inf InF INf INF + infinity Infinity InFiNiTy iNfInItY + /) +{ + my $x = 1 + $inf; + is($x->bstr(), "inf", qq|\$x = 1 + "$inf"|); + is(ref($x), $class, "\$x is a $class"); +} diff --git a/cpan/bignum/t/infnan.inc b/cpan/bignum/t/infnan.inc deleted file mode 100644 index 5ecc7b5936..0000000000 --- a/cpan/bignum/t/infnan.inc +++ /dev/null @@ -1,91 +0,0 @@ -#!perl - -use strict; -use warnings; - -my $x; - -############################################################################### -# inf tests - -$x = 1 + inf; -like(ref($x), qr/^Math::BigInt/, '$x = 1 + inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = 1 + inf; $x->bstr() = 'inf'|); - -$x = 1 * inf; -like(ref($x), qr/^Math::BigInt/, '$x = 1 * inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = 1 * inf; $x->bstr() = 'inf'|); - -# these don't work without exporting inf() -$x = inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf; $x->bstr() = 'inf'|); - -$x = inf + inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf + inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf + inf; $x->bstr() = 'inf'|); - -$x = inf * inf; -like(ref($x), qr/^Math::BigInt/, '$x = inf * inf makes a Math::BigInt'); -is($x->bstr(), 'inf', qq|$x = inf * inf; $x->bstr() = 'inf'|); - -############################################################################### -# NaN tests - -$x = 1 + NaN; -like(ref($x), qr/^Math::BigInt/, '$x = 1 + NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = 1 + NaN; $x->bstr() = 'NaN'|); - -$x = 1 * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = 1 * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = 1 * NaN; $x->bstr() = 'NaN'|); - -# these don't work without exporting NaN() -$x = NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN; $x->bstr() = 'NaN'|); - -$x = NaN + NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN + NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN + NaN; $x->bstr() = 'NaN'|); - -$x = NaN * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = NaN * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN * NaN; $x->bstr() = 'NaN'|); - -############################################################################### -# mixed tests - -# these don't work without exporting NaN() or inf() - -$x = NaN + inf; -like(ref($x), qr/^Math::BigInt/, '$x = NaN + inf makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN + inf; $x->bstr() = 'NaN'|); - -$x = NaN * inf; -like(ref($x), qr/^Math::BigInt/, '$x = NaN * inf makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = NaN * inf; $x->bstr() = 'NaN'|); - -$x = inf * NaN; -like(ref($x), qr/^Math::BigInt/, '$x = inf * NaN makes a Math::BigInt'); -is($x->bstr(), 'NaN', qq|$x = inf * NaN; $x->bstr() = 'NaN'|); - -############################################################################### -# inf and NaN as strings. - -for my $nan (qw/ nan naN nAn nAN Nan NaN NAn NAN /) { - my $x = 1 + $nan; - is($x->bstr(), "NaN", qq|\$x = 1 + "$nan"; \$x->bstr() = "NaN"|); - isa_ok($x, "Math::BigInt"); -} - -for my $inf (qw/ inf inF iNf iNF Inf InF INf INF - infinity Infinity InFiNiTy iNfInItY - /) -{ - my $x = 1 + $inf; - is($x->bstr(), "inf", qq|\$x = 1 + "$inf"; \$x->bstr() = "inf"|); - isa_ok($x, "Math::BigInt"); -} - -1; diff --git a/cpan/bignum/t/option_a.t b/cpan/bignum/t/option_a.t index 2a9d17154d..6cd02268e1 100644 --- a/cpan/bignum/t/option_a.t +++ b/cpan/bignum/t/option_a.t @@ -1,22 +1,36 @@ -#!perl - -############################################################################### +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 6; + +{ + my $class = "Math::BigInt"; + + use bigint a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -use bignum a => '12'; + bigint -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); +} + +{ + my $class = "Math::BigFloat"; -my @CLASSES = qw/Math::BigInt Math::BigFloat/; + use bignum a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -foreach my $class (@CLASSES) { - is($class->accuracy(),12, "$class accuracy = 12"); + bignum -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); } -bignum->import(accuracy => '23'); +{ + my $class = "Math::BigRat"; + + use bigrat a => "12"; + cmp_ok($class -> accuracy(), "==", 12, "$class accuracy = 12"); -foreach my $class (@CLASSES) { - is($class->accuracy(), 23, "$class accuracy = 23"); + bigrat -> import(accuracy => "23"); + cmp_ok($class -> accuracy(), "==", 23, "$class accuracy = 23"); } diff --git a/cpan/bignum/t/option_l.t b/cpan/bignum/t/option_l.t index 25ca325f3e..74a1ce7ece 100644 --- a/cpan/bignum/t/option_l.t +++ b/cpan/bignum/t/option_l.t @@ -1,52 +1,72 @@ -#!perl +# -*- mode: perl; -*- # test the "l", "lib", "try" and "only" options: use strict; use warnings; -use Test::More tests => 19; +use Test::More tests => 14; use bignum; -# Catch warnings. +# Catch warning. -my @WARNINGS; +my $warning; local $SIG{__WARN__} = sub { - push @WARNINGS, $_[0]; + $warning = $_[0]; }; my $rc; -$rc = eval { bignum->import( "l" => "foo" ) }; -is($@, '', # shouldn't die - qq|eval { bignum->import( "l" => "foo" ) }|); -is(scalar(@WARNINGS), 1, 'one warning'); -like($WARNINGS[0], qr/using fallback/, 'using fallback'); +$warning = ""; +$rc = eval { bignum->import("l" => "foo") }; +subtest qq|eval { bignum->import("l" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "lib" => "foo" ) }; -is($@, '', # ditto - qq|eval { bignum->import( "lib" => "foo" ) }|); -is(scalar @WARNINGS, 2, 'two warnings'); -like($WARNINGS[1], qr/using fallback/, 'using fallback'); + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; + +$warning = ""; +$rc = eval { bignum->import("lib" => "foo") }; +subtest qq|eval { bignum->import("lib" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "try" => "foo" ) }; -is($@, '', # shouldn't die - qq|eval { bignum->import( "try" => "foo" ) }|); + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; -$rc = eval { bignum->import( "try" => "foo" ) }; -is($@, '', # ditto - qq|eval { bignum->import( "try" => "foo" ) }|); +$warning = ""; +$rc = eval { bignum->import("try" => "foo") }; +subtest qq|eval { bignum->import("try" => "foo") }| => sub { + plan tests => 2; + + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; -$rc = eval { bignum->import( "foo" => "bar" ) }; -like($@, qr/^Unknown option foo/i, 'died'); # should die +$warning = ""; +$rc = eval { bignum->import("only" => "foo") }; +subtest qq|eval { bignum->import("only" => "foo") }| => sub { + plan tests => 2; -$rc = eval { bignum->import( "only" => "bar" ) }; -like($@, qr/fallback.*disallowed/i, 'died'); # should die + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; + +$warning = ""; +$rc = eval { bignum->import("foo" => "bar") }; +subtest qq|eval { bignum->import("foo" => "bar") }| => sub { + plan tests => 2; + + is($@, '', "didn't die"); + is($warning, "", "didn't get a warning"); +}; # test that options are only lowercase (don't see a reason why allow UPPER) foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { - $rc = eval { bignum->import( $_ => "bar" ) }; - like($@, qr/^Unknown option $_/i, 'died'); # should die + $rc = eval { bignum->import($_ => "bar") }; + like($@, qr/^Unknown option /i, + qq|eval { bignum->import($_ => "bar") }|); } diff --git a/cpan/bignum/t/option_p.t b/cpan/bignum/t/option_p.t index 6f57c92c81..672d73e199 100644 --- a/cpan/bignum/t/option_p.t +++ b/cpan/bignum/t/option_p.t @@ -1,20 +1,36 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 6; -my @CLASSES = qw/Math::BigInt Math::BigFloat/; +{ + my $class = "Math::BigInt"; -use bignum p => '12'; + use bigint p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); -foreach my $class (@CLASSES) { - is($class->precision(), 12, "$class precision = 12"); + bigint -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); } -bignum->import(p => '42'); +{ + my $class = "Math::BigFloat"; -foreach my $class (@CLASSES) { - is($class->precision(), 42, "$class precision = 42"); + use bignum p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); + + bignum -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); +} + +{ + my $class = "Math::BigRat"; + + use bigrat p => "12"; + cmp_ok($class -> precision(), "==", 12, "$class precision = 12"); + + bigrat -> import(precision => "23"); + cmp_ok($class -> precision(), "==", 23, "$class precision = 23"); } diff --git a/cpan/bignum/t/overrides.t b/cpan/bignum/t/overrides.t index 371d91d667..c79563182b 100644 --- a/cpan/bignum/t/overrides.t +++ b/cpan/bignum/t/overrides.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- use strict; use warnings; @@ -6,7 +6,7 @@ use warnings; # Test behaviour of hex and oct overrides in detail, and also how the three # modules interact. -use Test::More tests => 35; +use Test::More tests => 31; my $hex_called; my $oct_called; @@ -33,13 +33,14 @@ BEGIN { is oct(@_), "16", 'bigint oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > do { no bigint; 5.009004 }; + skip "no lexical hex/oct", 2 unless $] > "5.009004"; is ref hex(1), 'Math::BigInt', 'bigint hex() works when bignum and bigrat are loaded'; is ref oct(1), 'Math::BigInt', 'bigint oct() works when bignum and bigrat are loaded'; } } + { use bignum; $_ = "20"; @@ -50,13 +51,14 @@ BEGIN { is oct(@_), "16", 'bignum oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > 5.009004; - is ref hex(1), 'Math::BigInt', + skip "no lexical hex/oct", 2 unless $] > "5.009004"; + is ref hex(1), 'Math::BigFloat', 'bignum hex() works when bigint and bigrat are loaded'; - is ref oct(1), 'Math::BigInt', + is ref oct(1), 'Math::BigFloat', 'bignum oct() works when bigint and bigrat are loaded'; } } + { use bigrat; $_ = "20"; @@ -67,10 +69,10 @@ BEGIN { is oct(@_), "16", 'bigrat oct override provides scalar context'; SKIP: { - skip "no lexical hex/oct", 2 unless $] > 5.009004; - is ref hex(1), 'Math::BigInt', + skip "no lexical hex/oct", 2 unless $] > "5.009004"; + is ref hex(1), 'Math::BigRat', 'bigrat hex() works when bignum and bigint are loaded'; - is ref oct(1), 'Math::BigInt', + is ref oct(1), 'Math::BigRat', 'bigrat oct() works when bignum and bigint are loaded'; } } @@ -94,21 +96,23 @@ is $oct_called, 1, 'existing oct overrides are called'; ::is oct("20"), "16", 'exported oct function works with "decimal"'; # (used to return 20 because it thought it was decimal) } + { package _importer2; use bignum 'hex', 'oct'; ::is \&hex, \&bignum::hex, 'bignum exports hex'; ::is \&oct, \&bignum::oct, 'bignum exports oct'; - ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint'; - ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint'; +# ::is \&hex, \&bigint::hex, 'bignum exports same hex as bigint'; +# ::is \&oct, \&bigint::oct, 'bignum exports same oct as bigint'; } + { package _importer3; use bigrat 'hex', 'oct'; ::is \&hex, \&bigrat::hex, 'bigrat exports hex'; ::is \&oct, \&bigrat::oct, 'bigrat exports oct'; - ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint'; - ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint'; +# ::is \&hex, \&bigint::hex, 'bigrat exports same hex as bigint'; +# ::is \&oct, \&bigint::oct, 'bigrat exports same oct as bigint'; } is ref(hex 0), "", 'hex export is not global'; is ref(oct 0), "", 'oct export is not global'; diff --git a/cpan/bignum/t/ratopt_a.t b/cpan/bignum/t/ratopt_a.t index e5ee13b942..9a5ce7c061 100644 --- a/cpan/bignum/t/ratopt_a.t +++ b/cpan/bignum/t/ratopt_a.t @@ -1,13 +1,13 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### use strict; use warnings; -use Test::More tests => 7; +use Test::More tests => 3; -my @CLASSES = qw/Math::BigInt Math::BigFloat Math::BigRat/; +my @CLASSES = qw/Math::BigRat/; # bigrat (bug until v0.15) use bigrat a => 2; diff --git a/cpan/bignum/t/scope_i.t b/cpan/bignum/t/scope-bigint.t index e76ceeee25..0196884a09 100644 --- a/cpan/bignum/t/scope_i.t +++ b/cpan/bignum/t/scope-bigint.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test "no bigint;" and overloading of hex()/oct() for newer Perls @@ -16,8 +16,8 @@ isnt(ref(2.0), '', 'is in effect'); isnt(ref(0x20), '', 'is in effect'); SKIP: { - # Quote version number due to "use bigint;" - skip('Need at least Perl v5.9.4', 2) if $] < "5.009004"; + # Quote numbers due to "use bigint;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; is(ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); is(ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); @@ -30,6 +30,6 @@ SKIP: { is(ref(2.0), '', 'is not in effect'); is(ref(0x20), '', 'is not in effect'); - isnt(ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt(ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); } diff --git a/cpan/bignum/t/scope-bignum.t b/cpan/bignum/t/scope-bignum.t new file mode 100644 index 0000000000..c10b24978c --- /dev/null +++ b/cpan/bignum/t/scope-bignum.t @@ -0,0 +1,35 @@ +# -*- mode: perl; -*- + +############################################################################### +# Test "no bignum;" and overloading of hex()/oct() for newer Perls + +use strict; +use warnings; + +use Test::More tests => 10; + +# no :hex and :oct means these do not get overloaded for older Perls: +use bignum; + +isnt(ref(1), '', 'is in effect'); +isnt(ref(2.0), '', 'is in effect'); +isnt(ref(0x20), '', 'is in effect'); + +SKIP: { + # Quote numbers due to "use bignum;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; + + is(ref(hex(9)), 'Math::BigFloat', 'hex is overloaded'); + is(ref(oct(07)), 'Math::BigFloat', 'oct is overloaded'); +} + +{ + no bignum; + + is(ref(1), '', 'is not in effect'); + is(ref(2.0), '', 'is not in effect'); + is(ref(0x20), '', 'is not in effect'); + + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); +} diff --git a/cpan/bignum/t/scope_r.t b/cpan/bignum/t/scope-bigrat.t index 8ad2626bf8..d7731d3ecf 100644 --- a/cpan/bignum/t/scope_r.t +++ b/cpan/bignum/t/scope-bigrat.t @@ -1,4 +1,4 @@ -#!perl +# -*- mode: perl; -*- ############################################################################### # Test "no bigrat;" and overloading of hex()/oct() for newer Perls @@ -16,10 +16,11 @@ isnt(ref(2.0), '', 'is in effect'); isnt(ref(0x20), '', 'is in effect'); SKIP: { - skip('Need at least Perl v5.9.4', 2) if $] < 5.009004; + # Quote numbers due to "use bigrat;" + skip('Need at least Perl v5.9.4', "2") if $] < "5.009004"; - is(ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); - is(ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); + is(ref(hex(9)), 'Math::BigRat', 'hex is overloaded'); + is(ref(oct(07)), 'Math::BigRat', 'oct is overloaded'); } { @@ -29,6 +30,6 @@ SKIP: { is(ref(2.0), '', 'is not in effect'); is(ref(0x20), '', 'is not in effect'); - isnt(ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt(ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); + is(ref(hex(9)), '', 'hex is not overloaded'); + is(ref(oct(07)), '', 'oct is not overloaded'); } diff --git a/cpan/bignum/t/scope-nested-const.t b/cpan/bignum/t/scope-nested-const.t new file mode 100644 index 0000000000..b2f2a4d039 --- /dev/null +++ b/cpan/bignum/t/scope-nested-const.t @@ -0,0 +1,222 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More tests => 48; + +note "\nbigint -> bignum -> bigrat\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); +} + +note "\nbigint -> bigrat -> bignum\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); +} + +note "\nbignum -> bigint -> bigrat\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); +} + +note "\nbignum -> bigrat -> bigint\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); +} + +note "\nbigrat -> bigint -> bignum\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); +} + +note "\nbigrat -> bignum -> bigint\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(1), "Math::BigRat"); + + { + note "use bignum;"; + use bignum; + is(ref(1), "Math::BigFloat"); + + { + note "use bigint;"; + use bigint; + is(ref(1), "Math::BigInt"); + + note "no bigint;"; + no bigint; + is(ref(1), ""); + } + + is(ref(1), "Math::BigFloat"); + + note "no bignum;"; + no bignum; + is(ref(1), ""); + } + + is(ref(1), "Math::BigRat"); + + note "no bigrat;"; + no bigrat; + is(ref(1), ""); +} diff --git a/cpan/bignum/t/scope-nested-hex-oct.t b/cpan/bignum/t/scope-nested-hex-oct.t new file mode 100644 index 0000000000..df26efa7f4 --- /dev/null +++ b/cpan/bignum/t/scope-nested-hex-oct.t @@ -0,0 +1,274 @@ +# -*- mode: perl; -*- + +use strict; +use warnings; + +use Test::More; + +plan skip_all => 'Need at least Perl v5.10.1' if $] < "5.010001"; + +plan tests => 96; + +note "\nbigint -> bignum -> bigrat\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigint -> bigrat -> bignum\n\n"; + +{ + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbignum -> bigint -> bigrat\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbignum -> bigrat -> bigint\n\n"; + +{ + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigrat -> bigint -> bignum\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} + +note "\nbigrat -> bignum -> bigint\n\n"; + +{ + note "use bigrat;"; + use bigrat; + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + { + note "use bignum;"; + use bignum; + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + { + note "use bigint;"; + use bigint; + is(ref(hex("1")), "Math::BigInt", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigInt", 'ref(oct("1"))'); + + note "no bigint;"; + no bigint; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigFloat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigFloat", 'ref(oct("1"))'); + + note "no bignum;"; + no bignum; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); + } + + is(ref(hex("1")), "Math::BigRat", 'ref(hex("1"))'); + is(ref(oct("1")), "Math::BigRat", 'ref(oct("1"))'); + + note "no bigrat;"; + no bigrat; + is(ref(hex("1")), "", 'ref(hex("1"))'); + is(ref(oct("1")), "", 'ref(oct("1"))'); +} diff --git a/cpan/bignum/t/scope_f.t b/cpan/bignum/t/scope_f.t deleted file mode 100644 index e932ea2b9f..0000000000 --- a/cpan/bignum/t/scope_f.t +++ /dev/null @@ -1,34 +0,0 @@ -#!perl - -############################################################################### -# Test "no bignum;" and overloading of hex()/oct() for newer Perls - -use strict; -use warnings; - -use Test::More tests => 10; - -# no :hex and :oct means these do not get overloaded for older Perls: -use bignum; - -isnt (ref(1), '', 'is in effect'); -isnt (ref(2.0), '', 'is in effect'); -isnt (ref(0x20), '', 'is in effect'); - -SKIP: { - skip ('Need at least Perl v5.9.4', 2) if $] < 5.009004; - - is (ref(hex(9)), 'Math::BigInt', 'hex is overloaded'); - is (ref(oct(07)), 'Math::BigInt', 'oct is overloaded'); - } - -{ - no bignum; - - is (ref(1), '', 'is not in effect'); - is (ref(2.0), '', 'is not in effect'); - is (ref(0x20), '', 'is not in effect'); - - isnt (ref(hex(9)), 'Math::BigInt', 'hex is not overloaded'); - isnt (ref(oct(07)), 'Math::BigInt', 'oct is not overloaded'); -} |