From ccbfef1989966a87df0683fb781de40d0fad1f84 Mon Sep 17 00:00:00 2001 From: Florian Ragwitz Date: Sat, 23 Oct 2010 17:18:25 -0700 Subject: Math::BigRat has blead as its upstream --- MANIFEST | 28 +- Porting/Maintainers.pl | 4 +- cpan/Math-BigRat/lib/Math/BigRat.pm | 2020 -------------------------------- cpan/Math-BigRat/t/Math/BigRat/Test.pm | 122 -- cpan/Math-BigRat/t/big_ap.t | 95 -- cpan/Math-BigRat/t/bigfltpm.inc | 1673 -------------------------- cpan/Math-BigRat/t/bigfltrt.t | 19 - cpan/Math-BigRat/t/biglog.t | 73 -- cpan/Math-BigRat/t/bigrat.t | 325 ----- cpan/Math-BigRat/t/bigratpm.inc | 905 -------------- cpan/Math-BigRat/t/bigratpm.t | 12 - cpan/Math-BigRat/t/bigratup.t | 32 - cpan/Math-BigRat/t/bigroot.t | 42 - cpan/Math-BigRat/t/hang.t | 19 - cpan/Math-BigRat/t/requirer.t | 15 - cpan/Math-BigRat/t/trap.t | 75 -- dist/Math-BigRat/lib/Math/BigRat.pm | 2020 ++++++++++++++++++++++++++++++++ dist/Math-BigRat/t/Math/BigRat/Test.pm | 122 ++ dist/Math-BigRat/t/big_ap.t | 94 ++ dist/Math-BigRat/t/bigfltpm.inc | 1673 ++++++++++++++++++++++++++ dist/Math-BigRat/t/bigfltrt.t | 19 + dist/Math-BigRat/t/biglog.t | 72 ++ dist/Math-BigRat/t/bigrat.t | 324 +++++ dist/Math-BigRat/t/bigratpm.inc | 905 ++++++++++++++ dist/Math-BigRat/t/bigratpm.t | 12 + dist/Math-BigRat/t/bigratup.t | 31 + dist/Math-BigRat/t/bigroot.t | 41 + dist/Math-BigRat/t/hang.t | 18 + dist/Math-BigRat/t/requirer.t | 14 + dist/Math-BigRat/t/trap.t | 74 ++ 30 files changed, 5435 insertions(+), 5443 deletions(-) delete mode 100644 cpan/Math-BigRat/lib/Math/BigRat.pm delete mode 100644 cpan/Math-BigRat/t/Math/BigRat/Test.pm delete mode 100644 cpan/Math-BigRat/t/big_ap.t delete mode 100644 cpan/Math-BigRat/t/bigfltpm.inc delete mode 100644 cpan/Math-BigRat/t/bigfltrt.t delete mode 100644 cpan/Math-BigRat/t/biglog.t delete mode 100644 cpan/Math-BigRat/t/bigrat.t delete mode 100644 cpan/Math-BigRat/t/bigratpm.inc delete mode 100644 cpan/Math-BigRat/t/bigratpm.t delete mode 100644 cpan/Math-BigRat/t/bigratup.t delete mode 100644 cpan/Math-BigRat/t/bigroot.t delete mode 100644 cpan/Math-BigRat/t/hang.t delete mode 100644 cpan/Math-BigRat/t/requirer.t delete mode 100644 cpan/Math-BigRat/t/trap.t create mode 100644 dist/Math-BigRat/lib/Math/BigRat.pm create mode 100644 dist/Math-BigRat/t/Math/BigRat/Test.pm create mode 100644 dist/Math-BigRat/t/big_ap.t create mode 100644 dist/Math-BigRat/t/bigfltpm.inc create mode 100644 dist/Math-BigRat/t/bigfltrt.t create mode 100644 dist/Math-BigRat/t/biglog.t create mode 100644 dist/Math-BigRat/t/bigrat.t create mode 100644 dist/Math-BigRat/t/bigratpm.inc create mode 100644 dist/Math-BigRat/t/bigratpm.t create mode 100644 dist/Math-BigRat/t/bigratup.t create mode 100644 dist/Math-BigRat/t/bigroot.t create mode 100644 dist/Math-BigRat/t/hang.t create mode 100644 dist/Math-BigRat/t/requirer.t create mode 100644 dist/Math-BigRat/t/trap.t diff --git a/MANIFEST b/MANIFEST index 95fff9f458..1b96d3e3ad 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1345,20 +1345,6 @@ cpan/Log-Message/t/01_Log-Message-Config.t Log::Message tests cpan/Log-Message/t/02_Log-Message.t Log::Message tests cpan/Log-Message/t/conf/config_file Log::Message tests cpan/Log-Message/t/conf/LoadMe.pl Log::Message tests -cpan/Math-BigRat/lib/Math/BigRat.pm Math::BigRat -cpan/Math-BigRat/t/big_ap.t Math::BigRat test -cpan/Math-BigRat/t/bigfltpm.inc Math::BigRat test -cpan/Math-BigRat/t/bigfltrt.t Math::BigRat test -cpan/Math-BigRat/t/biglog.t Math::BigRat test -cpan/Math-BigRat/t/bigratpm.inc Math::BigRat test -cpan/Math-BigRat/t/bigratpm.t Math::BigRat test -cpan/Math-BigRat/t/bigrat.t Math::BigRat test -cpan/Math-BigRat/t/bigratup.t test under $Math::BigInt::upgrade -cpan/Math-BigRat/t/bigroot.t Math::BigRat test -cpan/Math-BigRat/t/hang.t Math::BigRat test for bug #34584 - hang in exp() -cpan/Math-BigRat/t/Math/BigRat/Test.pm Math::BigRat test helper -cpan/Math-BigRat/t/requirer.t see if require works properly -cpan/Math-BigRat/t/trap.t see if trap_nan and trap_inf work cpan/Math-Complex/lib/Math/Complex.pm A Complex package cpan/Math-Complex/lib/Math/Trig.pm A simple interface to complex trigonometry cpan/Math-Complex/t/Complex.t See if Math::Complex works @@ -2865,6 +2851,20 @@ dist/Math-BigInt/t/use_lib4.t Test combinations of Math::BigInt and BigFloat dist/Math-BigInt/t/use_mbfw.t use BigFloat w/ with and lib at the same time dist/Math-BigInt/t/use.t Test if use Math::BigInt(); works dist/Math-BigInt/t/with_sub.t Test use Math::BigFloat with => package +dist/Math-BigRat/lib/Math/BigRat.pm Math::BigRat +dist/Math-BigRat/t/big_ap.t Math::BigRat test +dist/Math-BigRat/t/bigfltpm.inc Math::BigRat test +dist/Math-BigRat/t/bigfltrt.t Math::BigRat test +dist/Math-BigRat/t/biglog.t Math::BigRat test +dist/Math-BigRat/t/bigratpm.inc Math::BigRat test +dist/Math-BigRat/t/bigratpm.t Math::BigRat test +dist/Math-BigRat/t/bigrat.t Math::BigRat test +dist/Math-BigRat/t/bigratup.t test under $Math::BigInt::upgrade +dist/Math-BigRat/t/bigroot.t Math::BigRat test +dist/Math-BigRat/t/hang.t Math::BigRat test for bug #34584 - hang in exp() +dist/Math-BigRat/t/Math/BigRat/Test.pm Math::BigRat test helper +dist/Math-BigRat/t/requirer.t see if require works properly +dist/Math-BigRat/t/trap.t see if trap_nan and trap_inf work dist/Module-CoreList/Changes Module::CoreList Changes dist/Module-CoreList/corelist The corelist command-line utility dist/Module-CoreList/identify-dependencies A usage example for Module::CoreList diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1c27564e52..1a5bc8aea1 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -890,14 +890,14 @@ use File::Glob qw(:case); { 'MAINTAINER' => 'rafl', 'DISTRIBUTION' => 'FLORA/Math-BigRat-0.26.tar.gz', - 'FILES' => q[cpan/Math-BigRat], + 'FILES' => q[dist/Math-BigRat], 'EXCLUDED' => [ qr{^inc/}, qw{ t/pod.t t/pod_cov.t }, ], - 'UPSTREAM' => 'cpan', + 'UPSTREAM' => 'blead', }, 'Math::Complex' => diff --git a/cpan/Math-BigRat/lib/Math/BigRat.pm b/cpan/Math-BigRat/lib/Math/BigRat.pm deleted file mode 100644 index 030a87ecdb..0000000000 --- a/cpan/Math-BigRat/lib/Math/BigRat.pm +++ /dev/null @@ -1,2020 +0,0 @@ - -# -# "Tax the rat farms." - Lord Vetinari -# - -# The following hash values are used: -# sign : +,-,NaN,+inf,-inf -# _d : denominator -# _n : numeraotr (value = _n/_d) -# _a : accuracy -# _p : precision -# You should not look at the innards of a BigRat - use the methods for this. - -package Math::BigRat; - -# anythig older is untested, and unlikely to work -use 5.006; -use strict; - -use Math::BigFloat; -use vars qw($VERSION @ISA $upgrade $downgrade - $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf); - -@ISA = qw(Math::BigFloat); - -$VERSION = '0.26'; -$VERSION = eval $VERSION; - -use overload; # inherit overload from Math::BigFloat - -BEGIN - { - *objectify = \&Math::BigInt::objectify; # inherit this from BigInt - *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD - # we inherit these from BigFloat because currently it is not possible - # that MBF has a different $MBI variable than we, because MBF also uses - # Math::BigInt::config->('lib'); (there is always only one library loaded) - *_e_add = \&Math::BigFloat::_e_add; - *_e_sub = \&Math::BigFloat::_e_sub; - *as_int = \&as_number; - *is_pos = \&is_positive; - *is_neg = \&is_negative; - } - -############################################################################## -# Global constants and flags. Access these only via the accessor methods! - -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; -$upgrade = undef; -$downgrade = undef; - -# These are internally, and not to be used from the outside at all! - -$_trap_nan = 0; # are NaNs ok? set w/ config() -$_trap_inf = 0; # are infs ok? set w/ config() - -# the package we are using for our private parts, defaults to: -# Math::BigInt->config()->{lib} -my $MBI = 'Math::BigInt::Calc'; - -my $nan = 'NaN'; -my $class = 'Math::BigRat'; - -sub isa - { - return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't - UNIVERSAL::isa(@_); - } - -############################################################################## - -sub _new_from_float - { - # turn a single float input into a rational number (like '0.1') - my ($self,$f) = @_; - - return $self->bnan() if $f->is_nan(); - return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/; - - $self->{_n} = $MBI->_copy( $f->{_m} ); # mantissa - $self->{_d} = $MBI->_one(); - $self->{sign} = $f->{sign} || '+'; - if ($f->{_es} eq '-') - { - # something like Math::BigRat->new('0.1'); - # 1 / 1 => 1/10 - $MBI->_lsft ( $self->{_d}, $f->{_e} ,10); - } - else - { - # something like Math::BigRat->new('10'); - # 1 / 1 => 10/1 - $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless - $MBI->_is_zero($f->{_e}); - } - $self; - } - -sub new - { - # create a Math::BigRat - my $class = shift; - - my ($n,$d) = @_; - - my $self = { }; bless $self,$class; - - # input like (BigInt) or (BigFloat): - if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat'))) - { - if ($n->isa('Math::BigFloat')) - { - $self->_new_from_float($n); - } - if ($n->isa('Math::BigInt')) - { - # TODO: trap NaN, inf - $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N - $self->{_d} = $MBI->_one(); # d => 1 - $self->{sign} = $n->{sign}; - } - if ($n->isa('Math::BigInt::Lite')) - { - # TODO: trap NaN, inf - $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; - $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N - $self->{_d} = $MBI->_one(); # d => 1 - } - return $self->bnorm(); # normalize (120/1 => 12/10) - } - - # input like (BigInt,BigInt) or (BigLite,BigLite): - if (ref($d) && ref($n)) - { - # do N first (for $self->{sign}): - if ($n->isa('Math::BigInt')) - { - # TODO: trap NaN, inf - $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N - $self->{sign} = $n->{sign}; - } - elsif ($n->isa('Math::BigInt::Lite')) - { - # TODO: trap NaN, inf - $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; - $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n - } - else - { - require Carp; - Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new"); - } - # now D: - if ($d->isa('Math::BigInt')) - { - # TODO: trap NaN, inf - $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D - # +/+ or -/- => +, +/- or -/+ => - - $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+'; - } - elsif ($d->isa('Math::BigInt::Lite')) - { - # TODO: trap NaN, inf - $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D - my $ds = '+'; $ds = '-' if $$d < 0; - # +/+ or -/- => +, +/- or -/+ => - - $self->{sign} = $ds ne $self->{sign} ? '-' : '+'; - } - else - { - require Carp; - Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new"); - } - return $self->bnorm(); # normalize (120/1 => 12/10) - } - return $n->copy() if ref $n; # already a BigRat - - if (!defined $n) - { - $self->{_n} = $MBI->_zero(); # undef => 0 - $self->{_d} = $MBI->_one(); - $self->{sign} = '+'; - return $self; - } - - # string input with / delimiter - if ($n =~ /\s*\/\s*/) - { - return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid - return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid - ($n,$d) = split (/\//,$n); - # try as BigFloats first - if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/)) - { - local $Math::BigFloat::accuracy = undef; - local $Math::BigFloat::precision = undef; - - # one of them looks like a float - my $nf = Math::BigFloat->new($n,undef,undef); - $self->{sign} = '+'; - return $self->bnan() if $nf->is_nan(); - - $self->{_n} = $MBI->_copy( $nf->{_m} ); # get mantissa - - # now correct $self->{_n} due to $n - my $f = Math::BigFloat->new($d,undef,undef); - return $self->bnan() if $f->is_nan(); - $self->{_d} = $MBI->_copy( $f->{_m} ); - - # calculate the difference between nE and dE - my $diff_e = $nf->exponent()->bsub( $f->exponent); - if ($diff_e->is_negative()) - { - # < 0: mul d with it - $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10); - } - elsif (!$diff_e->is_zero()) - { - # > 0: mul n with it - $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10); - } - } - else - { - # both d and n look like (big)ints - - $self->{sign} = '+'; # no sign => '+' - $self->{_n} = undef; - $self->{_d} = undef; - if ($n =~ /^([+-]?)0*([0-9]+)\z/) # first part ok? - { - $self->{sign} = $1 || '+'; # no sign => '+' - $self->{_n} = $MBI->_new($2 || 0); - } - - if ($d =~ /^([+-]?)0*([0-9]+)\z/) # second part ok? - { - $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg. - $self->{_d} = $MBI->_new($2 || 0); - } - - if (!defined $self->{_n} || !defined $self->{_d}) - { - $d = Math::BigInt->new($d,undef,undef) unless ref $d; - $n = Math::BigInt->new($n,undef,undef) unless ref $n; - - if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/) - { - # both parts are ok as integers (wierd things like ' 1e0' - $self->{_n} = $MBI->_copy($n->{value}); - $self->{_d} = $MBI->_copy($d->{value}); - $self->{sign} = $n->{sign}; - $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2 - return $self->bnorm(); - } - - $self->{sign} = '+'; # a default sign - return $self->bnan() if $n->is_nan() || $d->is_nan(); - - # handle inf cases: - if ($n->is_inf() || $d->is_inf()) - { - if ($n->is_inf()) - { - return $self->bnan() if $d->is_inf(); # both are inf => NaN - my $s = '+'; # '+inf/+123' or '-inf/-123' - $s = '-' if substr($n->{sign},0,1) ne $d->{sign}; - # +-inf/123 => +-inf - return $self->binf($s); - } - # 123/inf => 0 - return $self->bzero(); - } - } - } - - return $self->bnorm(); - } - - # simple string input - if (($n =~ /[\.eE]/) && $n !~ /^0x/) - { - # looks like a float, quacks like a float, so probably is a float - $self->{sign} = 'NaN'; - local $Math::BigFloat::accuracy = undef; - local $Math::BigFloat::precision = undef; - $self->_new_from_float(Math::BigFloat->new($n,undef,undef)); - } - else - { - # for simple forms, use $MBI directly - if ($n =~ /^([+-]?)0*([0-9]+)\z/) - { - $self->{sign} = $1 || '+'; - $self->{_n} = $MBI->_new($2 || 0); - $self->{_d} = $MBI->_one(); - } - else - { - my $n = Math::BigInt->new($n,undef,undef); - $self->{_n} = $MBI->_copy($n->{value}); - $self->{_d} = $MBI->_one(); - $self->{sign} = $n->{sign}; - return $self->bnan() if $self->{sign} eq 'NaN'; - return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/; - } - } - $self->bnorm(); - } - -sub copy - { - # if two arguments, the first one is the class to "swallow" subclasses - my ($c,$x) = @_; - - if (scalar @_ == 1) - { - $x = $_[0]; - $c = ref($x); - } - return unless ref($x); # only for objects - - my $self = bless {}, $c; - - $self->{sign} = $x->{sign}; - $self->{_d} = $MBI->_copy($x->{_d}); - $self->{_n} = $MBI->_copy($x->{_n}); - $self->{_a} = $x->{_a} if defined $x->{_a}; - $self->{_p} = $x->{_p} if defined $x->{_p}; - $self; - } - -############################################################################## - -sub config - { - # return (later set?) configuration data as hash ref - my $class = shift || 'Math::BigRat'; - - if (@_ == 1 && ref($_[0]) ne 'HASH') - { - my $cfg = $class->SUPER::config(); - return $cfg->{$_[0]}; - } - - my $cfg = $class->SUPER::config(@_); - - # now we need only to override the ones that are different from our parent - $cfg->{class} = $class; - $cfg->{with} = $MBI; - $cfg; - } - -############################################################################## - -sub bstr - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; - } - - my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2' - - return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d}); - $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); - } - -sub bsstr - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; - } - - my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 - $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); - } - -sub bnorm - { - # reduce the number to the shortest form - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - # Both parts must be objects of whatever we are using today. - if ( my $c = $MBI->_check($x->{_n}) ) - { - require Carp; Carp::croak ("n did not pass the self-check ($c) in bnorm()"); - } - if ( my $c = $MBI->_check($x->{_d}) ) - { - require Carp; Carp::croak ("d did not pass the self-check ($c) in bnorm()"); - } - - # no normalize for NaN, inf etc. - return $x if $x->{sign} !~ /^[+-]$/; - - # normalize zeros to 0/1 - if ($MBI->_is_zero($x->{_n})) - { - $x->{sign} = '+'; # never leave a -0 - $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d}); - return $x; - } - - return $x if $MBI->_is_one($x->{_d}); # no need to reduce - - # reduce other numbers - my $gcd = $MBI->_copy($x->{_n}); - $gcd = $MBI->_gcd($gcd,$x->{_d}); - - if (!$MBI->_is_one($gcd)) - { - $x->{_n} = $MBI->_div($x->{_n},$gcd); - $x->{_d} = $MBI->_div($x->{_d},$gcd); - } - $x; - } - -############################################################################## -# sign manipulation - -sub bneg - { - # (BRAT or num_str) return BRAT - # negate number or make a negated number from string - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $x if $x->modify('bneg'); - - # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN' - $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n})); - $x; - } - -############################################################################## -# special values - -sub _bnan - { - # used by parent class bnan() to initialize number to NaN - my $self = shift; - - if ($_trap_nan) - { - require Carp; - my $class = ref($self); - # "$self" below will stringify the object, this blows up if $self is a - # partial object (happens under trap_nan), so fix it beforehand - $self->{_d} = $MBI->_zero() unless defined $self->{_d}; - $self->{_n} = $MBI->_zero() unless defined $self->{_n}; - Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); - } - $self->{_n} = $MBI->_zero(); - $self->{_d} = $MBI->_zero(); - } - -sub _binf - { - # used by parent class bone() to initialize number to +inf/-inf - my $self = shift; - - if ($_trap_inf) - { - require Carp; - my $class = ref($self); - # "$self" below will stringify the object, this blows up if $self is a - # partial object (happens under trap_nan), so fix it beforehand - $self->{_d} = $MBI->_zero() unless defined $self->{_d}; - $self->{_n} = $MBI->_zero() unless defined $self->{_n}; - Carp::croak ("Tried to set $self to inf in $class\::_binf()"); - } - $self->{_n} = $MBI->_zero(); - $self->{_d} = $MBI->_zero(); - } - -sub _bone - { - # used by parent class bone() to initialize number to +1/-1 - my $self = shift; - $self->{_n} = $MBI->_one(); - $self->{_d} = $MBI->_one(); - } - -sub _bzero - { - # used by parent class bzero() to initialize number to 0 - my $self = shift; - $self->{_n} = $MBI->_zero(); - $self->{_d} = $MBI->_one(); - } - -############################################################################## -# mul/add/div etc - -sub badd - { - # add two rational numbers - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$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} !~ /^[+-]$/); - - # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 - # - + - = --------- = -- - # 4 3 4*3 12 - - # we do not compute the gcd() here, but simple do: - # 5 7 5*3 + 7*4 43 - # - + - = --------- = -- - # 4 3 4*3 12 - - # and bnorm() will then take care of the rest - - # 5 * 3 - $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d}); - - # 7 * 4 - my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} ); - - # 5 * 3 + 7 * 4 - ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign}); - - # 4 * 3 - $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d}); - - # normalize result, and possible round - $x->bnorm()->round(@r); - } - -sub bsub - { - # subtract two rational numbers - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - # flip sign of $x, call badd(), then flip sign of result - $x->{sign} =~ tr/+-/-+/ - unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 - $x->badd($y,@r); # does norm and round - $x->{sign} =~ tr/+-/-+/ - unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 - $x; - } - -sub bmul - { - # multiply two rational numbers - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); - - # inf handling - if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) - { - return $x->bnan() if $x->is_zero() || $y->is_zero(); - # result will always be +-inf: - # +inf * +/+inf => +inf, -inf * -/-inf => +inf - # +inf * -/-inf => -inf, -inf * +/+inf => -inf - return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); - return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); - return $x->binf('-'); - } - - # x== 0 # also: or y == 1 or y == -1 - return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); - - # XXX TODO: - # According to Knuth, this can be optimized by doing gcd twice (for d and n) - # and reducing in one step. This would save us the bnorm() at the end. - - # 1 2 1 * 2 2 1 - # - * - = ----- = - = - - # 4 3 4 * 3 12 6 - - $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n}); - $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d}); - - # compute new sign - $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; - - $x->bnorm()->round(@r); - } - -sub bdiv - { - # (dividend: BRAT or num_str, divisor: BRAT or num_str) return - # (BRAT,BRAT) (quo,rem) or BRAT (only rem) - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - return $self->_div_inf($x,$y) - if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); - - # x== 0 # also: or y == 1 or y == -1 - return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); - - # XXX TODO: list context, upgrade - # According to Knuth, this can be optimized by doing gcd twice (for d and n) - # and reducing in one step. This would save us the bnorm() at the end. - - # 1 1 1 3 - # - / - == - * - - # 4 3 4 1 - - $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d}); - $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n}); - - # compute new sign - $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; - - $x->bnorm()->round(@r); - $x; - } - -sub bmod - { - # compute "remainder" (in Perl way) of $x / $y - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - return $self->_div_inf($x,$y) - if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); - - return $x if $x->is_zero(); # 0 / 7 = 0, mod 0 - - # compute $x - $y * floor($x/$y), keeping the sign of $x - - # copy x to u, make it positive and then do a normal division ($u/$y) - my $u = bless { sign => '+' }, $self; - $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} ); - $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} ); - - # compute floor(u) - if (! $MBI->_is_one($u->{_d})) - { - $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate - # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway - } - - # now compute $y * $u - $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above - $u->{_n} = $MBI->_mul($u->{_n},$y->{_n}); - - my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive - # compute $x - $u - $x->bsub($u); - $x->{sign} = $xsign; # put sign back - - $x->bnorm()->round(@r); - } - -############################################################################## -# bdec/binc - -sub bdec - { - # decrement value (subtract 1) - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf - - if ($x->{sign} eq '-') - { - $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d}); # -5/2 => -7/2 - } - else - { - if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d? - { - # 1/3 -- => -2/3 - $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n}); - $x->{sign} = '-'; - } - else - { - $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2 - } - } - $x->bnorm()->round(@r); - } - -sub binc - { - # increment value (add 1) - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf - - if ($x->{sign} eq '-') - { - if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) - { - # -1/3 ++ => 2/3 (overflow at 0) - $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n}); - $x->{sign} = '+'; - } - else - { - $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2 - } - } - else - { - $x->{_n} = $MBI->_add($x->{_n},$x->{_d}); # 5/2 => 7/2 - } - $x->bnorm()->round(@r); - } - -############################################################################## -# is_foo methods (the rest is inherited) - -sub is_int - { - # return true if arg (BRAT or num_str) is an integer - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't - $MBI->_is_one($x->{_d}); # x/y && y != 1 => no integer - 0; - } - -sub is_zero - { - # return true if arg (BRAT or num_str) is zero - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); - 0; - } - -sub is_one - { - # return true if arg (BRAT or num_str) is +1 or -1 if signis given - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - my $sign = $_[2] || ''; $sign = '+' if $sign ne '-'; - return 1 - if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})); - 0; - } - -sub is_odd - { - # return true if arg (BFLOAT or num_str) is odd or false if even - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't - ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1 - 0; - } - -sub is_even - { - # return true if arg (BINT or num_str) is even or false if odd - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never - && $MBI->_is_even($x->{_n})); # but 4/1 is - 0; - } - -############################################################################## -# parts() and friends - -sub numerator - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - - # NaN, inf, -inf - return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/); - - my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign}; - $n; - } - -sub denominator - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - - # NaN - return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN'; - # inf, -inf - return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/; - - Math::BigInt->new($MBI->_str($x->{_d})); - } - -sub parts - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - - my $c = 'Math::BigInt'; - - return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN'; - return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf'; - return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf'; - - my $n = $c->new( $MBI->_str($x->{_n})); - $n->{sign} = $x->{sign}; - my $d = $c->new( $MBI->_str($x->{_d})); - ($n,$d); - } - -sub length - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $nan unless $x->is_int(); - $MBI->_len($x->{_n}); # length(-123/1) => length(123) - } - -sub digit - { - my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_); - - return $nan unless $x->is_int(); - $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2) - } - -############################################################################## -# special calc routines - -sub bceil - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - - return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf - $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 - - $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate - $x->{_d} = $MBI->_one(); # d => 1 - $x->{_n} = $MBI->_inc($x->{_n}) - if $x->{sign} eq '+'; # +22/7 => 4/1 - $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0 - $x; - } - -sub bfloor - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - - return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf - $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 - - $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate - $x->{_d} = $MBI->_one(); # d => 1 - $x->{_n} = $MBI->_inc($x->{_n}) - if $x->{sign} eq '-'; # -22/7 => -4/1 - $x; - } - -sub bfac - { - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - # if $x is not an integer - if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d}))) - { - return $x->bnan(); - } - - $x->{_n} = $MBI->_fac($x->{_n}); - # since _d is 1, we don't need to reduce/norm the result - $x->round(@r); - } - -sub bpow - { - # power ($x ** $y) - - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x - return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - return $x->bone(@r) if $y->is_zero(); - return $x->round(@r) if $x->is_one() || $y->is_one(); - - if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})) - { - # if $x == -1 and odd/even y => +1/-1 - return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); - # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; - } - # 1 ** -y => 1 / (1 ** |y|) - # so do test for negative $y after above's clause - - return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) - - # shortcut if y == 1/N (is then sqrt() respective broot()) - if ($MBI->_is_one($y->{_n})) - { - return $x->bsqrt(@r) if $MBI->_is_two($y->{_d}); # 1/2 => sqrt - return $x->broot($MBI->_str($y->{_d}),@r); # 1/N => root(N) - } - - # shortcut y/1 (and/or x/1) - if ($MBI->_is_one($y->{_d})) - { - # shortcut for x/1 and y/1 - if ($MBI->_is_one($x->{_d})) - { - $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1 - if ($y->{sign} eq '-') - { - # 0.2 ** -3 => 1/(0.2 ** 3) - ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap - } - # correct sign; + ** + => + - if ($x->{sign} eq '-') - { - # - * - => +, - * - * - => - - $x->{sign} = '+' if $MBI->_is_even($y->{_n}); - } - return $x->round(@r); - } - # x/z ** y/1 - $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y - $x->{_d} = $MBI->_pow($x->{_d},$y->{_n}); - if ($y->{sign} eq '-') - { - # 0.2 ** -3 => 1/(0.2 ** 3) - ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap - } - # correct sign; + ** + => + - if ($x->{sign} eq '-') - { - # - * - => +, - * - * - => - - $x->{sign} = '+' if $MBI->_is_even($y->{_n}); - } - return $x->round(@r); - } - -# print STDERR "# $x $y\n"; - - # otherwise: - - # n/d n ______________ - # a/b = -\/ (a/b) ** d - - # (a/b) ** n == (a ** n) / (b ** n) - $MBI->_pow($x->{_n}, $y->{_n} ); - $MBI->_pow($x->{_d}, $y->{_n} ); - - return $x->broot($MBI->_str($y->{_d}),@r); # n/d => root(n) - } - -sub blog - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,$class,@_); - } - - # blog(1,Y) => 0 - return $x->bzero() if $x->is_one() && $y->{sign} eq '+'; - - # $x <= 0 => NaN - return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+'; - - if ($x->is_int() && $y->is_int()) - { - return $self->new($x->as_number()->blog($y->as_number(),@r)); - } - - # do it with floats - $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) ); - } - -sub bexp - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,$class,@_); - } - - return $x->binf(@r) if $x->{sign} eq '+inf'; - return $x->bzero(@r) if $x->{sign} eq '-inf'; - - # we need to limit the accuracy to protect against overflow - my $fallback = 0; - my ($scale,@params); - ($x,@params) = $x->_find_round_parameters(@r); - - # also takes care of the "error in _find_round_parameters?" case - return $x if $x->{sign} eq 'NaN'; - - # no rounding at all, so must use fallback - if (scalar @params == 0) - { - # simulate old behaviour - $params[0] = $self->div_scale(); # and round to it as accuracy - $params[1] = undef; # P = undef - $scale = $params[0]+4; # at least four more for proper round - $params[2] = $r[2]; # round mode by caller or undef - $fallback = 1; # to clear a/p afterwards - } - else - { - # the 4 below is empirical, and there might be cases where it's not enough... - $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined - } - - return $x->bone(@params) if $x->is_zero(); - - # See the comments in Math::BigFloat on how this algorithm works. - # Basically we calculate A and B (where B is faculty(N)) so that A/B = e - - my $x_org = $x->copy(); - if ($scale <= 75) - { - # set $x directly from a cached string form - $x->{_n} = $MBI->_new("90933395208605785401971970164779391644753259799242"); - $x->{_d} = $MBI->_new("33452526613163807108170062053440751665152000000000"); - $x->{sign} = '+'; - } - else - { - # compute A and B so that e = A / B. - - # After some terms we end up with this, so we use it as a starting point: - my $A = $MBI->_new("90933395208605785401971970164779391644753259799242"); - my $F = $MBI->_new(42); my $step = 42; - - # Compute how many steps we need to take to get $A and $B sufficiently big - my $steps = Math::BigFloat::_len_to_steps($scale - 4); -# print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; - while ($step++ <= $steps) - { - # calculate $a * $f + 1 - $A = $MBI->_mul($A, $F); - $A = $MBI->_inc($A); - # increment f - $F = $MBI->_inc($F); - } - # compute $B as factorial of $steps (this is faster than doing it manually) - my $B = $MBI->_fac($MBI->_new($steps)); - -# print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n"; - - $x->{_n} = $A; - $x->{_d} = $B; - $x->{sign} = '+'; - } - - # $x contains now an estimate of e, with some surplus digits, so we can round - if (!$x_org->is_one()) - { - # raise $x to the wanted power and round it in one step: - $x->bpow($x_org, @params); - } - else - { - # else just round the already computed result - delete $x->{_a}; delete $x->{_p}; - # shortcut to not run through _find_round_parameters again - if (defined $params[0]) - { - $x->bround($params[0],$params[2]); # then round accordingly - } - else - { - $x->bfround($params[1],$params[2]); # then round accordingly - } - } - if ($fallback) - { - # clear a/p after round, since user did not request it - delete $x->{_a}; delete $x->{_p}; - } - - $x; - } - -sub bnok - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,$class,@_); - } - - # do it with floats - $x->_new_from_float( $x->_as_float()->bnok(Math::BigFloat->new("$y"),@r) ); - } - -sub _float_from_part - { - my $x = shift; - - my $f = Math::BigFloat->bzero(); - $f->{_m} = $MBI->_copy($x); - $f->{_e} = $MBI->_zero(); - - $f; - } - -sub _as_float - { - my $x = shift; - - local $Math::BigFloat::upgrade = undef; - local $Math::BigFloat::accuracy = undef; - local $Math::BigFloat::precision = undef; - # 22/7 => 3.142857143.. - - my $a = $x->accuracy() || 0; - if ($a != 0 || !$MBI->_is_one($x->{_d})) - { - # n/d - return scalar Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy()); - } - # just n - Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n})); - } - -sub broot - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - if ($x->is_int() && $y->is_int()) - { - return $self->new($x->as_number()->broot($y->as_number(),@r)); - } - - # do it with floats - $x->_new_from_float( $x->_as_float()->broot($y->_as_float(),@r) )->bnorm()->bround(@r); - } - -sub bmodpow - { - # set up parameters - my ($self,$x,$y,$m,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,$m,@r) = objectify(3,@_); - } - - # $x or $y or $m are NaN or +-inf => NaN - return $x->bnan() - if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || - $m->{sign} !~ /^[+-]$/; - - if ($x->is_int() && $y->is_int() && $m->is_int()) - { - return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r)); - } - - warn ("bmodpow() not fully implemented"); - $x->bnan(); - } - -sub bmodinv - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,@_); - } - - # $x or $y are NaN or +-inf => NaN - return $x->bnan() - if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; - - if ($x->is_int() && $y->is_int()) - { - return $self->new($x->as_number()->bmodinv($y->as_number(),@r)); - } - - warn ("bmodinv() not fully implemented"); - $x->bnan(); - } - -sub bsqrt - { - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 - return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf - return $x->round(@r) if $x->is_zero() || $x->is_one(); - - local $Math::BigFloat::upgrade = undef; - local $Math::BigFloat::downgrade = undef; - local $Math::BigFloat::precision = undef; - local $Math::BigFloat::accuracy = undef; - local $Math::BigInt::upgrade = undef; - local $Math::BigInt::precision = undef; - local $Math::BigInt::accuracy = undef; - - $x->{_n} = _float_from_part( $x->{_n} )->bsqrt(); - $x->{_d} = _float_from_part( $x->{_d} )->bsqrt(); - - # XXX TODO: we probably can optimze this: - - # if sqrt(D) was not integer - if ($x->{_d}->{_es} ne '+') - { - $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1 - $x->{_d} = $MBI->_copy( $x->{_d}->{_m} ); # 7.1/45.1 => 71/45.1 - } - # if sqrt(N) was not integer - if ($x->{_n}->{_es} ne '+') - { - $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1 - $x->{_n} = $MBI->_copy( $x->{_n}->{_m} ); # 710/45.1 => 710/451 - } - - # convert parts to $MBI again - $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10) - if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY'; - $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10) - if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY'; - - $x->bnorm()->round(@r); - } - -sub blsft - { - my ($self,$x,$y,$b,@r) = objectify(3,@_); - - $b = 2 unless defined $b; - $b = $self->new($b) unless ref ($b); - $x->bmul( $b->copy()->bpow($y), @r); - $x; - } - -sub brsft - { - my ($self,$x,$y,$b,@r) = objectify(3,@_); - - $b = 2 unless defined $b; - $b = $self->new($b) unless ref ($b); - $x->bdiv( $b->copy()->bpow($y), @r); - $x; - } - -############################################################################## -# round - -sub round - { - $_[0]; - } - -sub bround - { - $_[0]; - } - -sub bfround - { - $_[0]; - } - -############################################################################## -# comparing - -sub bcmp - { - # compare two signed numbers - - # set up parameters - my ($self,$x,$y) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y) = objectify(2,@_); - } - - 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 +1 if $x->{sign} eq '+inf'; - return -1 if $x->{sign} eq '-inf'; - return -1 if $y->{sign} eq '+inf'; - return +1; - } - # check sign for speed first - return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y - return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 - - # shortcut - my $xz = $MBI->_is_zero($x->{_n}); - my $yz = $MBI->_is_zero($y->{_n}); - return 0 if $xz && $yz; # 0 <=> 0 - return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y - return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 - - my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d}); - my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d}); - - my $cmp = $MBI->_acmp($t,$u); # signs are equal - $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse - $cmp; - } - -sub bacmp - { - # compare two numbers (as unsigned) - - # set up parameters - my ($self,$x,$y) = (ref($_[0]),@_); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y) = objectify(2,$class,@_); - } - - 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 -1; - } - - my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d}); - my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d}); - $MBI->_acmp($t,$u); # ignore signs - } - -############################################################################## -# output conversation - -sub numify - { - # convert 17/8 => float (aka 2.125) - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc - - # N/1 => N - my $neg = ''; $neg = '-' if $x->{sign} eq '-'; - return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d}); - - $x->_as_float()->numify() + 0.0; - } - -sub as_number - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - # NaN, inf etc - return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; - - my $u = Math::BigInt->bzero(); - $u->{sign} = $x->{sign}; - $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3 - $u; - } - -sub as_float - { - # return N/D as Math::BigFloat - - # set up parameters - my ($self,$x,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - ($self,$x,@r) = objectify(1,$class,@_) unless ref $_[0]; - - # NaN, inf etc - return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; - - my $u = Math::BigFloat->bzero(); - $u->{sign} = $x->{sign}; - # n - $u->{_m} = $MBI->_copy($x->{_n}); - $u->{_e} = $MBI->_zero(); - $u->bdiv( $MBI->_str($x->{_d}), @r); - # return $u - $u; - } - -sub as_bin - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $x unless $x->is_int(); - - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_bin($x->{_n}); - } - -sub as_hex - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $x unless $x->is_int(); - - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_hex($x->{_n}); - } - -sub as_oct - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - - return $x unless $x->is_int(); - - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_oct($x->{_n}); - } - -############################################################################## - -sub from_hex - { - my $class = shift; - - $class->new(@_); - } - -sub from_bin - { - my $class = shift; - - $class->new(@_); - } - -sub from_oct - { - my $class = shift; - - my @parts; - for my $c (@_) - { - push @parts, Math::BigInt->from_oct($c); - } - $class->new ( @parts ); - } - -############################################################################## -# import - -sub import - { - my $self = shift; - my $l = scalar @_; - my $lib = ''; my @a; - my $try = 'try'; - - for ( my $i = 0; $i < $l ; $i++) - { - if ( $_[$i] eq ':constant' ) - { - # this rest causes overlord er load to step in - overload::constant float => sub { $self->new(shift); }; - } -# elsif ($_[$i] eq 'upgrade') -# { -# # this causes upgrading -# $upgrade = $_[$i+1]; # or undef to disable -# $i++; -# } - elsif ($_[$i] eq 'downgrade') - { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; - } - elsif ($_[$i] =~ /^(lib|try|only)\z/) - { - $lib = $_[$i+1] || ''; # default Calc - $try = $1; # lib, try or only - $i++; - } - elsif ($_[$i] eq 'with') - { - # this argument is no longer used - #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc - $i++; - } - else - { - push @a, $_[$i]; - } - } - require Math::BigInt; - - # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP - if ($lib ne '') - { - my @c = split /\s*,\s*/, $lib; - foreach (@c) - { - $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters - } - $lib = join(",", @c); - } - my @import = ('objectify'); - push @import, $try => $lib if $lib ne ''; - - # MBI already loaded, so feed it our lib arguments - Math::BigInt->import( @import ); - - $MBI = Math::BigFloat->config()->{lib}; - - # register us with MBI to get notified of future lib changes - Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } ); - - # any non :constant stuff is handled by our parent, Exporter (loaded - # by Math::BigFloat, even if @_ is empty, to give it a chance - $self->SUPER::import(@a); # for subclasses - $self->export_to_level(1,$self,@a); # need this, too - } - -1; - -__END__ - -=head1 NAME - -Math::BigRat - Arbitrary big rational numbers - -=head1 SYNOPSIS - - use Math::BigRat; - - my $x = Math::BigRat->new('3/7'); $x += '5/9'; - - print $x->bstr(),"\n"; - print $x ** 2,"\n"; - - my $y = Math::BigRat->new('inf'); - print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n"; - - my $z = Math::BigRat->new(144); $z->bsqrt(); - -=head1 DESCRIPTION - -Math::BigRat complements Math::BigInt and Math::BigFloat by providing support -for arbitrary big rational numbers. - -=head2 MATH LIBRARY - -You can change the underlying module that does the low-level -math operations by using: - - use Math::BigRat try => 'GMP'; - -Note: This needs Math::BigInt::GMP installed. - -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::BigRat try => 'Foo,Math::BigInt::Bar'; - -If you want to get warned when the fallback occurs, replace "try" with -"lib": - - use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; - -If you want the code to die instead, replace "try" with -"only": - - use Math::BigRat only => 'Foo,Math::BigInt::Bar'; - -=head1 METHODS - -Any methods not listed here are derived from Math::BigFloat (or -Math::BigInt), so make sure you check these two modules for further -information. - -=head2 new() - - $x = Math::BigRat->new('1/3'); - -Create a new Math::BigRat object. Input can come in various forms: - - $x = Math::BigRat->new(123); # scalars - $x = Math::BigRat->new('inf'); # infinity - $x = Math::BigRat->new('123.3'); # float - $x = Math::BigRat->new('1/3'); # simple string - $x = Math::BigRat->new('1 / 3'); # spaced - $x = Math::BigRat->new('1 / 0.1'); # w/ floats - $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt - $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat - $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite - - # You can also give D and N as different objects: - $x = Math::BigRat->new( - Math::BigInt->new(-123), - Math::BigInt->new(7), - ); # => -123/7 - -=head2 numerator() - - $n = $x->numerator(); - -Returns a copy of the numerator (the part above the line) as signed BigInt. - -=head2 denominator() - - $d = $x->denominator(); - -Returns a copy of the denominator (the part under the line) as positive BigInt. - -=head2 parts() - - ($n,$d) = $x->parts(); - -Return a list consisting of (signed) numerator and (unsigned) denominator as -BigInts. - -=head2 numify() - - my $y = $x->numify(); - -Returns the object as a scalar. This will lose some data if the object -cannot be represented by a normal Perl scalar (integer or float), so -use L or L instead. - -This routine is automatically used whenever a scalar is required: - - my $x = Math::BigRat->new('3/1'); - @array = (0,1,2,3); - $y = $array[$x]; # set $y to 3 - -=head2 as_int()/as_number() - - $x = Math::BigRat->new('13/7'); - print $x->as_int(),"\n"; # '1' - -Returns a copy of the object as BigInt, truncated to an integer. - -C is an alias for C. - -=head2 as_float() - - $x = Math::BigRat->new('13/7'); - print $x->as_float(),"\n"; # '1' - - $x = Math::BigRat->new('2/3'); - print $x->as_float(5),"\n"; # '0.66667' - -Returns a copy of the object as BigFloat, preserving the -accuracy as wanted, or the default of 40 digits. - -This method was added in v0.22 of Math::BigRat (April 2008). - -=head2 as_hex() - - $x = Math::BigRat->new('13'); - print $x->as_hex(),"\n"; # '0xd' - -Returns the BigRat as hexadecimal string. Works only for integers. - -=head2 as_bin() - - $x = Math::BigRat->new('13'); - print $x->as_bin(),"\n"; # '0x1101' - -Returns the BigRat as binary string. Works only for integers. - -=head2 as_oct() - - $x = Math::BigRat->new('13'); - print $x->as_oct(),"\n"; # '015' - -Returns the BigRat as octal string. Works only for integers. - -=head2 from_hex()/from_bin()/from_oct() - - my $h = Math::BigRat->from_hex('0x10'); - my $b = Math::BigRat->from_bin('0b10000000'); - my $o = Math::BigRat->from_oct('020'); - -Create a BigRat from an hexadecimal, binary or octal number -in string form. - -=head2 length() - - $len = $x->length(); - -Return the length of $x in digitis for integer values. - -=head2 digit() - - print Math::BigRat->new('123/1')->digit(1); # 1 - print Math::BigRat->new('123/1')->digit(-1); # 3 - -Return the N'ths digit from X when X is an integer value. - -=head2 bnorm() - - $x->bnorm(); - -Reduce the number to the shortest form. This routine is called -automatically whenever it is needed. - -=head2 bfac() - - $x->bfac(); - -Calculates the factorial of $x. For instance: - - print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3 - print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5 - -Works currently only for integers. - -=head2 bround()/round()/bfround() - -Are not yet implemented. - -=head2 bmod() - - use Math::BigRat; - my $x = Math::BigRat->new('7/4'); - my $y = Math::BigRat->new('4/3'); - print $x->bmod($y); - -Set $x to the remainder of the division of $x by $y. - -=head2 bneg() - - $x->bneg(); - -Used to negate the object in-place. - -=head2 is_one() - - print "$x is 1\n" if $x->is_one(); - -Return true if $x is exactly one, otherwise false. - -=head2 is_zero() - - print "$x is 0\n" if $x->is_zero(); - -Return true if $x is exactly zero, otherwise false. - -=head2 is_pos()/is_positive() - - print "$x is >= 0\n" if $x->is_positive(); - -Return true if $x is positive (greater than or equal to zero), otherwise -false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't. - -C is an alias for C. - -=head2 is_neg()/is_negative() - - print "$x is < 0\n" if $x->is_negative(); - -Return true if $x is negative (smaller than zero), otherwise false. Please -note that '-inf' is also negative, while 'NaN' and '+inf' aren't. - -C is an alias for C. - -=head2 is_int() - - print "$x is an integer\n" if $x->is_int(); - -Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise -false. Please note that '-inf', 'inf' and 'NaN' aren't integer. - -=head2 is_odd() - - print "$x is odd\n" if $x->is_odd(); - -Return true if $x is odd, otherwise false. - -=head2 is_even() - - print "$x is even\n" if $x->is_even(); - -Return true if $x is even, otherwise false. - -=head2 bceil() - - $x->bceil(); - -Set $x to the next bigger integer value (e.g. truncate the number to integer -and then increment it by one). - -=head2 bfloor() - - $x->bfloor(); - -Truncate $x to an integer value. - -=head2 bsqrt() - - $x->bsqrt(); - -Calculate the square root of $x. - -=head2 broot() - - $x->broot($n); - -Calculate the N'th root of $x. - -=head2 badd()/bmul()/bsub()/bdiv()/bdec()/binc() - -Please see the documentation in L. - -=head2 copy() - - my $z = $x->copy(); - -Makes a deep copy of the object. - -Please see the documentation in L for further details. - -=head2 bstr()/bsstr() - - my $x = Math::BigInt->new('8/4'); - print $x->bstr(),"\n"; # prints 1/2 - print $x->bsstr(),"\n"; # prints 1/2 - -Return a string representating this object. - -=head2 bacmp()/bcmp() - -Used to compare numbers. - -Please see the documentation in L for further details. - -=head2 blsft()/brsft() - -Used to shift numbers left/right. - -Please see the documentation in L for further details. - -=head2 bpow() - - $x->bpow($y); - -Compute $x ** $y. - -Please see the documentation in L for further details. - -=head2 bexp() - - $x->bexp($accuracy); # calculate e ** X - -Calculates two integers A and B so that A/B is equal to C, where C is -Euler's number. - -This method was added in v0.20 of Math::BigRat (May 2007). - -See also L. - -=head2 bnok() - - $x->bnok($y); # x over y (binomial coefficient n over k) - -Calculates the binomial coefficient n over k, also called the "choose" -function. The result is equivalent to: - - ( n ) n! - | - | = ------- - ( k ) k!(n-k)! - -This method was added in v0.20 of Math::BigRat (May 2007). - -=head2 config() - - use Data::Dumper; - - print Dumper ( Math::BigRat->config() ); - print Math::BigRat->config()->{lib},"\n"; - -Returns a hash containing the configuration, e.g. the version number, lib -loaded etc. The following hash keys are currently filled in with the -appropriate information. - - key RO/RW Description - Example - ============================================================ - lib RO Name of the Math library - Math::BigInt::Calc - lib_version RO Version of 'lib' - 0.30 - class RO The class of config you just called - Math::BigRat - version RO version number of the class you used - 0.10 - upgrade RW To which class numbers are upgraded - undef - downgrade RW To which class numbers are downgraded - undef - precision RW Global precision - undef - accuracy RW Global accuracy - undef - round_mode RW Global round mode - even - div_scale RW Fallback accuracy for div - 40 - trap_nan RW Trap creation of NaN (undef = no) - undef - trap_inf RW Trap creation of +inf/-inf (undef = no) - undef - -By passing a reference to a hash you may set the configuration values. This -works only for values that a marked with a C above, anything else is -read-only. - -=head2 objectify() - -This is an internal routine that turns scalars into objects. - -=head1 BUGS - -Some things are not yet implemented, or only implemented half-way: - -=over 2 - -=item inf handling (partial) - -=item NaN handling (partial) - -=item rounding (not implemented except for bceil/bfloor) - -=item $x ** $y where $y is not an integer - -=item bmod(), blog(), bmodinv() and bmodpow() (partial) - -=back - -=head1 LICENSE - -This program is free software; you may redistribute it and/or modify it under -the same terms as Perl itself. - -=head1 SEE ALSO - -L and L as well as L, -L and L. - -See L for a way to use -Math::BigRat. - -The package at L -may contain more documentation and examples as well as testcases. - -=head1 AUTHORS - -(C) by Tels L 2001 - 2009. - -Currently maintained by Jonathan "Duke" Leto L - -=cut diff --git a/cpan/Math-BigRat/t/Math/BigRat/Test.pm b/cpan/Math-BigRat/t/Math/BigRat/Test.pm deleted file mode 100644 index 630a84359a..0000000000 --- a/cpan/Math-BigRat/t/Math/BigRat/Test.pm +++ /dev/null @@ -1,122 +0,0 @@ -package Math::BigRat::Test; - -require 5.005_02; -use strict; - -use Exporter; -use Math::BigRat; -use Math::BigFloat; -use vars qw($VERSION @ISA - $accuracy $precision $round_mode $div_scale); - -@ISA = qw(Math::BigRat Exporter); -$VERSION = 0.04; - -use overload; # inherit overload from BigRat - -# Globals -$accuracy = $precision = undef; -$round_mode = 'even'; -$div_scale = 40; - -my $class = 'Math::BigRat::Test'; - -#ub 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]; -# # Store the floating point value -# my $self = Math::BigFloat->new($value,$a,$p,$round_mode); -# bless $self, $class; -# $self->{'_custom'} = 1; # make sure this never goes away -# return $self; -#} - -BEGIN - { - *fstr = \&bstr; - *fsstr = \&bsstr; - *objectify = \&Math::BigInt::objectify; - *AUTOLOAD = \&Math::BigRat::AUTOLOAD; - no strict 'refs'; - foreach my $method ( qw/ div acmp floor ceil root sqrt log fac modpow modinv/) - { - *{'b' . $method} = \&{'Math::BigRat::b' . $method}; - } - } - -sub fround - { - my ($x,$a) = @_; - - #print "$a $accuracy $precision $round_mode\n"; - Math::BigFloat->round_mode($round_mode); - Math::BigFloat->accuracy($a || $accuracy); - Math::BigFloat->precision(undef); - my $y = Math::BigFloat->new($x->bsstr(),undef,undef); - $class->new($y->fround($a)); - } - -sub ffround - { - my ($x,$p) = @_; - - Math::BigFloat->round_mode($round_mode); - Math::BigFloat->accuracy(undef); - Math::BigFloat->precision($p || $precision); - my $y = Math::BigFloat->new($x->bsstr(),undef,undef); - $class->new($y->ffround($p)); - } - -sub bstr - { - # calculate a BigFloat compatible string output - my ($x) = @_; - - $x = $class->new($x) unless ref $x; - - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; - } - - my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 - -# print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n"; - return $s.$x->{_n} if $x->{_d}->is_one(); - my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); - local $Math::BigFloat::accuracy = $accuracy || $x->{_a}; - local $Math::BigFloat::precision = $precision || $x->{_p}; - $s.$output->bstr(); - } - -sub numify - { - $_[0]->bsstr(); - } - -sub bsstr - { - # calculate a BigFloat compatible string output - my ($x) = @_; - - $x = $class->new($x) unless ref $x; - - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; - } - - my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 - - my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); - return $s.$output->bsstr(); - } - -1; diff --git a/cpan/Math-BigRat/t/big_ap.t b/cpan/Math-BigRat/t/big_ap.t deleted file mode 100644 index 39a2f7185b..0000000000 --- a/cpan/Math-BigRat/t/big_ap.t +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl -w - -# Test that accuracy() and precision() in BigInt/BigFloat do not disturb -# the rounding force in BigRat. - -use strict; -use Test::More tests => 17; - -use Math::BigInt; -use Math::BigFloat; -use Math::BigRat; - -my $r = 'Math::BigRat'; -my $proper = $r->new('12345678901234567890/2'); -my $proper_inc = $r->new('12345678901234567890/2')->binc(); -my $proper_dec = $r->new('12345678901234567890/2')->bdec(); -my $proper_int = Math::BigInt->new('12345678901234567890'); -my $proper_float = Math::BigFloat->new('12345678901234567890'); -my $proper2 = $r->new('12345678901234567890'); - -print "# Start\n"; - -Math::BigInt->accuracy(3); -Math::BigFloat->accuracy(5); - -my ($x,$y,$z); - -############################################################################## -# new() - -$z = $r->new('12345678901234567890/2'); -is ($z,$proper); - -$z = $r->new('1234567890123456789E1'); -is ($z,$proper2); - -$z = $r->new('12345678901234567890/1E0'); -is ($z,$proper2); -$z = $r->new('1234567890123456789e1/1'); -is ($z,$proper2); -$z = $r->new('1234567890123456789e1/1E0'); -is ($z,$proper2); - -$z = $r->new($proper_int); -is ($z,$proper2); - -$z = $r->new($proper_float); -is ($z,$proper2); - -############################################################################## -# bdiv - -$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2'); -$z = $x->copy->bdiv($y); -is ($z,$proper); - -############################################################################## -# bmul - -$x = $r->new("$proper"); $y = Math::BigRat->new('1'); -$z = $x->copy->bmul($y); -is ($z,$proper); -$z = $r->new('12345678901234567890/1E0'); -is ($z,$proper2); - -$z = $r->new($proper_int); -is ($z,$proper2); - -$z = $r->new($proper_float); -is ($z,$proper2); - -############################################################################## -# bdiv - -$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2'); -$z = $x->copy->bdiv($y); -is ($z,$proper); - -############################################################################## -# bmul - -$x = $r->new("$proper"); $y = Math::BigRat->new('1'); -$z = $x->copy->bmul($y); -is ($z,$proper); - -$x = $r->new("$proper"); $y = Math::BigRat->new('2'); -$z = $x->copy->bmul($y); -is ($z,$proper2); - -############################################################################## -# binc/bdec - -$x = $proper->copy()->binc(); is ($x,$proper_inc); -$x = $proper->copy()->bdec(); is ($x,$proper_dec); - diff --git a/cpan/Math-BigRat/t/bigfltpm.inc b/cpan/Math-BigRat/t/bigfltpm.inc deleted file mode 100644 index c51741bd42..0000000000 --- a/cpan/Math-BigRat/t/bigfltpm.inc +++ /dev/null @@ -1,1673 +0,0 @@ -#include this file into another test for subclass testing... - -ok ($class->config()->{lib},$CL); - -use strict; - -my $z; - -while () - { - chomp; - $_ =~ s/#.*$//; # remove comments - $_ =~ s/\s+$//; # trailing spaces - next if /^$/; # skip empty lines & comments - if (s/^&//) - { - $f = $_; - } - elsif (/^\$/) - { - $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale - #print "\$setup== $setup\n"; - } - else - { - if (m|^(.*?):(/.+)$|) - { - $ans = $2; - @args = split(/:/,$1,99); - } - else - { - @args = split(/:/,$_,99); $ans = pop(@args); - } - $try = "\$x = $class->new(\"$args[0]\");"; - if ($f eq "fnorm") - { - $try .= "\$x;"; - } elsif ($f eq "finf") { - $try .= "\$x->finf('$args[1]');"; - } elsif ($f eq "is_inf") { - $try .= "\$x->is_inf('$args[1]');"; - } elsif ($f eq "fone") { - $try .= "\$x->bone('$args[1]');"; - } elsif ($f eq "fstr") { - $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; - $try .= '$x->fstr();'; - } elsif ($f eq "parts") { - # ->bstr() to see if an object is returned - $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; - $try .= '"$a $b";'; - } elsif ($f eq "exponent") { - # ->bstr() to see if an object is returned - $try .= '$x->exponent()->bstr();'; - } elsif ($f eq "mantissa") { - # ->bstr() to see if an object is returned - $try .= '$x->mantissa()->bstr();'; - } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) { - $try .= "\$x->$f();"; - # some unary ops (test the fxxx form, since that is done by AUTOLOAD) - } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { - $try .= "\$x->f$1();"; - # some is_xxx test function - } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { - $try .= "\$x->$f();"; - } elsif ($f eq "finc") { - $try .= '++$x;'; - } elsif ($f eq "fdec") { - $try .= '--$x;'; - }elsif ($f eq "fround") { - $try .= "$setup; \$x->fround($args[1]);"; - } elsif ($f eq "ffround") { - $try .= "$setup; \$x->ffround($args[1]);"; - } elsif ($f eq "fsqrt") { - $try .= "$setup; \$x->fsqrt();"; - } elsif ($f eq "ffac") { - $try .= "$setup; \$x->ffac();"; - } elsif ($f eq "flog") { - if (defined $args[1] && $args[1] ne '') - { - $try .= "\$y = $class->new($args[1]);"; - $try .= "$setup; \$x->flog(\$y);"; - } - else - { - $try .= "$setup; \$x->flog();"; - } - } - else - { - $try .= "\$y = $class->new(\"$args[1]\");"; - - if ($f eq "bgcd") - { - if (defined $args[2]) - { - $try .= " \$z = $class->new(\"$args[2]\"); "; - } - $try .= "$class\::bgcd(\$x, \$y"; - $try .= ", \$z" if (defined $args[2]); - $try .= " );"; - } - elsif ($f eq "blcm") - { - if (defined $args[2]) - { - $try .= " \$z = $class->new(\"$args[2]\"); "; - } - $try .= "$class\::blcm(\$x, \$y"; - $try .= ", \$z" if (defined $args[2]); - $try .= " );"; - } elsif ($f eq "fcmp") { - $try .= '$x->fcmp($y);'; - } elsif ($f eq "facmp") { - $try .= '$x->facmp($y);'; - } elsif ($f eq "fpow") { - $try .= '$x ** $y;'; - } elsif ($f eq "bnok") { - $try .= '$x->bnok($y);'; - } elsif ($f eq "froot") { - $try .= "$setup; \$x->froot(\$y);"; - } elsif ($f eq "fadd") { - $try .= '$x + $y;'; - } elsif ($f eq "fsub") { - $try .= '$x - $y;'; - } elsif ($f eq "fmul") { - $try .= '$x * $y;'; - } elsif ($f eq "fdiv") { - $try .= "$setup; \$x / \$y;"; - } elsif ($f eq "fdiv-list") { - $try .= "$setup; join(',',\$x->fdiv(\$y));"; - } elsif ($f eq "frsft") { - $try .= '$x >> $y;'; - } elsif ($f eq "flsft") { - $try .= '$x << $y;'; - } elsif ($f eq "fmod") { - $try .= '$x % $y;'; - } else { warn "Unknown op '$f'"; } - } - # print "# Trying: '$try'\n"; - $ans1 = eval $try; - print "# Error: $@\n" if $@; - if ($ans =~ m|^/(.*)$|) - { - my $pat = $1; - if ($ans1 =~ /$pat/) - { - ok (1,1); - } - else - { - print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); - } - } - else - { - if ($ans eq "") - { - ok_undef ($ans1); - } - else - { - print "# Tried: '$try'\n" if !ok ($ans1, $ans); - if (ref($ans1) eq "$class") - { - # float numbers are normalized (for now), so mantissa shouldn't have - # trailing zeros - #print $ans1->_trailing_zeros(),"\n"; - print "# Has trailing zeros after '$try'\n" - if !ok ($CL->_zeros( $ans1->{_m}), 0); - } - } - } # end pattern or string - } - } # end while - -# check whether $class->new( Math::BigInt->new()) destroys it -# ($y == 12 in this case) -$x = Math::BigInt->new(1200); $y = $class->new($x); -ok ($y,1200); ok ($x,1200); - -############################################################################### -# Really huge, big, ultra-mega-biggy-monster exponents -# Technically, the exponents should not be limited (they are BigInts), but -# practically there are a few places were they are limited to a Perl scalar. -# This is sometimes for speed, sometimes because otherwise the number wouldn't -# fit into your memory (just think of 1e123456789012345678901234567890 + 1!) -# anyway. We don't test everything here, but let's make sure it just basically -# works. - -my $monster = '1e1234567890123456789012345678901234567890'; - -# new and exponent -ok ($class->new($monster)->bsstr(), - '1e+1234567890123456789012345678901234567890'); -ok ($class->new($monster)->exponent(), - '1234567890123456789012345678901234567890'); -# cmp -ok ($class->new($monster) > 0,1); - -# sub/mul -ok ($class->new($monster)->bsub( $monster),0); -ok ($class->new($monster)->bmul(2)->bsstr(), - '2e+1234567890123456789012345678901234567890'); - -# mantissa -$monster = '1234567890123456789012345678901234567890e2'; -ok ($class->new($monster)->mantissa(), - '123456789012345678901234567890123456789'); - -############################################################################### -# zero,inf,one,nan - -$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); -$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); -$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); -$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); - -############################################################################### -# bone/binf etc as plain calls (Lite failed them) - -ok ($class->fzero(),0); -ok ($class->fone(),1); -ok ($class->fone('+'),1); -ok ($class->fone('-'),-1); -ok ($class->fnan(),'NaN'); -ok ($class->finf(),'inf'); -ok ($class->finf('+'),'inf'); -ok ($class->finf('-'),'-inf'); -ok ($class->finf('-inf'),'-inf'); - -$class->accuracy(undef); $class->precision(undef); # reset - -############################################################################### -# bug in bsstr()/numify() showed up in after-rounding in bdiv() - -$x = $class->new('0.008'); $y = $class->new(2); -$x->bdiv(3,$y); -ok ($x,'0.0027'); - -############################################################################### -# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() -# correctly modifies $x - - -$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); - -$class->precision(undef); -$x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); - -$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); - -{ - no strict 'refs'; - # A and P set => NaN - ${${class}.'::accuracy'} = 4; $x = $class->new(12); - $x->fsqrt(3); ok ($x,'NaN'); - # supplied arg overrides set global - $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); - $class->accuracy(undef); $class->precision(undef); # reset for further tests -} - -############################################################################# -# can we call objectify (broken until v1.52) - -{ - no strict; - $try = - '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);'; - $ans = eval $try; - ok ($ans,"$class 4 5"); -} - -############################################################################# -# is_one('-') (broken until v1.64) - -ok ($class->new(-1)->is_one(),0); -ok ($class->new(-1)->is_one('-'),1); - -############################################################################# -# bug 1/0.5 leaving 2e-0 instead of 2e0 - -ok ($class->new(1)->fdiv('0.5')->bsstr(),'2e+0'); - -############################################################################### -# [perl #30609] bug with $x -= $x not being 0, but 2*$x - -$x = $class->new(3); $x -= $x; ok ($x, 0); -$x = $class->new(-3); $x -= $x; ok ($x, 0); -$x = $class->new(3); $x += $x; ok ($x, 6); -$x = $class->new(-3); $x += $x; ok ($x, -6); - -$x = $class->new('NaN'); $x -= $x; ok ($x->is_nan(), 1); -$x = $class->new('inf'); $x -= $x; ok ($x->is_nan(), 1); -$x = $class->new('-inf'); $x -= $x; ok ($x->is_nan(), 1); - -$x = $class->new('NaN'); $x += $x; ok ($x->is_nan(), 1); -$x = $class->new('inf'); $x += $x; ok ($x->is_inf(), 1); -$x = $class->new('-inf'); $x += $x; ok ($x->is_inf('-'), 1); - -$x = $class->new('3.14'); $x -= $x; ok ($x, 0); -$x = $class->new('-3.14'); $x -= $x; ok ($x, 0); -$x = $class->new('3.14'); $x += $x; ok ($x, '6.28'); -$x = $class->new('-3.14'); $x += $x; ok ($x, '-6.28'); - -$x = $class->new('3.14'); $x *= $x; ok ($x, '9.8596'); -$x = $class->new('-3.14'); $x *= $x; ok ($x, '9.8596'); -$x = $class->new('3.14'); $x /= $x; ok ($x, '1'); -$x = $class->new('-3.14'); $x /= $x; ok ($x, '1'); -$x = $class->new('3.14'); $x %= $x; ok ($x, '0'); -$x = $class->new('-3.14'); $x %= $x; ok ($x, '0'); - -############################################################################### -# the following two were reported by "kenny" via hotmail.com: - -#perl -MMath::BigFloat -wle 'print Math::BigFloat->new(0)->bpow(".1")' -#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. - -$x = $class->new(0); $y = $class->new('0.1'); -ok ($x ** $y, 0, 'no warnings and zero result'); - -#perl -MMath::BigFloat -lwe 'print Math::BigFloat->new(".222222222222222222222222222222222222222222")->bceil()' -#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. - -$x = $class->new(".222222222222222222222222222222222222222222"); -ok ($x->bceil(), 1, 'no warnings and one as result'); - -############################################################################### -# test **=, <<=, >>= - -# ((2^148)-1)/17 -$x = $class->new(2); $x **= 148; $x++; $x->bdiv(17, 60)->bfloor(); $x->accuracy(undef); -ok ($x,"20988936657440586486151264256610222593863921"); -ok ($x->length(),length "20988936657440586486151264256610222593863921"); - -$x = $class->new('2'); -my $y = $class->new('18'); -ok ($x <<= $y, 2 << 18); -ok ($x, 2 << 18); -ok ($x >>= $y, 2); -ok ($x, 2); - -$x = $class->new('2'); -$y = $class->new('18.2'); -$x <<= $y; # 2 * (2 ** 18.2); - -ok ($x->copy()->bfround(-9), '602248.763144685'); -ok ($x >>= $y, 2); # 2 * (2 ** 18.2) / (2 ** 18.2) => 2 -ok ($x, 2); - -1; # all done - -############################################################################### -# Perl 5.005 does not like ok ($x,undef) - -sub ok_undef - { - my $x = shift; - - ok (1,1) and return if !defined $x; - ok ($x,'undef'); - } - -__DATA__ -&bgcd -inf:12:NaN --inf:12:NaN -12:inf:NaN -12:-inf:NaN -inf:inf:NaN -inf:-inf:NaN --inf:-inf:NaN -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+0:+0:0 -+0:+1:1 -+1:+0:1 -+1:+1:1 -+2:+3:1 -+3:+2:1 --3:+2:1 --3:-2:1 --144:-60:12 -144:-60:12 -144:60:12 -100:625:25 -4096:81:1 -1034:804:2 -27:90:56:1 -27:90:54:9 -&blcm -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+0:+0:NaN -+1:+0:0 -+0:+1:0 -+27:+90:270 -+1034:+804:415668 -$div_scale = 40; -&bnok -+inf:10:inf -NaN:NaN:NaN -NaN:1:NaN -1:NaN:NaN -1:1:1 -# k > n -1:2:0 -2:3:0 -# k < 0 -1:-2:0 -# 7 over 3 = 35 -7:3:35 -7:6:1 -100:90:17310309456440 -&flog -0::NaN --1::NaN --2::NaN -# base > 0, base != 1 -2:-1:NaN -2:0:NaN -2:1:NaN -# log(1) is always 1, regardless of $base -1::0 -1:1:0 -1:2:0 -2::0.6931471805599453094172321214581765680755 -2.718281828::0.9999999998311266953289851340574956564911 -$div_scale = 20; -2.718281828::0.99999999983112669533 -$div_scale = 15; -123::4.81218435537242 -10::2.30258509299405 -1000::6.90775527898214 -100::4.60517018598809 -2::0.693147180559945 -3.1415::1.14470039286086 -12345::9.42100640177928 -0.001::-6.90775527898214 -# bug until v1.71: -10:10:1 -100:100:1 -# reset for further tests -$div_scale = 40; -1::0 -&frsft -NaNfrsft:2:NaN -0:2:0 -1:1:0.5 -2:1:1 -4:1:2 -123:1:61.5 -32:3:4 -&flsft -NaNflsft:0:NaN -2:1:4 -4:3:32 -5:3:40 -1:2:4 -0:5:0 -&fnorm -1:1 --0:0 -fnormNaN:NaN -+inf:inf --inf:-inf -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 -.2E2:20 -1.E3:1000 -# some inputs that result in zero -0e0:0 -+0e0:0 -+0e+0:0 --0e+0:0 -0e-0:0 --0e-0:0 -+0e-0:0 -000:0 -00e2:0 -00e02:0 -000e002:0 -000e1230:0 -00e-3:0 -00e+3:0 -00e-03:0 -00e+03:0 --000:0 --00e2:0 --00e02:0 --000e002:0 --000e1230:0 --00e-3:0 --00e+3:0 --00e-03:0 --00e+03:0 -&as_number -0:0 -1:1 -1.2:1 -2.345:2 --2:-2 --123.456:-123 --200:-200 -# test for bug in brsft() not handling cases that return 0 -0.000641:0 -0.0006412:0 -0.00064123:0 -0.000641234:0 -0.0006412345:0 -0.00064123456:0 -0.000641234567:0 -0.0006412345678:0 -0.00064123456789:0 -0.1:0 -0.01:0 -0.001:0 -0.0001:0 -0.00001:0 -0.000001:0 -0.0000001:0 -0.00000001:0 -0.000000001:0 -0.0000000001:0 -0.00000000001:0 -0.12345:0 -0.123456:0 -0.1234567:0 -0.12345678:0 -0.123456789:0 -&finf -1:+:inf -2:-:-inf -3:abc:inf -&as_hex -+inf:inf --inf:-inf -hexNaN:NaN -0:0x0 -5:0x5 --5:-0x5 -&as_bin -+inf:inf --inf:-inf -hexNaN:NaN -0:0b0 -5:0b101 --5:-0b101 -&numify -# uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output -0:0e+1 -+1:1e+0 -1234:1234e+0 -NaN:NaN -+inf:inf --inf:-inf --5:-5e+0 -100:1e+2 --100:-1e+2 -&fnan -abc:NaN -2:NaN --2:NaN -0:NaN -&fone -2:+:1 --2:-:-1 --2:+:1 -2:-:-1 -0::1 --2::1 -abc::1 -2:abc:1 -&fsstr -+inf:inf --inf:-inf -abcfsstr:NaN --abcfsstr:NaN -1234.567:1234567e-3 -123:123e+0 --5:-5e+0 --100:-1e+2 -&fstr -+inf:::inf --inf:::-inf -abcfstr:::NaN -1234.567:9::1234.56700 -1234.567::-6:1234.567000 -12345:5::12345 -0.001234:6::0.00123400 -0.001234::-8:0.00123400 -0:4::0 -0::-4:0.0000 -&fnorm -inf:inf -+inf:inf --inf:-inf -+infinity:NaN -+-inf:NaN -abc:NaN - 1 a:NaN -1bcd2:NaN -11111b:NaN -+1z:NaN --1z:NaN -0e999:0 -0e-999:0 --0e999:0 --0e-999:0 -0:0 -+0:0 -+00:0 -+0_0_0:0 -000000_0000000_00000:0 --0:0 --0000:0 -+1:1 -+01:1 -+001:1 -+00000100000:100000 -123456789:123456789 --1:-1 --01:-1 --001:-1 --123456789:-123456789 --00000100000:-100000 -123.456a:NaN -123.456:123.456 -0.01:0.01 -.002:0.002 -+.2:0.2 --0.0003:-0.0003 --.0000000004:-0.0000000004 -123456E2:12345600 -123456E-2:1234.56 --123456E2:-12345600 --123456E-2:-1234.56 -1e1:10 -2e-11:0.00000000002 -# excercise _split - .02e-1:0.002 - 000001:1 - -00001:-1 - -1:-1 - 000.01:0.01 - -000.0023:-0.0023 - 1.1e1:11 --3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 --4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 -&fpow -NaN:1:NaN -1:NaN:NaN -NaN:-1:NaN --1:NaN:NaN -NaN:-21:NaN --21:NaN:NaN -NaN:21:NaN -21:NaN:NaN -0:0:1 -0:1:0 -0:9:0 -0:-2:inf -2:2:4 -1:2:1 -1:3:1 --1:2:1 --1:3:-1 -123.456:2:15241.383936 -2:-2:0.25 -2:-3:0.125 -128:-2:0.00006103515625 -abc:123.456:NaN -123.456:abc:NaN -+inf:123.45:inf --inf:123.45:-inf -+inf:-123.45:inf --inf:-123.45:-inf --2:2:4 --2:3:-8 --2:4:16 --2:5:-32 --3:2:9 --3:3:-27 --3:4:81 --3:5:-243 -# 2 ** 0.5 == sqrt(2) -# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0) -2:0.5:1.41421356237309504880168872420969807857 -#2:0.2:1.148698354997035006798626946777927589444 -#6:1.5:14.6969384566990685891837044482353483518 -$div_scale = 20; -#62.5:12.5:26447206647554886213592.3959144 -$div_scale = 40; -&fneg -fnegNaN:NaN -+inf:-inf --inf:inf -+0:0 -+1:-1 --1:1 -+123456789:-123456789 --123456789:123456789 -+123.456789:-123.456789 --123456.789:123456.789 -&fabs -fabsNaN:NaN -+inf:inf --inf:inf -+0:0 -+1:1 --1:1 -+123456789:123456789 --123456789:123456789 -+123.456789:123.456789 --123456.789:123456.789 -&fround -$round_mode = "trunc" -+inf:5:inf --inf:5:-inf -0:5:0 -NaNfround:5:NaN -+10123456789:5:10123000000 --10123456789:5:-10123000000 -+10123456789.123:5:10123000000 --10123456789.123:5:-10123000000 -+10123456789:9:10123456700 --10123456789:9:-10123456700 -+101234500:6:101234000 --101234500:6:-101234000 -$round_mode = "zero" -+20123456789:5:20123000000 --20123456789:5:-20123000000 -+20123456789.123:5:20123000000 --20123456789.123:5:-20123000000 -+20123456789:9:20123456800 --20123456789:9:-20123456800 -+201234500:6:201234000 --201234500:6:-201234000 -$round_mode = "+inf" -+30123456789:5:30123000000 --30123456789:5:-30123000000 -+30123456789.123:5:30123000000 --30123456789.123:5:-30123000000 -+30123456789:9:30123456800 --30123456789:9:-30123456800 -+301234500:6:301235000 --301234500:6:-301234000 -$round_mode = "-inf" -+40123456789:5:40123000000 --40123456789:5:-40123000000 -+40123456789.123:5:40123000000 --40123456789.123:5:-40123000000 -+40123456789:9:40123456800 --40123456789:9:-40123456800 -+401234500:6:401234000 --401234500:6:-401235000 -$round_mode = "odd" -+50123456789:5:50123000000 --50123456789:5:-50123000000 -+50123456789.123:5:50123000000 --50123456789.123:5:-50123000000 -+50123456789:9:50123456800 --50123456789:9:-50123456800 -+501234500:6:501235000 --501234500:6:-501235000 -$round_mode = "even" -+60123456789:5:60123000000 --60123456789:5:-60123000000 -+60123456789:9:60123456800 --60123456789:9:-60123456800 -+601234500:6:601234000 --601234500:6:-601234000 -+60123456789.0123:5:60123000000 --60123456789.0123:5:-60123000000 -$round_mode = "common" -+60123456789:5:60123000000 --60123456789:5:-60123000000 -+60123456789:6:60123500000 --60123456789:6:-60123500000 -+60123456789:9:60123456800 --60123456789:9:-60123456800 -+601234500:6:601235000 --601234500:6:-601235000 -+601234400:6:601234000 --601234400:6:-601234000 -+601234600:6:601235000 --601234600:6:-601235000 -+601234300:6:601234000 -+60123456789.0123:5:60123000000 --60123456789.0123:5:-60123000000 -&ffround -$round_mode = "trunc" -+inf:5:inf --inf:5:-inf -0:5:0 -NaNffround:5:NaN -+1.23:-1:1.2 -+1.234:-1:1.2 -+1.2345:-1:1.2 -+1.23:-2:1.23 -+1.234:-2:1.23 -+1.2345:-2:1.23 -+1.23:-3:1.230 -+1.234:-3:1.234 -+1.2345:-3:1.234 --1.23:-1:-1.2 -+1.27:-1:1.2 --1.27:-1:-1.2 -+1.25:-1:1.2 --1.25:-1:-1.2 -+1.35:-1:1.3 --1.35:-1:-1.3 --0.0061234567890:-1:0.0 --0.0061:-1:0.0 --0.00612:-1:0.0 --0.00612:-2:0.00 --0.006:-1:0.0 --0.006:-2:0.00 --0.0006:-2:0.00 --0.0006:-3:0.000 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:0 -0.41:0:0 -$round_mode = "zero" -+2.23:-1:/2.2(?:0{5}\d+)? --2.23:-1:/-2.2(?:0{5}\d+)? -+2.27:-1:/2.(?:3|29{5}\d+) --2.27:-1:/-2.(?:3|29{5}\d+) -+2.25:-1:/2.2(?:0{5}\d+)? --2.25:-1:/-2.2(?:0{5}\d+)? -+2.35:-1:/2.(?:3|29{5}\d+) --2.35:-1:/-2.(?:3|29{5}\d+) --0.0065:-1:0.0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -$round_mode = "+inf" -+3.23:-1:/3.2(?:0{5}\d+)? --3.23:-1:/-3.2(?:0{5}\d+)? -+3.27:-1:/3.(?:3|29{5}\d+) --3.27:-1:/-3.(?:3|29{5}\d+) -+3.25:-1:/3.(?:3|29{5}\d+) --3.25:-1:/-3.2(?:0{5}\d+)? -+3.35:-1:/3.(?:4|39{5}\d+) --3.35:-1:/-3.(?:3|29{5}\d+) --0.0065:-1:0.0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:1 -0.51:0:1 -0.41:0:0 -$round_mode = "-inf" -+4.23:-1:/4.2(?:0{5}\d+)? --4.23:-1:/-4.2(?:0{5}\d+)? -+4.27:-1:/4.(?:3|29{5}\d+) --4.27:-1:/-4.(?:3|29{5}\d+) -+4.25:-1:/4.2(?:0{5}\d+)? --4.25:-1:/-4.(?:3|29{5}\d+) -+4.35:-1:/4.(?:3|29{5}\d+) --4.35:-1:/-4.(?:4|39{5}\d+) --0.0065:-1:0.0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.007|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -$round_mode = "odd" -+5.23:-1:/5.2(?:0{5}\d+)? --5.23:-1:/-5.2(?:0{5}\d+)? -+5.27:-1:/5.(?:3|29{5}\d+) --5.27:-1:/-5.(?:3|29{5}\d+) -+5.25:-1:/5.(?:3|29{5}\d+) --5.25:-1:/-5.(?:3|29{5}\d+) -+5.35:-1:/5.(?:3|29{5}\d+) --5.35:-1:/-5.(?:3|29{5}\d+) --0.0065:-1:0.0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.007|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:1 -0.51:0:1 -0.41:0:0 -$round_mode = "even" -+6.23:-1:/6.2(?:0{5}\d+)? --6.23:-1:/-6.2(?:0{5}\d+)? -+6.27:-1:/6.(?:3|29{5}\d+) --6.27:-1:/-6.(?:3|29{5}\d+) -+6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) --6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) -+6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) --6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) --0.0065:-1:0.0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -0.01234567:-3:0.012 -0.01234567:-4:0.0123 -0.01234567:-5:0.01235 -0.01234567:-6:0.012346 -0.01234567:-7:0.0123457 -0.01234567:-8:0.01234567 -0.01234567:-9:0.012345670 -0.01234567:-12:0.012345670000 -&fcmp -fcmpNaN:fcmpNaN: -fcmpNaN:+0: -+0:fcmpNaN: -+0:+0:0 --1:+0:-1 -+0:-1:1 -+1:+0:1 -+0:+1:-1 --1:+1:-1 -+1:-1:1 --1:-1:0 -+1:+1:0 --1.1:0:-1 -+0:-1.1:1 -+1.1:+0:1 -+0:+1.1:-1 -+123:+123:0 -+123:+12:1 -+12:+123:-1 --123:-123:0 --123:-12:-1 --12:-123:1 -+123:+124:-1 -+124:+123:1 --123:-124:1 --124:-123:-1 -0:0.01:-1 -0:0.0001:-1 -0:-0.0001:1 -0:-0.1:1 -0.1:0:1 -0.00001:0:1 --0.0001:0:-1 --0.1:0:-1 -0:0.0001234:-1 -0:-0.0001234:1 -0.0001234:0:1 --0.0001234:0:-1 -0.0001:0.0005:-1 -0.0005:0.0001:1 -0.005:0.0001:1 -0.001:0.0005:1 -0.000001:0.0005:-1 -0.00000123:0.0005:-1 -0.00512:0.0001:1 -0.005:0.000112:1 -0.00123:0.0005:1 -1.5:2:-1 -2:1.5:1 -1.54321:234:-1 -234:1.54321:1 -# infinity --inf:5432112345:-1 -+inf:5432112345:1 --inf:-5432112345:-1 -+inf:-5432112345:1 --inf:54321.12345:-1 -+inf:54321.12345:1 --inf:-54321.12345:-1 -+inf:-54321.12345:1 -+inf:+inf:0 --inf:-inf:0 -+inf:-inf:1 --inf:+inf:-1 -# return undef -+inf:NaN: -NaN:inf: --inf:NaN: -NaN:-inf: -&facmp -fcmpNaN:fcmpNaN: -fcmpNaN:+0: -+0:fcmpNaN: -+0:+0:0 --1:+0:1 -+0:-1:-1 -+1:+0:1 -+0:+1:-1 --1:+1:0 -+1:-1:0 --1:-1:0 -+1:+1:0 --1.1:0:1 -+0:-1.1:-1 -+1.1:+0:1 -+0:+1.1:-1 -+123:+123:0 -+123:+12:1 -+12:+123:-1 --123:-123:0 --123:-12:1 --12:-123:-1 -+123:+124:-1 -+124:+123:1 --123:-124:-1 --124:-123:1 -0:0.01:-1 -0:0.0001:-1 -0:-0.0001:-1 -0:-0.1:-1 -0.1:0:1 -0.00001:0:1 --0.0001:0:1 --0.1:0:1 -0:0.0001234:-1 -0:-0.0001234:-1 -0.0001234:0:1 --0.0001234:0:1 -0.0001:0.0005:-1 -0.0005:0.0001:1 -0.005:0.0001:1 -0.001:0.0005:1 -0.000001:0.0005:-1 -0.00000123:0.0005:-1 -0.00512:0.0001:1 -0.005:0.000112:1 -0.00123:0.0005:1 -1.5:2:-1 -2:1.5:1 -1.54321:234:-1 -234:1.54321:1 -# infinity --inf:5432112345:1 -+inf:5432112345:1 --inf:-5432112345:1 -+inf:-5432112345:1 --inf:54321.12345:1 -+inf:54321.12345:1 --inf:-54321.12345:1 -+inf:-54321.12345:1 -+inf:+inf:0 --inf:-inf:0 -+inf:-inf:0 --inf:+inf:0 -5:inf:-1 --1:inf:-1 -5:-inf:-1 --1:-inf:-1 -# return undef -+inf:facmpNaN: -facmpNaN:inf: --inf:facmpNaN: -facmpNaN:-inf: -&fdec -fdecNaN:NaN -+inf:inf --inf:-inf -+0:-1 -+1:0 --1:-2 -1.23:0.23 --1.23:-2.23 -100:99 -101:100 --100:-101 --99:-100 --98:-99 -99:98 -&finc -fincNaN:NaN -+inf:inf --inf:-inf -+0:1 -+1:2 --1:0 -1.23:2.23 --1.23:-0.23 -100:101 --100:-99 --99:-98 --101:-100 -99:100 -&fadd -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:NaN --inf:+inf:NaN -+inf:+inf:inf --inf:-inf:-inf -baddNaN:+inf:NaN -baddNaN:+inf:NaN -+inf:baddNaN:NaN --inf:baddNaN:NaN -+0:+0:0 -+1:+0:1 -+0:+1:1 -+1:+1:2 --1:+0:-1 -+0:-1:-1 --1:-1:-2 --1:+1:0 -+1:-1:0 -+9:+1:10 -+99:+1:100 -+999:+1:1000 -+9999:+1:10000 -+99999:+1:100000 -+999999:+1:1000000 -+9999999:+1:10000000 -+99999999:+1:100000000 -+999999999:+1:1000000000 -+9999999999:+1:10000000000 -+99999999999:+1:100000000000 -+10:-1:9 -+100:-1:99 -+1000:-1:999 -+10000:-1:9999 -+100000:-1:99999 -+1000000:-1:999999 -+10000000:-1:9999999 -+100000000:-1:99999999 -+1000000000:-1:999999999 -+10000000000:-1:9999999999 -+123456789:+987654321:1111111110 --123456789:+987654321:864197532 --123456789:-987654321:-1111111110 -+123456789:-987654321:-864197532 -0.001234:0.0001234:0.0013574 -&fsub -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:inf --inf:+inf:-inf -+inf:+inf:NaN --inf:-inf:NaN -baddNaN:+inf:NaN -baddNaN:+inf:NaN -+inf:baddNaN:NaN --inf:baddNaN:NaN -+0:+0:0 -+1:+0:1 -+0:+1:-1 -+1:+1:0 --1:+0:-1 -+0:-1:1 --1:-1:0 --1:+1:-2 -+1:-1:2 -+9:+1:8 -+99:+1:98 -+999:+1:998 -+9999:+1:9998 -+99999:+1:99998 -+999999:+1:999998 -+9999999:+1:9999998 -+99999999:+1:99999998 -+999999999:+1:999999998 -+9999999999:+1:9999999998 -+99999999999:+1:99999999998 -+10:-1:11 -+100:-1:101 -+1000:-1:1001 -+10000:-1:10001 -+100000:-1:100001 -+1000000:-1:1000001 -+10000000:-1:10000001 -+100000000:-1:100000001 -+1000000000:-1:1000000001 -+10000000000:-1:10000000001 -+123456789:+987654321:-864197532 --123456789:+987654321:-1111111110 --123456789:-987654321:864197532 -+123456789:-987654321:1111111110 -&fmul -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:NaNmul:NaN -+inf:NaNmul:NaN -NaNmul:+inf:NaN -NaNmul:-inf:NaN -+inf:+inf:inf -+inf:-inf:-inf -+inf:-inf:-inf -+inf:+inf:inf -+inf:123.34:inf -+inf:-123.34:-inf --inf:123.34:-inf --inf:-123.34:inf -123.34:+inf:inf --123.34:+inf:-inf -123.34:-inf:-inf --123.34:-inf:inf -+0:+0:0 -+0:+1:0 -+1:+0:0 -+0:-1:0 --1:+0:0 -+123456789123456789:+0:0 -+0:+123456789123456789:0 --1:-1:1 --1:+1:-1 -+1:-1:-1 -+1:+1:1 -+2:+3:6 --2:+3:-6 -+2:-3:-6 --2:-3:6 -+111:+111:12321 -+10101:+10101:102030201 -+1001001:+1001001:1002003002001 -+100010001:+100010001:10002000300020001 -+10000100001:+10000100001:100002000030000200001 -+11111111111:+9:99999999999 -+22222222222:+9:199999999998 -+33333333333:+9:299999999997 -+44444444444:+9:399999999996 -+55555555555:+9:499999999995 -+66666666666:+9:599999999994 -+77777777777:+9:699999999993 -+88888888888:+9:799999999992 -+99999999999:+9:899999999991 -6:120:720 -10:10000:100000 -&fdiv-list -0:0:NaN,NaN -0:1:0,0 -9:4:2.25,1 -9:5:1.8,4 -# bug in v1.74 with bdiv in list context, when $y is 1 or -1 -2.1:-1:-2.1,0 -2.1:1:2.1,0 --2.1:-1:2.1,0 --2.1:1:-2.1,0 -&fdiv -$div_scale = 40; $round_mode = 'even' -abc:abc:NaN -abc:+1:abc:NaN -+1:abc:NaN --1:abc:NaN -0:abc:NaN -+0:+0:NaN -+0:+1:0 -+1:+0:inf -+3214:+0:inf -+0:-1:0 --1:+0:-inf --3214:+0:-inf -+1:+1:1 --1:-1:1 -+1:-1:-1 --1:+1:-1 -+1:+2:0.5 -+2:+1:2 -123:+inf:0 -123:-inf:0 -+10:+5:2 -+100:+4:25 -+1000:+8:125 -+10000:+16:625 -+10000:-16:-625 -+999999999999:+9:111111111111 -+999999999999:+99:10101010101 -+999999999999:+999:1001001001 -+999999999999:+9999:100010001 -+999999999999999:+99999:10000100001 -+1000000000:+9:111111111.1111111111111111111111111111111 -+2000000000:+9:222222222.2222222222222222222222222222222 -+3000000000:+9:333333333.3333333333333333333333333333333 -+4000000000:+9:444444444.4444444444444444444444444444444 -+5000000000:+9:555555555.5555555555555555555555555555556 -+6000000000:+9:666666666.6666666666666666666666666666667 -+7000000000:+9:777777777.7777777777777777777777777777778 -+8000000000:+9:888888888.8888888888888888888888888888889 -+9000000000:+9:1000000000 -+35500000:+113:314159.2920353982300884955752212389380531 -+71000000:+226:314159.2920353982300884955752212389380531 -+106500000:+339:314159.2920353982300884955752212389380531 -+1000000000:+3:333333333.3333333333333333333333333333333 -2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 -123456:1:123456 -$div_scale = 20 -+1000000000:+9:111111111.11111111111 -+2000000000:+9:222222222.22222222222 -+3000000000:+9:333333333.33333333333 -+4000000000:+9:444444444.44444444444 -+5000000000:+9:555555555.55555555556 -+6000000000:+9:666666666.66666666667 -+7000000000:+9:777777777.77777777778 -+8000000000:+9:888888888.88888888889 -+9000000000:+9:1000000000 -1:10:0.1 -1:100:0.01 -1:1000:0.001 -1:10000:0.0001 -1:504:0.001984126984126984127 -2:1.987654321:1.0062111801179738436 -123456789.123456789123456789123456789:1:123456789.12345678912 -# the next two cases are the "old" behaviour, but are now (>v0.01) different -#+35500000:+113:314159.292035398230088 -#+71000000:+226:314159.292035398230088 -+35500000:+113:314159.29203539823009 -+71000000:+226:314159.29203539823009 -+106500000:+339:314159.29203539823009 -+1000000000:+3:333333333.33333333333 -$div_scale = 1 -# round to accuracy 1 after bdiv -+124:+3:40 -123456789.1234:1:100000000 -# reset scale for further tests -$div_scale = 40 -&fmod -+9:4:1 -+9:5:4 -+9000:56:40 -+56:9000:56 -# inf handling, see table in doc -0:inf:0 -0:-inf:0 -5:inf:5 -5:-inf:5 --5:inf:-5 --5:-inf:-5 -inf:5:0 --inf:5:0 -inf:-5:0 --inf:-5:0 -5:5:0 --5:-5:0 -inf:inf:NaN --inf:-inf:NaN --inf:inf:NaN -inf:-inf:NaN -8:0:8 -inf:0:inf -# exceptions to reminder rule --inf:0:-inf --8:0:-8 -0:0:NaN -abc:abc:NaN -abc:1:abc:NaN -1:abc:NaN -0:0:NaN -0:1:0 -1:0:1 -0:-1:0 --1:0:-1 -1:1:0 --1:-1:0 -1:-1:0 --1:1:0 -1:2:1 -2:1:0 -1000000000:9:1 -2000000000:9:2 -3000000000:9:3 -4000000000:9:4 -5000000000:9:5 -6000000000:9:6 -7000000000:9:7 -8000000000:9:8 -9000000000:9:0 -35500000:113:33 -71000000:226:66 -106500000:339:99 -1000000000:3:1 -10:5:0 -100:4:0 -1000:8:0 -10000:16:0 -999999999999:9:0 -999999999999:99:0 -999999999999:999:0 -999999999999:9999:0 -999999999999999:99999:0 --9:+5:1 -+9:-5:-1 --9:-5:-4 --5:3:1 --2:3:1 -4:3:1 -1:3:1 --5:-3:-2 --2:-3:-2 -4:-3:-2 -1:-3:-2 -4095:4095:0 -100041000510123:3:0 -152403346:12345:4321 -87654321:87654321:0 -# now some floating point tests -123:2.5:0.5 -1230:2.5:0 -123.4:2.5:0.9 -123e1:25:5 --2.1:1:0.9 -2.1:1:0.1 --2.1:-1:-0.1 -2.1:-1:-0.9 --3:1:0 -3:1:0 --3:-1:0 -3:-1:0 -&ffac -Nanfac:NaN --1:NaN -+inf:inf --inf:NaN -0:1 -1:1 -2:2 -3:6 -4:24 -5:120 -6:720 -10:3628800 -11:39916800 -12:479001600 -&froot -# sqrt() -+0:2:0 -+1:2:1 --1:2:NaN -# -$x ** (1/2) => -$y, but not in froot() --123.456:2:NaN -+inf:2:inf --inf:2:NaN -2:2:1.41421356237309504880168872420969807857 --2:2:NaN -4:2:2 -9:2:3 -16:2:4 -100:2:10 -123.456:2:11.11107555549866648462149404118219234119 -15241.38393:2:123.4559999756998444766131352122991626468 -1.44:2:1.2 -12:2:3.464101615137754587054892683011744733886 -0.49:2:0.7 -0.0049:2:0.07 -# invalid ones -1:NaN:NaN --1:NaN:NaN -0:NaN:NaN --inf:NaN:NaN -+inf:NaN:NaN -NaN:0:NaN -NaN:2:NaN -NaN:inf:NaN -NaN:inf:NaN -12:-inf:NaN -12:inf:NaN -+0:0:NaN -+1:0:NaN --1:0:NaN --2:0:NaN --123.45:0:NaN -+inf:0:NaN -12:1:12 --12:1:NaN -8:-1:NaN --8:-1:NaN -# cubic root -8:3:2 --8:3:NaN -# fourths root -16:4:2 -81:4:3 -# see t/bigroot() for more tests -&fsqrt -+0:0 --1:NaN --2:NaN --16:NaN --123.45:NaN -nanfsqrt:NaN -+inf:inf --inf:NaN -1:1 -2:1.41421356237309504880168872420969807857 -4:2 -9:3 -16:4 -100:10 -123.456:11.11107555549866648462149404118219234119 -15241.38393:123.4559999756998444766131352122991626468 -1.44:1.2 -# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 -1.44E10:120000 -2e10:141421.356237309504880168872420969807857 -144e20:120000000000 -# proved to be an endless loop under 7-9 -12:3.464101615137754587054892683011744733886 -0.49:0.7 -0.0049:0.07 -&is_nan -123:0 -abc:1 -NaN:1 --123:0 -&is_inf -+inf::1 --inf::1 -abc::0 -1::0 -NaN::0 --1::0 -+inf:-:0 -+inf:+:1 --inf:-:1 --inf:+:0 -# it must be exactly /^[+-]inf$/ -+infinity::0 --infinity::0 -&is_odd -abc:0 -0:0 --1:1 --3:1 -1:1 -3:1 -1000001:1 -1000002:0 -+inf:0 --inf:0 -123.45:0 --123.45:0 -2:0 -&is_int -NaNis_int:0 -0:1 -1:1 -2:1 --2:1 --1:1 --inf:0 -+inf:0 -123.4567:0 --0.1:0 --0.002:0 -&is_even -abc:0 -0:1 --1:0 --3:0 -1:0 -3:0 -1000001:0 -1000002:1 -2:1 -+inf:0 --inf:0 -123.456:0 --123.456:0 -0.01:0 --0.01:0 -120:1 -1200:1 --1200:1 -&is_positive -0:0 -1:1 --1:0 --123:0 -NaN:0 --inf:0 -+inf:1 -&is_negative -0:0 -1:0 --1:1 --123:1 -NaN:0 --inf:1 -+inf:0 -&parts -0:0 1 -1:1 0 -123:123 0 --123:-123 0 --1200:-12 2 -NaNparts:NaN NaN -+inf:inf inf --inf:-inf inf -&exponent -0:1 -1:0 -123:0 --123:0 --1200:2 -+inf:inf --inf:inf -NaNexponent:NaN -&mantissa -0:0 -1:1 -123:123 --123:-123 --1200:-12 -+inf:inf --inf:-inf -NaNmantissa:NaN -&length -123:3 --123:3 -0:1 -1:1 -12345678901234567890:20 -&is_zero -NaNzero:0 -+inf:0 --inf:0 -0:1 --1:0 -1:0 -&is_one -NaNone:0 -+inf:0 --inf:0 -0:0 -2:0 -1:1 --1:0 --2:0 -&ffloor -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-52 -12.2:12 -0.12345:0 -0.123456:0 -0.1234567:0 -0.12345678:0 -0.123456789:0 -&fceil -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-51 -12.2:13 diff --git a/cpan/Math-BigRat/t/bigfltrt.t b/cpan/Math-BigRat/t/bigfltrt.t deleted file mode 100644 index 278980ac57..0000000000 --- a/cpan/Math-BigRat/t/bigfltrt.t +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 1; - -BEGIN { - unshift @INC, 't'; -} - -use Math::BigRat::Test lib => 'Calc'; # test via this Subclass - -use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); -$class = "Math::BigRat::Test"; -$CL = "Math::BigInt::Calc"; - -pass(); - -# fails still too many tests -#require 't/bigfltpm.inc'; # all tests here for sharing diff --git a/cpan/Math-BigRat/t/biglog.t b/cpan/Math-BigRat/t/biglog.t deleted file mode 100644 index 5c4b96b3d4..0000000000 --- a/cpan/Math-BigRat/t/biglog.t +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl -w - -# Test blog function (and bpow, since it uses blog), as well as bexp(). - -use strict; -use Test::More tests => 17; - -use Math::BigRat; - -my $cl = "Math::BigRat"; - -############################################################################# -# test log($n) - -# does not work yet -#is ($cl->new(2)->blog(), '0', "blog(2)"); -#is ($cl->new(288)->blog(), '5',"blog(288)"); -#is ($cl->new(2000)->blog(), '7', "blog(2000)"); - -############################################################################# -# test exp($n) - -is ($cl->new(1)->bexp()->as_int(), '2', "bexp(1)"); -is ($cl->new(2)->bexp()->as_int(), '7',"bexp(2)"); -is ($cl->new(3)->bexp()->as_int(), '20', "bexp(3)"); - -# rounding not implemented yet -#is ($cl->new(3)->bexp(10), '20', "bexp(3,10)"); - -# $x < 0 => NaN -ok ($cl->new(-2)->blog(), 'NaN'); -ok ($cl->new(-1)->blog(), 'NaN'); -ok ($cl->new(-10)->blog(), 'NaN'); -ok ($cl->new(-2,2)->blog(), 'NaN'); - -############################################################################# -# test bexp() with cached results - -is ($cl->new(1)->bexp(), - '90933395208605785401971970164779391644753259799242' . '/' . - '33452526613163807108170062053440751665152000000000', - 'bexp(1)'); -is ($cl->new(2)->bexp(1,40), $cl->new(1)->bexp(1,45)->bpow(2,40), 'bexp(2)'); - -is ($cl->new("12.5")->bexp(1,61), $cl->new(1)->bexp(1,65)->bpow(12.5,61), 'bexp(12.5)'); - -############################################################################# -# test bexp() with big values (non-cached) - -is ($cl->new(1)->bexp(1,100)->as_float(100), - '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427', - 'bexp(100)'); - -is ($cl->new("12.5")->bexp(1,91), $cl->new(1)->bexp(1,95)->bpow(12.5,91), - 'bexp(12.5) to 91 digits'); - -############################################################################# -# some integer results -is ($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32"); -is ($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32"); -is ($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65"); - -my $x = Math::BigInt->new( '777' ) ** 256; -my $base = Math::BigInt->new( '12345678901234' ); -is ($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); - -$x = Math::BigInt->new( '777' ) ** 777; -$base = Math::BigInt->new( '777' ); -is ($x->copy()->blog($base), 777, 'blog(777**777, 777)'); - -# all done -1; - diff --git a/cpan/Math-BigRat/t/bigrat.t b/cpan/Math-BigRat/t/bigrat.t deleted file mode 100644 index 4d1d451489..0000000000 --- a/cpan/Math-BigRat/t/bigrat.t +++ /dev/null @@ -1,325 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 200; - -# basic testing of Math::BigRat - -use Math::BigRat; -use Math::BigInt; -use Math::BigFloat; - -# shortcuts -my $cr = 'Math::BigRat'; -my $mbi = 'Math::BigInt'; -my $mbf = 'Math::BigFloat'; - -my ($x,$y,$z); - -$x = Math::BigRat->new(1234); is ($x,1234); -isa_ok ($x, 'Math::BigRat'); -is ($x->isa('Math::BigFloat'), 0); -is ($x->isa('Math::BigInt'), 0); - -############################################################################## -# new and bnorm() - -foreach my $func (qw/new bnorm/) - { - $x = $cr->$func(1234); is ($x,1234); - - $x = $cr->$func('1234/1'); is ($x,1234); - $x = $cr->$func('1234/2'); is ($x,617); - - $x = $cr->$func('100/1.0'); is ($x,100); - $x = $cr->$func('10.0/1.0'); is ($x,10); - $x = $cr->$func('0.1/10'); is ($x,'1/100'); - $x = $cr->$func('0.1/0.1'); is ($x,'1'); - $x = $cr->$func('1e2/10'); is ($x,10); - $x = $cr->$func('5/1e2'); is ($x,'1/20'); - $x = $cr->$func('1e2/1e1'); is ($x,10); - $x = $cr->$func('1 / 3'); is ($x,'1/3'); - $x = $cr->$func('-1 / 3'); is ($x,'-1/3'); - $x = $cr->$func('NaN'); is ($x,'NaN'); - $x = $cr->$func('inf'); is ($x,'inf'); - $x = $cr->$func('-inf'); is ($x,'-inf'); - $x = $cr->$func('1/'); is ($x,'NaN'); - - $x = $cr->$func("0x7e"); is ($x,126); - - # input ala '1+1/3' isn't parsed ok yet - $x = $cr->$func('1+1/3'); is ($x,'NaN'); - - $x = $cr->$func('1/1.2'); is ($x,'5/6'); - $x = $cr->$func('1.3/1.2'); is ($x,'13/12'); - $x = $cr->$func('1.2/1'); is ($x,'6/5'); - - ############################################################################ - # other classes as input - - $x = $cr->$func($mbi->new(1231)); is ($x,'1231'); - $x = $cr->$func($mbf->new(1232)); is ($x,'1232'); - $x = $cr->$func($mbf->new(1232.3)); is ($x,'12323/10'); - } - -my $n = 'numerator'; -my $d = 'denominator'; - -$x = $cr->new('-0'); is ($x,'0'); is ($x->$n(), '0'); is ($x->$d(),'1'); -$x = $cr->new('NaN'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); -$x = $cr->new('-NaN'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); -$x = $cr->new('-1r4'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); - -$x = $cr->new('+inf'); is ($x,'inf'); is ($x->$n(), 'inf'); is ($x->$d(),'1'); -$x = $cr->new('-inf'); is ($x,'-inf'); is ($x->$n(), '-inf'); is ($x->$d(),'1'); -$x = $cr->new('123a4'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); - -# wrong inputs -$x = $cr->new('1e2e2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); -$x = $cr->new('1+2+2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); -# failed due to BigFloat bug -$x = $cr->new('1.2.2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); - -is ($cr->new('123a4'),'NaN'); -is ($cr->new('123e4'),'1230000'); -is ($cr->new('-NaN'),'NaN'); -is ($cr->new('NaN'),'NaN'); -is ($cr->new('+inf'),'inf'); -is ($cr->new('-inf'),'-inf'); - -############################################################################## -# two Bigints - -is ($cr->new($mbi->new(3),$mbi->new(7))->badd(1),'10/7'); -is ($cr->new($mbi->new(-13),$mbi->new(7)),'-13/7'); -is ($cr->new($mbi->new(13),$mbi->new(-7)),'-13/7'); -is ($cr->new($mbi->new(-13),$mbi->new(-7)),'13/7'); - -############################################################################## -# mixed arguments - -is ($cr->new('3/7')->badd(1),'10/7'); -is ($cr->new('3/10')->badd(1.1),'7/5'); -is ($cr->new('3/7')->badd($mbi->new(1)),'10/7'); -is ($cr->new('3/10')->badd($mbf->new('1.1')),'7/5'); - -is ($cr->new('3/7')->bsub(1),'-4/7'); -is ($cr->new('3/10')->bsub(1.1),'-4/5'); -is ($cr->new('3/7')->bsub($mbi->new(1)),'-4/7'); -is ($cr->new('3/10')->bsub($mbf->new('1.1')),'-4/5'); - -is ($cr->new('3/7')->bmul(1),'3/7'); -is ($cr->new('3/10')->bmul(1.1),'33/100'); -is ($cr->new('3/7')->bmul($mbi->new(1)),'3/7'); -is ($cr->new('3/10')->bmul($mbf->new('1.1')),'33/100'); - -is ($cr->new('3/7')->bdiv(1),'3/7'); -is ($cr->new('3/10')->bdiv(1.1),'3/11'); -is ($cr->new('3/7')->bdiv($mbi->new(1)),'3/7'); -is ($cr->new('3/10')->bdiv($mbf->new('1.1')),'3/11'); - -############################################################################## -$x = $cr->new('1/4'); $y = $cr->new('1/3'); - -is ($x + $y, '7/12'); -is ($x * $y, '1/12'); -is ($x / $y, '3/4'); - -$x = $cr->new('7/5'); $x *= '3/2'; -is ($x,'21/10'); -$x -= '0.1'; -is ($x,'2'); # not 21/10 - -$x = $cr->new('2/3'); $y = $cr->new('3/2'); -is ($x > $y,''); -is ($x < $y,1); -is ($x == $y,''); - -$x = $cr->new('-2/3'); $y = $cr->new('3/2'); -is ($x > $y,''); -is ($x < $y,'1'); -is ($x == $y,''); - -$x = $cr->new('-2/3'); $y = $cr->new('-2/3'); -is ($x > $y,''); -is ($x < $y,''); -is ($x == $y,'1'); - -$x = $cr->new('-2/3'); $y = $cr->new('-1/3'); -is ($x > $y,''); -is ($x < $y,'1'); -is ($x == $y,''); - -$x = $cr->new('-124'); $y = $cr->new('-122'); -is ($x->bacmp($y),1); - -$x = $cr->new('-124'); $y = $cr->new('-122'); -is ($x->bcmp($y),-1); - -$x = $cr->new('3/7'); $y = $cr->new('5/7'); -is ($x+$y,'8/7'); - -$x = $cr->new('3/7'); $y = $cr->new('5/7'); -is ($x*$y,'15/49'); - -$x = $cr->new('3/5'); $y = $cr->new('5/7'); -is ($x*$y,'3/7'); - -$x = $cr->new('3/5'); $y = $cr->new('5/7'); -is ($x/$y,'21/25'); - -$x = $cr->new('7/4'); $y = $cr->new('1'); -is ($x % $y,'3/4'); - -$x = $cr->new('7/4'); $y = $cr->new('5/13'); -is ($x % $y,'11/52'); - -$x = $cr->new('7/4'); $y = $cr->new('5/9'); -is ($x % $y,'1/12'); - -$x = $cr->new('-144/9')->bsqrt(); is ($x,'NaN'); -$x = $cr->new('144/9')->bsqrt(); is ($x,'4'); -$x = $cr->new('3/4')->bsqrt(); is ($x, - '1732050807568877293527446341505872366943/' - .'2000000000000000000000000000000000000000'); - -############################################################################## -# bpow - -$x = $cr->new('2/1'); $z = $x->bpow('3/1'); is ($x,'8'); -$x = $cr->new('1/2'); $z = $x->bpow('3/1'); is ($x,'1/8'); -$x = $cr->new('1/3'); $z = $x->bpow('4/1'); is ($x,'1/81'); -$x = $cr->new('2/3'); $z = $x->bpow('4/1'); is ($x,'16/81'); - -$x = $cr->new('2/3'); $z = $x->bpow('5/3'); -is ($x, '31797617848703662994667839220546583581/62500000000000000000000000000000000000'); - -############################################################################## -# bfac - -$x = $cr->new('1'); $x->bfac(); is ($x,'1'); -for (my $i = 0; $i < 8; $i++) - { - $x = $cr->new("$i/1")->bfac(); is ($x,$mbi->new($i)->bfac()); - } - -# test for $self->bnan() vs. $x->bnan(); -$x = $cr->new('-1'); $x->bfac(); is ($x,'NaN'); - -############################################################################## -# binc/bdec - -$x = $cr->new('3/2'); is ($x->binc(),'5/2'); -$x = $cr->new('15/6'); is ($x->bdec(),'3/2'); - -############################################################################## -# bfloor/bceil - -$x = $cr->new('-7/7'); is ($x->$n(), '-1'); is ($x->$d(), '1'); -$x = $cr->new('-7/7')->bfloor(); is ($x->$n(), '-1'); is ($x->$d(), '1'); - -############################################################################## -# bsstr - -$x = $cr->new('7/5')->bsstr(); is ($x,'7/5'); -$x = $cr->new('-7/5')->bsstr(); is ($x,'-7/5'); - -############################################################################## -# numify() - -my @array = qw/1 2 3 4 5 6 7 8 9/; -$x = $cr->new('8/8'); is ($array[$x],2); -$x = $cr->new('16/8'); is ($array[$x],3); -$x = $cr->new('17/8'); is ($array[$x],3); -$x = $cr->new('33/8'); is ($array[$x],5); -$x = $cr->new('-33/8'); is ($array[$x],6); -$x = $cr->new('-8/1'); is ($array[$x],2); # -8 => 2 - -$x = $cr->new('33/8'); is ($x->numify() * 1000, 4125); -$x = $cr->new('-33/8'); is ($x->numify() * 1000, -4125); -$x = $cr->new('inf'); is ($x->numify(), 'inf'); -$x = $cr->new('-inf'); is ($x->numify(), '-inf'); -$x = $cr->new('NaN'); is ($x->numify(), 'NaN'); - -$x = $cr->new('4/3'); is ($x->numify(), 4/3); - -############################################################################## -# as_hex(), as_bin(), as_oct() - -$x = $cr->new('8/8'); -is ($x->as_hex(), '0x1'); is ($x->as_bin(), '0b1'); is ($x->as_oct(), '01'); -$x = $cr->new('80/8'); -is ($x->as_hex(), '0xa'); is ($x->as_bin(), '0b1010'); is ($x->as_oct(), '012'); - -############################################################################## -# broot(), blog(), bmodpow() and bmodinv() - -$x = $cr->new(2) ** 32; -$y = $cr->new(4); -$z = $cr->new(3); - -is ($x->copy()->broot($y), 2 ** 8); -is (ref($x->copy()->broot($y)), $cr); - -is ($x->copy()->bmodpow($y,$z), 1); -is (ref($x->copy()->bmodpow($y,$z)), $cr); - -$x = $cr->new(8); -$y = $cr->new(5033); -$z = $cr->new(4404); - -is ($x->copy()->bmodinv($y), $z); -is (ref($x->copy()->bmodinv($y)), $cr); - -# square root with exact result -$x = $cr->new('1.44'); -is ($x->copy()->broot(2), '6/5'); -is (ref($x->copy()->broot(2)), $cr); - -# log with exact result -$x = $cr->new('256.1'); -is ($x->copy()->blog(2), '8000563442710106079310294693803606983661/1000000000000000000000000000000000000000'); -is (ref($x->copy()->blog(2)), $cr); - -$x = $cr->new(144); -is ($x->copy()->broot('2'), 12, 'v/144 = 12'); - -$x = $cr->new(12*12*12); -is ($x->copy()->broot('3'), 12, '(12*12*12) ** 1/3 = 12'); - -############################################################################## -# from_hex(), from_bin(), from_oct() - -$x = Math::BigRat->from_hex('0x100'); -is ($x, '256', 'from_hex'); -$x = $cr->from_hex('0x100'); -is ($x, '256', 'from_hex'); - -$x = Math::BigRat->from_bin('0b100'); -is ($x, '4', 'from_bin'); -$x = $cr->from_bin('0b100'); -is ($x, '4', 'from_bin'); - -$x = Math::BigRat->from_oct('0100'); -is ($x, '64', 'from_oct'); -$x = $cr->from_oct('0100'); -is ($x, '64', 'from_oct'); - -############################################################################## -# as_float() - -$x = Math::BigRat->new('1/2'); my $f = $x->as_float(); - -is ($x, '1/2', '$x unmodified'); -is ($f, '0.5', 'as_float(0.5)'); - -$x = Math::BigRat->new('2/3'); $f = $x->as_float(5); - -is ($x, '2/3', '$x unmodified'); -is ($f, '0.66667', 'as_float(2/3,5)'); - -############################################################################## -# done - -1; - diff --git a/cpan/Math-BigRat/t/bigratpm.inc b/cpan/Math-BigRat/t/bigratpm.inc deleted file mode 100644 index 11028569a1..0000000000 --- a/cpan/Math-BigRat/t/bigratpm.inc +++ /dev/null @@ -1,905 +0,0 @@ -#include this file into another test for subclass testing... - -is ($class->config()->{lib},$CL); - -$setup = ''; - -while () - { - chomp; - $_ =~ s/#.*$//; # remove comments - $_ =~ s/\s+$//; # trailing spaces - next if /^$/; # skip empty lines & comments - if (s/^&//) - { - $f = $_; - } - elsif (/^\$/) - { - $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale - #print "\$setup== $setup\n"; - } - else - { - if (m|^(.*?):(/.+)$|) - { - $ans = $2; - @args = split(/:/,$1,99); - } - else - { - @args = split(/:/,$_,99); $ans = pop(@args); - } - $try = "\$x = new $class \"$args[0]\";"; - if ($f eq "bnorm") - { - $try .= "\$x;"; - } elsif ($f eq "finf") { - my $a = $args[1] || ''; - $try .= "\$x->binf('$a');"; - } elsif ($f eq "is_inf") { - $try .= "\$x->is_inf('$args[1]');"; - } elsif ($f eq "fone") { - $try .= "\$x->bone('$args[1]');"; - } elsif ($f eq "fstr") { - $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; - $try .= '$x->bstr();'; - } elsif ($f eq "parts") { - # ->bstr() to see if an object is returned - $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; - $try .= '"$a $b";'; - } elsif ($f eq "numerator") { - # ->bstr() to see if an object is returned - $try .= '$x->numerator()->bstr();'; - } elsif ($f eq "denominator") { - # ->bstr() to see if an object is returned - $try .= '$x->denominator()->bstr();'; - } elsif ($f =~ /^(length|numify)$/) { - $try .= "\$x->$f();"; - # some unary ops (can't test the fxxx form, since no AUTOLOAD in BigRat) - } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { - $try .= "\$x->b$1();"; - # some is_xxx test function - } elsif ($f =~ /^is_(zero|one|pos|neg|negative|positive|odd|even|nan|int)\z/) { - $try .= "\$x->$f();"; - } elsif ($f =~ /^(as_number|as_int)\z/){ - $try .= "\$x->$1();"; - } elsif ($f eq "finc") { - $try .= '++$x;'; - } elsif ($f eq "fdec") { - $try .= '--$x;'; - } elsif ($f eq "digit") { - $try .= "\$x->digit($args[1]);"; - } elsif ($f eq "fround") { - $try .= "$setup; \$x->bround($args[1]);"; - } elsif ($f eq "ffround") { - $try .= "$setup; \$x->bfround($args[1]);"; - } elsif ($f eq "fsqrt") { - $try .= "$setup; \$x->bsqrt();"; - } elsif ($f eq "flog") { - $try .= "$setup; \$x->blog();"; - } elsif ($f eq "ffac") { - $try .= "$setup; \$x->bfac();"; - } - else - { - $try .= "\$y = new $class \"$args[1]\";"; - if ($f eq "bcmp") { - $try .= '$x <=> $y;'; - } elsif ($f eq "bacmp") { - $try .= '$x->bacmp($y);'; - } elsif ($f eq "bpow") { - $try .= '$x ** $y;'; - } elsif ($f eq "fpow") { - $try .= '$x->bpow($y);'; - } elsif ($f eq "badd") { - $try .= '$x + $y;'; - } elsif ($f eq "bsub") { - $try .= '$x - $y;'; - } elsif ($f eq "bmul") { - $try .= '$x * $y;'; - } elsif ($f eq "bdiv") { - $try .= "$setup; \$x / \$y;"; - } elsif ($f eq "fdiv-list") { - $try .= "$setup; join(',',\$x->bdiv(\$y));"; - } elsif ($f eq "brsft") { - $try .= '$x >> $y;'; - } elsif ($f eq "blsft") { - $try .= '$x << $y;'; - } elsif ($f eq "bmod") { - $try .= '$x % $y;'; - } elsif( $f eq "bmodinv") { - $try .= "\$x->bmodinv(\$y);"; - } elsif( $f eq "blog") { - $try .= "\$x->blog(\$y);"; - } else { - $try .= "\$z = $class->new(\"$args[2]\");"; - - # Functions with three arguments - if( $f eq "bmodpow") { - $try .= "\$x->bmodpow(\$y,\$z);"; - } else { warn "Unknown op '$f'"; } - } - } - # print "# Trying: '$try'\n"; - $ans1 = eval $try; - if ($ans =~ m|^/(.*)$|) - { - my $pat = $1; - like ($ans1, qr/$pat/); - } - else - { - if ($ans eq "") - { - is ($ans1, undef); - } - else - { - is ($ans1, $ans) or diag("Tried: '$try'"); -# if (ref($ans1) eq "$class") -# { -# # float numbers are normalized (for now), so mantissa shouldn't have -# # trailing zeros -# #print $ans1->_trailing_zeros(),"\n"; -# print "# Has trailing zeros after '$try'\n" -# if !is ($ans1->{_m}->_trailing_zeros(), 0); -# } - } - } # end pattern or string - } - } # end while - -# check whether $class->new( Math::BigInt->new()) destroys it -# ($y == 12 in this case) -$x = Math::BigInt->new(1200); $y = $class->new($x); -is ($y,1200); is ($x,1200); - -############################################################################### -# zero,inf,one,nan - -$x = $class->new(2); $x->bzero(); is ($x->{_a}, undef); is ($x->{_p}, undef); -$x = $class->new(2); $x->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef); -$x = $class->new(2); $x->bone(); is ($x->{_a}, undef); is ($x->{_p}, undef); -$x = $class->new(2); $x->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef); - -__DATA__ -&digit -123:2:1 -1234:0:4 -1234:1:3 -1234:2:2 -1234:3:1 -1234:-1:1 -1234:-2:2 -1234:-3:3 -1234:-4:4 -0:0:0 -0:1:0 -&bmodinv -# format: number:modulus:result -# bmodinv Data errors -abc:abc:NaN -abc:5:NaN -5:abc:NaN -# bmodinv Expected Results from normal use -1:5:1 -3:5:2 --2:5:2 -8:5033:4404 -1234567891:13:6 --1234567891:13:7 -324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902 -## bmodinv Error cases / useless use of function -3:-5:NaN -inf:5:NaN -5:inf:NaN --inf:5:NaN -5:-inf:NaN -&as_number -144/7:20 -12/1:12 --12/1:-12 --12/3:-4 -NaN:NaN -+inf:inf --inf:-inf -&as_int -144/7:20 -12/1:12 --12/1:-12 --12/3:-4 -NaN:NaN -+inf:inf --inf:-inf -&bmodpow -# format: number:exponent:modulus:result -# bmodpow Data errors -abc:abc:abc:NaN -5:abc:abc:NaN -abc:5:abc:NaN -abc:abc:5:NaN -5:5:abc:NaN -5:abc:5:NaN -abc:5:5:NaN -# bmodpow Expected results -0:0:2:1 -1:0:2:1 -0:0:1:0 -8:7:5032:3840 -8:-1:5033:4404 -98436739867439843769485798542749827593285729587325:43698764986460981048259837659386739857456983759328457:6943857329857295827698367:3104744730915914415259518 -# bmodpow Error cases -8:8:-5:NaN -8:-1:16:NaN -inf:5:13:NaN -5:inf:13:NaN -&bmod -NaN:1:NaN -1:NaN:NaN -1:1:0 -2:2:0 -12:6:0 -7/4:4/14:1/28 -7/4:4/16:0 --7/4:4/16:0 --7/4:-4/16:0 -7/4:-4/16:0 -7/4:4/32:0 --7/4:4/32:0 --7/4:-4/32:0 -7/4:-4/32:0 -7/4:4/28:1/28 --7/4:4/28:-1/28 -7/4:-4/28:1/28 --7/4:-4/28:-1/28 -&fsqrt -1:1 -0:0 -NaN:NaN -+inf:inf --inf:NaN -144:12 -# sqrt(144) / sqrt(4) = 12/2 = 6/1 -144/4:6 -25/16:5/4 --3:NaN -&flog -NaN:NaN -0:NaN --2:NaN -&blog -NaN:NaN:NaN -0:NaN:NaN -NaN:0:NaN -NaN:1:NaN -1:NaN:NaN -0:2:NaN -0:-2:NaN -3:-2:NaN -&finf -1:+:inf -2:-:-inf -3:abc:inf -&numify -0:0 -+1:1 -1234:1234 -3/4:0.75 -5/2:2.5 -3/2:1.5 -5/4:1.25 -NaN:NaN -+inf:inf --inf:-inf -&fnan -abc:NaN -2:NaN --2:NaN -0:NaN -&fone -2:+:1 --2:-:-1 --2:+:1 -2:-:-1 -0::1 --2::1 -abc::1 -2:abc:1 -&fsstr -+inf:inf --inf:-inf -abcfsstr:NaN -1:1/1 -3/1:3/1 -0.1:1/10 -&bnorm -1:1 --0:0 -bnormNaN:NaN -+inf:inf --inf:-inf -inf/inf:NaN -5/inf:0 -5/-inf:0 -inf/5:inf --inf/5:-inf -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 -.2E2:20 -inf:inf -+inf:inf --inf:-inf -+infinity:NaN -+-inf:NaN -abc:NaN - 1 a:NaN -1bcd2:NaN -11111b:NaN -+1z:NaN --1z:NaN -0:0 -+0:0 -+00:0 -+0_0_0:0 -000000_0000000_00000:0 --0:0 --0000:0 -+1:1 -+01:1 -+001:1 -+00000100000:100000 -+00000800/00000010:80 --00000800/00000010:-80 -+00000800/-00000010:-80 --00000800/-00000010:80 -123456789:123456789 --1:-1 --01:-1 --001:-1 --123456789:-123456789 --00000100000:-100000 -123.456a:NaN -123.456:15432/125 -0.01:1/100 -.002:1/500 -+.2:1/5 --0.0003:-3/10000 --.0000000004:-1/2500000000 -123456E2:12345600 -123456E-2:30864/25 --123456E2:-12345600 --123456E-2:-30864/25 -1e1:10 -2e-11:1/50000000000 -12/10:6/5 -0.1/0.1:1 -100/0.1:1000 -0.1/10:1/100 -1 / 3:1/3 -1/ 3:1/3 -1 /3:1/3 -&fneg -fnegNaN:NaN -+inf:-inf --inf:inf -+0:0 -+1:-1 --1:1 -+123456789:-123456789 --123456789:123456789 -+123.456789:-123456789/1000000 --123456.789:123456789/1000 -123/7:-123/7 --123/7:123/7 -123/-7:123/7 -&fabs -fabsNaN:NaN -+inf:inf --inf:inf -+0:0 -+1:1 --1:1 -+123456789:123456789 --123456789:123456789 -+123.456789:123456789/1000000 --123456.789:123456789/1000 -&badd -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:NaN --inf:+inf:NaN -+inf:+inf:inf --inf:-inf:-inf -baddNaN:+inf:NaN -baddNaN:+inf:NaN -+inf:baddNaN:NaN --inf:baddNaN:NaN -+0:+0:0 -+1:+0:1 -+0:+1:1 -+1:+1:2 --1:+0:-1 -+0:-1:-1 --1:-1:-2 --1:+1:0 -+1:-1:0 -+9:+1:10 -+99:+1:100 -+999:+1:1000 -+9999:+1:10000 -+99999:+1:100000 -+999999:+1:1000000 -+9999999:+1:10000000 -+99999999:+1:100000000 -+999999999:+1:1000000000 -+9999999999:+1:10000000000 -+99999999999:+1:100000000000 -+10:-1:9 -+100:-1:99 -+1000:-1:999 -+10000:-1:9999 -+100000:-1:99999 -+1000000:-1:999999 -+10000000:-1:9999999 -+100000000:-1:99999999 -+1000000000:-1:999999999 -+10000000000:-1:9999999999 -+123456789:+987654321:1111111110 --123456789:+987654321:864197532 --123456789:-987654321:-1111111110 -+123456789:-987654321:-864197532 -1/3:1/3:2/3 -2/3:-1/3:1/3 -&bsub -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:inf --inf:+inf:-inf -+inf:+inf:NaN --inf:-inf:NaN -baddNaN:+inf:NaN -baddNaN:+inf:NaN -+inf:baddNaN:NaN --inf:baddNaN:NaN -+0:+0:0 -+1:+0:1 -+0:+1:-1 -+1:+1:0 --1:+0:-1 -+0:-1:1 --1:-1:0 --1:+1:-2 -+1:-1:2 -+9:+1:8 -+99:+1:98 -+999:+1:998 -+9999:+1:9998 -+99999:+1:99998 -+999999:+1:999998 -+9999999:+1:9999998 -+99999999:+1:99999998 -+999999999:+1:999999998 -+9999999999:+1:9999999998 -+99999999999:+1:99999999998 -+10:-1:11 -+100:-1:101 -+1000:-1:1001 -+10000:-1:10001 -+100000:-1:100001 -+1000000:-1:1000001 -+10000000:-1:10000001 -+100000000:-1:100000001 -+1000000000:-1:1000000001 -+10000000000:-1:10000000001 -+123456789:+987654321:-864197532 --123456789:+987654321:-1111111110 --123456789:-987654321:864197532 -+123456789:-987654321:1111111110 -2/3:1/3:1/3 -7/27:3/54:11/54 --2/3:+2/3:-4/3 --2/3:-2/3:0 -0:-123:123 -0:123:-123 -&bmul -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:NaNmul:NaN -+inf:NaNmul:NaN -NaNmul:+inf:NaN -NaNmul:-inf:NaN -+inf:+inf:inf -+inf:-inf:-inf -+inf:-inf:-inf -+inf:+inf:inf -+inf:123.34:inf -+inf:-123.34:-inf --inf:123.34:-inf --inf:-123.34:inf -123.34:+inf:inf --123.34:+inf:-inf -123.34:-inf:-inf --123.34:-inf:inf -+0:+0:0 -+0:+1:0 -+1:+0:0 -+0:-1:0 --1:+0:0 -+123456789123456789:+0:0 -+0:+123456789123456789:0 --1:-1:1 --1:+1:-1 -+1:-1:-1 -+1:+1:1 -+2:+3:6 --2:+3:-6 -+2:-3:-6 --2:-3:6 -+111:+111:12321 -+10101:+10101:102030201 -+1001001:+1001001:1002003002001 -+100010001:+100010001:10002000300020001 -+10000100001:+10000100001:100002000030000200001 -+11111111111:+9:99999999999 -+22222222222:+9:199999999998 -+33333333333:+9:299999999997 -+44444444444:+9:399999999996 -+55555555555:+9:499999999995 -+66666666666:+9:599999999994 -+77777777777:+9:699999999993 -+88888888888:+9:799999999992 -+99999999999:+9:899999999991 -6:120:720 -10:10000:100000 -1/4:1/3:1/12 -&bdiv -$div_scale = 40; $round_mode = 'even' -abc:abc:NaN -abc:+1:abc:NaN -+1:abc:NaN --1:abc:NaN -0:abc:NaN -+0:+0:NaN -+0:+1:0 -+1:+0:inf -+3214:+0:inf -+0:-1:0 --1:+0:-inf --3214:+0:-inf -+1:+1:1 --1:-1:1 -+1:-1:-1 --1:+1:-1 -+1:+2:1/2 -+2:+1:2 -123:+inf:0 -123:-inf:0 -+10:+5:2 -+100:+4:25 -+1000:+8:125 -+10000:+16:625 -+10000:-16:-625 -+999999999999:+9:111111111111 -+999999999999:+99:10101010101 -+999999999999:+999:1001001001 -+999999999999:+9999:100010001 -+999999999999999:+99999:10000100001 -+1000000000:+9:1000000000/9 -+2000000000:+9:2000000000/9 -+3000000000:+9:1000000000/3 -+4000000000:+9:4000000000/9 -+5000000000:+9:5000000000/9 -+6000000000:+9:2000000000/3 -+7000000000:+9:7000000000/9 -+8000000000:+9:8000000000/9 -+9000000000:+9:1000000000 -+35500000:+113:35500000/113 -+71000000:+226:35500000/113 -+106500000:+339:35500000/113 -+1000000000:+3:1000000000/3 -2:25.024996000799840031993601279744051189762:1000000000000000000000000000000000000000/12512498000399920015996800639872025594881 -123456:1:123456 -1/4:1/3:3/4 -# reset scale for further tests -$div_scale = 40 -&is_nan -123:0 -abc:1 -NaN:1 --123:0 -&is_inf -+inf::1 --inf::1 -abc::0 -1::0 -NaN::0 --1::0 -+inf:-:0 -+inf:+:1 --inf:-:1 --inf:+:0 -# it must be exactly /^[+-]inf$/ -+infinity::0 --infinity::0 -&is_odd -abc:0 -0:0 --1:1 --3:1 -1:1 -3:1 -1000001:1 -1000002:0 -+inf:0 --inf:0 -123.45:0 --123.45:0 -2:0 -&is_int -NaNis_int:0 -0:1 -1:1 -2:1 --2:1 --1:1 --inf:0 -+inf:0 -123.4567:0 --0.1:0 --0.002:0 -1/3:0 -3/1:1 -&is_even -abc:0 -0:1 --1:0 --3:0 -1:0 -3:0 -1000001:0 -1000002:1 -2:1 -+inf:0 --inf:0 -123.456:0 --123.456:0 -0.01:0 --0.01:0 -120:1 -1200:1 --1200:1 -&is_pos -0:0 -1:1 --1:0 --123:0 -NaN:0 --inf:0 -+inf:1 -&is_positive -0:0 -1:1 --1:0 --123:0 -NaN:0 --inf:0 -+inf:1 -&is_neg -0:0 -1:0 --1:1 --123:1 -NaN:0 --inf:1 -+inf:0 -&is_negative -0:0 -1:0 --1:1 --123:1 -NaN:0 --inf:1 -+inf:0 -&parts -0:0 1 -1:1 1 -123:123 1 --123:-123 1 --1200:-1200 1 -5/7:5 7 --5/7:-5 7 -NaNparts:NaN NaN -+inf:inf inf --inf:-inf inf -&length -123:3 --123:3 -0:1 -1:1 -12345678901234567890:20 -&is_zero -NaNzero:0 -+inf:0 --inf:0 -0:1 --1:0 -1:0 -0/3:1 -1/3:0 --0/3:1 -5/inf:1 -&is_one -NaNone:0 -+inf:0 --inf:0 -0:0 -2:0 -1:1 --1:0 --2:0 -1/3:0 -100/100:1 -0.1/0.1:1 -5/inf:0 -&ffloor -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-52 -12.2:12 -3/7:0 -6/7:0 -7/7:1 -8/7:1 -13/7:1 -14/7:2 -15/7:2 --3/7:-1 --6/7:-1 --7/1:-7 --8/7:-2 --13/7:-2 --14/7:-2 --15/7:-3 -&fceil -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-51 -12.2:13 -3/7:1 -6/7:1 -8/7:2 -13/7:2 -14/7:2 -15/7:3 --3/7:0 --6/7:0 --8/7:-1 --13/7:-1 --14/7:-2 --15/7:-2 -&ffac -NaN:NaN -1:1 --1:NaN -&bpow -# bpow test for overload of ** -2:2:4 -3:3:27 -&bacmp -+0:-0:0 -+0:+1:-1 --1:+1:0 -+1:-1:0 --1:+2:-1 -+2:-1:1 --123456789:+987654321:-1 -+123456789:-987654321:-1 -+987654321:+123456789:1 --987654321:+123456789:1 --123:+4567889:-1 -# NaNs -acmpNaN:123: -123:acmpNaN: -acmpNaN:acmpNaN: -# infinity -+inf:+inf:0 --inf:-inf:0 -+inf:-inf:0 --inf:+inf:0 -+inf:123:1 --inf:123:1 -+inf:-123:1 --inf:-123:1 -+inf:1/23:1 --inf:1/23:1 -+inf:-1/23:1 --inf:-1/23:1 -+inf:12/3:1 --inf:12/3:1 -+inf:-12/3:1 --inf:-12/3:1 -123:inf:-1 --123:inf:-1 -123:-inf:-1 --123:-inf:-1 -1/23:inf:-1 --1/23:inf:-1 -1/23:-inf:-1 --1/23:-inf:-1 -12/3:inf:-1 --12/3:inf:-1 -12/3:-inf:-1 --12/3:-inf:-1 -# return undef -+inf:NaN: -NaN:inf: --inf:NaN: -NaN:-inf: -1/3:2/3:-1 -2/3:1/3:1 -2/3:2/3:0 -&fpow -2/1:3/1:8 -3/1:3/1:27 -5/2:3/1:125/8 --2/1:3/1:-8 --3/1:3/1:-27 --5/2:3/1:-125/8 --2/1:4/1:16 --3/1:4/1:81 --5/2:4/1:625/16 --5/2:-4/1:16/625 -1/5:-3:125 --1/5:-3:-125 -&numerator -NaN:NaN -inf:inf --inf:-inf -3/7:3 --3/7:-3 -0:0 -1:1 -5/-3:-5 -&denominator -NaN:NaN -inf:1 --inf:1 -3/7:7 -0:1 -1/1:1 --1/1:1 --3/7:7 -4/-5:5 -&finc -3/2:5/2 --15/6:-3/2 -NaN:NaN --1/3:2/3 --2/7:5/7 -&fdec -15/6:3/2 --3/2:-5/2 -1/3:-2/3 -2/7:-5/7 -NaN:NaN diff --git a/cpan/Math-BigRat/t/bigratpm.t b/cpan/Math-BigRat/t/bigratpm.t deleted file mode 100644 index d6bb22b1cf..0000000000 --- a/cpan/Math-BigRat/t/bigratpm.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 686; - -use Math::BigRat lib => 'Calc'; - -use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); -$class = "Math::BigRat"; -$CL = "Math::BigInt::Calc"; - -require 't/bigratpm.inc'; # all tests here for sharing diff --git a/cpan/Math-BigRat/t/bigratup.t b/cpan/Math-BigRat/t/bigratup.t deleted file mode 100644 index e963da3afc..0000000000 --- a/cpan/Math-BigRat/t/bigratup.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -# Test whether $Math::BigInt::upgrade breaks our neck - -use strict; -use Test::More tests => 5; - -use Math::BigInt upgrade => 'Math::BigRat'; -use Math::BigRat; - -my $rat = 'Math::BigRat'; -my ($x,$y,$z); - -############################################################################## -# bceil/bfloor - -$x = $rat->new('49/4'); is ($x->bfloor(),'12', 'floor(49/4)'); -$x = $rat->new('49/4'); is ($x->bceil(),'13', 'ceil(49/4)'); - -############################################################################## -# bsqrt - -$x = $rat->new('144'); is ($x->bsqrt(),'12', 'bsqrt(144)'); -$x = $rat->new('144/16'); is ($x->bsqrt(),'3', 'bsqrt(144/16)'); -$x = $rat->new('1/3'); is ($x->bsqrt(), - '1000000000000000000000000000000000000000/1732050807568877293527446341505872366943', - 'bsqrt(1/3)'); - -# all tests successfull - -1; - diff --git a/cpan/Math-BigRat/t/bigroot.t b/cpan/Math-BigRat/t/bigroot.t deleted file mode 100644 index 26bcacc5cb..0000000000 --- a/cpan/Math-BigRat/t/bigroot.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl -w - -# Test broot function (and bsqrt() function, since it is used by broot()). - -# It is too slow to be simple included in bigfltpm.inc, where it would get -# executed 3 times. - -# But it is better to test the numerical functionality, instead of not testing -# it at all. - -use strict; -use Test::More tests => 8 * 2; - -use Math::BigFloat; -use Math::BigInt; - -my $cl = "Math::BigFloat"; -my $c = "Math::BigInt"; - -# 2 ** 240 = -# 1766847064778384329583297500742918515827483896875618958121606201292619776 - -test_broot ('2','240', 8, undef, '1073741824'); -test_broot ('2','240', 9, undef, '106528681.3099908308759836475139583940127'); -test_broot ('2','120', 9, undef, '10321.27324073880096577298929482324664787'); -test_broot ('2','120', 17, undef, '133.3268493632747279600707813049418888729'); - -test_broot ('2','120', 8, undef, '32768'); -test_broot ('2','60', 8, undef, '181.0193359837561662466161566988413540569'); -test_broot ('2','60', 9, undef, '101.5936673259647663841091609134277286651'); -test_broot ('2','60', 17, undef, '11.54672461623965153271017217302844672562'); - -sub test_broot - { - my ($x,$n,$y,$scale,$result) = @_; - - my $s = $scale || 'undef'; - is ($cl->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $cl $x->bpow($n)->broot($y,$s) == $result"); - $result =~ s/\..*//; - is ($c->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $c $x->bpow($n)->broot($y,$s) == $result"); - } - diff --git a/cpan/Math-BigRat/t/hang.t b/cpan/Math-BigRat/t/hang.t deleted file mode 100644 index cf4d65c678..0000000000 --- a/cpan/Math-BigRat/t/hang.t +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w - -# test for bug #34584: hang in exp(1/2) - -use strict; -use Test::More tests => 1; - -use Math::BigRat; - -my $result = Math::BigRat->new('1/2')->bexp(); - -is ("$result", "9535900335500879457687887524133067574481/5783815921445270815783609372070483523265", - "exp(1/2) worked"); - -############################################################################## -# done - -1; - diff --git a/cpan/Math-BigRat/t/requirer.t b/cpan/Math-BigRat/t/requirer.t deleted file mode 100644 index 488ed1ecba..0000000000 --- a/cpan/Math-BigRat/t/requirer.t +++ /dev/null @@ -1,15 +0,0 @@ -#!/usr/bin/perl -w - -# check that simple requiring BigRat works - -use strict; -use Test::More tests => 1; - -my ($x); - -require Math::BigRat; $x = Math::BigRat->new(1); ++$x; - -is ($x, 2, '$x got successfully modified'); - -# all tests done - diff --git a/cpan/Math-BigRat/t/trap.t b/cpan/Math-BigRat/t/trap.t deleted file mode 100644 index cd3f442f2d..0000000000 --- a/cpan/Math-BigRat/t/trap.t +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/perl -w - -# test that config ( trap_nan => 1, trap_inf => 1) really works/dies - -use strict; -use Test::More tests => 29; - -use Math::BigRat; - -my $mbi = 'Math::BigRat'; -my ($cfg,$x); - -foreach my $class ($mbi) - { - # can do and defaults are okay? - can_ok ($class, 'config'); - is ($class->config()->{trap_nan}, 0); - is ($class->config()->{trap_inf}, 0); - - # can set? - $cfg = $class->config( trap_nan => 1 ); is ($cfg->{trap_nan},1); - - # can set via hash ref? - $cfg = $class->config( { trap_nan => 1 } ); is ($cfg->{trap_nan},1); - - # also test that new() still works normally - eval ("\$x = \$class->new('42'); \$x->bnan();"); - like ($@, qr/^Tried to set/); - is ($x,42); # after new() never modified - - # can reset? - $cfg = $class->config( trap_nan => 0 ); is ($cfg->{trap_nan},0); - - # can set? - $cfg = $class->config( trap_inf => 1 ); is ($cfg->{trap_inf},1); - eval ("\$x = \$class->new('4711'); \$x->binf();"); - like ($@, qr/^Tried to set/); - is ($x,4711); # after new() never modified - - # +$x/0 => +inf - eval ("\$x = \$class->new('4711'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,4711); # after new() never modified - - # -$x/0 => -inf - eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,-815); # after new() never modified - - $cfg = $class->config( trap_nan => 1 ); - # 0/0 => NaN - eval ("\$x = \$class->new('0'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,0); # after new() never modified - } - -############################################################################## -# BigRat - -$cfg = Math::BigRat->config( trap_nan => 1 ); - -for my $trap (qw/0.1a +inf inf -inf/) - { - my $x = Math::BigRat->new('7/4'); - - eval ("\$x = \$mbi->new('$trap');"); - is ($x,'7/4'); # never modified since it dies - eval ("\$x = \$mbi->new('$trap');"); - is ($x,'7/4'); # never modified since it dies - eval ("\$x = \$mbi->new('$trap/7');"); - is ($x,'7/4'); # never modified since it dies - } - -# all tests done - diff --git a/dist/Math-BigRat/lib/Math/BigRat.pm b/dist/Math-BigRat/lib/Math/BigRat.pm new file mode 100644 index 0000000000..3508bf94f0 --- /dev/null +++ b/dist/Math-BigRat/lib/Math/BigRat.pm @@ -0,0 +1,2020 @@ + +# +# "Tax the rat farms." - Lord Vetinari +# + +# The following hash values are used: +# sign : +,-,NaN,+inf,-inf +# _d : denominator +# _n : numeraotr (value = _n/_d) +# _a : accuracy +# _p : precision +# You should not look at the innards of a BigRat - use the methods for this. + +package Math::BigRat; + +# anythig older is untested, and unlikely to work +use 5.006; +use strict; + +use Math::BigFloat; +use vars qw($VERSION @ISA $upgrade $downgrade + $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf); + +@ISA = qw(Math::BigFloat); + +$VERSION = '0.26'; +$VERSION = eval $VERSION; + +use overload; # inherit overload from Math::BigFloat + +BEGIN + { + *objectify = \&Math::BigInt::objectify; # inherit this from BigInt + *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD + # we inherit these from BigFloat because currently it is not possible + # that MBF has a different $MBI variable than we, because MBF also uses + # Math::BigInt::config->('lib'); (there is always only one library loaded) + *_e_add = \&Math::BigFloat::_e_add; + *_e_sub = \&Math::BigFloat::_e_sub; + *as_int = \&as_number; + *is_pos = \&is_positive; + *is_neg = \&is_negative; + } + +############################################################################## +# Global constants and flags. Access these only via the accessor methods! + +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; +$upgrade = undef; +$downgrade = undef; + +# These are internally, and not to be used from the outside at all! + +$_trap_nan = 0; # are NaNs ok? set w/ config() +$_trap_inf = 0; # are infs ok? set w/ config() + +# the package we are using for our private parts, defaults to: +# Math::BigInt->config()->{lib} +my $MBI = 'Math::BigInt::Calc'; + +my $nan = 'NaN'; +my $class = 'Math::BigRat'; + +sub isa + { + return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't + UNIVERSAL::isa(@_); + } + +############################################################################## + +sub _new_from_float + { + # turn a single float input into a rational number (like '0.1') + my ($self,$f) = @_; + + return $self->bnan() if $f->is_nan(); + return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/; + + $self->{_n} = $MBI->_copy( $f->{_m} ); # mantissa + $self->{_d} = $MBI->_one(); + $self->{sign} = $f->{sign} || '+'; + if ($f->{_es} eq '-') + { + # something like Math::BigRat->new('0.1'); + # 1 / 1 => 1/10 + $MBI->_lsft ( $self->{_d}, $f->{_e} ,10); + } + else + { + # something like Math::BigRat->new('10'); + # 1 / 1 => 10/1 + $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless + $MBI->_is_zero($f->{_e}); + } + $self; + } + +sub new + { + # create a Math::BigRat + my $class = shift; + + my ($n,$d) = @_; + + my $self = { }; bless $self,$class; + + # input like (BigInt) or (BigFloat): + if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat'))) + { + if ($n->isa('Math::BigFloat')) + { + $self->_new_from_float($n); + } + if ($n->isa('Math::BigInt')) + { + # TODO: trap NaN, inf + $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N + $self->{_d} = $MBI->_one(); # d => 1 + $self->{sign} = $n->{sign}; + } + if ($n->isa('Math::BigInt::Lite')) + { + # TODO: trap NaN, inf + $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; + $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N + $self->{_d} = $MBI->_one(); # d => 1 + } + return $self->bnorm(); # normalize (120/1 => 12/10) + } + + # input like (BigInt,BigInt) or (BigLite,BigLite): + if (ref($d) && ref($n)) + { + # do N first (for $self->{sign}): + if ($n->isa('Math::BigInt')) + { + # TODO: trap NaN, inf + $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N + $self->{sign} = $n->{sign}; + } + elsif ($n->isa('Math::BigInt::Lite')) + { + # TODO: trap NaN, inf + $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; + $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n + } + else + { + require Carp; + Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new"); + } + # now D: + if ($d->isa('Math::BigInt')) + { + # TODO: trap NaN, inf + $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D + # +/+ or -/- => +, +/- or -/+ => - + $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+'; + } + elsif ($d->isa('Math::BigInt::Lite')) + { + # TODO: trap NaN, inf + $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D + my $ds = '+'; $ds = '-' if $$d < 0; + # +/+ or -/- => +, +/- or -/+ => - + $self->{sign} = $ds ne $self->{sign} ? '-' : '+'; + } + else + { + require Carp; + Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new"); + } + return $self->bnorm(); # normalize (120/1 => 12/10) + } + return $n->copy() if ref $n; # already a BigRat + + if (!defined $n) + { + $self->{_n} = $MBI->_zero(); # undef => 0 + $self->{_d} = $MBI->_one(); + $self->{sign} = '+'; + return $self; + } + + # string input with / delimiter + if ($n =~ /\s*\/\s*/) + { + return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid + return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid + ($n,$d) = split (/\//,$n); + # try as BigFloats first + if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/)) + { + local $Math::BigFloat::accuracy = undef; + local $Math::BigFloat::precision = undef; + + # one of them looks like a float + my $nf = Math::BigFloat->new($n,undef,undef); + $self->{sign} = '+'; + return $self->bnan() if $nf->is_nan(); + + $self->{_n} = $MBI->_copy( $nf->{_m} ); # get mantissa + + # now correct $self->{_n} due to $n + my $f = Math::BigFloat->new($d,undef,undef); + return $self->bnan() if $f->is_nan(); + $self->{_d} = $MBI->_copy( $f->{_m} ); + + # calculate the difference between nE and dE + my $diff_e = $nf->exponent()->bsub( $f->exponent); + if ($diff_e->is_negative()) + { + # < 0: mul d with it + $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10); + } + elsif (!$diff_e->is_zero()) + { + # > 0: mul n with it + $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10); + } + } + else + { + # both d and n look like (big)ints + + $self->{sign} = '+'; # no sign => '+' + $self->{_n} = undef; + $self->{_d} = undef; + if ($n =~ /^([+-]?)0*([0-9]+)\z/) # first part ok? + { + $self->{sign} = $1 || '+'; # no sign => '+' + $self->{_n} = $MBI->_new($2 || 0); + } + + if ($d =~ /^([+-]?)0*([0-9]+)\z/) # second part ok? + { + $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg. + $self->{_d} = $MBI->_new($2 || 0); + } + + if (!defined $self->{_n} || !defined $self->{_d}) + { + $d = Math::BigInt->new($d,undef,undef) unless ref $d; + $n = Math::BigInt->new($n,undef,undef) unless ref $n; + + if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/) + { + # both parts are ok as integers (wierd things like ' 1e0' + $self->{_n} = $MBI->_copy($n->{value}); + $self->{_d} = $MBI->_copy($d->{value}); + $self->{sign} = $n->{sign}; + $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2 + return $self->bnorm(); + } + + $self->{sign} = '+'; # a default sign + return $self->bnan() if $n->is_nan() || $d->is_nan(); + + # handle inf cases: + if ($n->is_inf() || $d->is_inf()) + { + if ($n->is_inf()) + { + return $self->bnan() if $d->is_inf(); # both are inf => NaN + my $s = '+'; # '+inf/+123' or '-inf/-123' + $s = '-' if substr($n->{sign},0,1) ne $d->{sign}; + # +-inf/123 => +-inf + return $self->binf($s); + } + # 123/inf => 0 + return $self->bzero(); + } + } + } + + return $self->bnorm(); + } + + # simple string input + if (($n =~ /[\.eE]/) && $n !~ /^0x/) + { + # looks like a float, quacks like a float, so probably is a float + $self->{sign} = 'NaN'; + local $Math::BigFloat::accuracy = undef; + local $Math::BigFloat::precision = undef; + $self->_new_from_float(Math::BigFloat->new($n,undef,undef)); + } + else + { + # for simple forms, use $MBI directly + if ($n =~ /^([+-]?)0*([0-9]+)\z/) + { + $self->{sign} = $1 || '+'; + $self->{_n} = $MBI->_new($2 || 0); + $self->{_d} = $MBI->_one(); + } + else + { + my $n = Math::BigInt->new($n,undef,undef); + $self->{_n} = $MBI->_copy($n->{value}); + $self->{_d} = $MBI->_one(); + $self->{sign} = $n->{sign}; + return $self->bnan() if $self->{sign} eq 'NaN'; + return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/; + } + } + $self->bnorm(); + } + +sub copy + { + # if two arguments, the first one is the class to "swallow" subclasses + my ($c,$x) = @_; + + if (scalar @_ == 1) + { + $x = $_[0]; + $c = ref($x); + } + return unless ref($x); # only for objects + + my $self = bless {}, $c; + + $self->{sign} = $x->{sign}; + $self->{_d} = $MBI->_copy($x->{_d}); + $self->{_n} = $MBI->_copy($x->{_n}); + $self->{_a} = $x->{_a} if defined $x->{_a}; + $self->{_p} = $x->{_p} if defined $x->{_p}; + $self; + } + +############################################################################## + +sub config + { + # return (later set?) configuration data as hash ref + my $class = shift || 'Math::BigRat'; + + if (@_ == 1 && ref($_[0]) ne 'HASH') + { + my $cfg = $class->SUPER::config(); + return $cfg->{$_[0]}; + } + + my $cfg = $class->SUPER::config(@_); + + # now we need only to override the ones that are different from our parent + $cfg->{class} = $class; + $cfg->{with} = $MBI; + $cfg; + } + +############################################################################## + +sub bstr + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2' + + return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d}); + $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); + } + +sub bsstr + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); + } + +sub bnorm + { + # reduce the number to the shortest form + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + # Both parts must be objects of whatever we are using today. + if ( my $c = $MBI->_check($x->{_n}) ) + { + require Carp; Carp::croak ("n did not pass the self-check ($c) in bnorm()"); + } + if ( my $c = $MBI->_check($x->{_d}) ) + { + require Carp; Carp::croak ("d did not pass the self-check ($c) in bnorm()"); + } + + # no normalize for NaN, inf etc. + return $x if $x->{sign} !~ /^[+-]$/; + + # normalize zeros to 0/1 + if ($MBI->_is_zero($x->{_n})) + { + $x->{sign} = '+'; # never leave a -0 + $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d}); + return $x; + } + + return $x if $MBI->_is_one($x->{_d}); # no need to reduce + + # reduce other numbers + my $gcd = $MBI->_copy($x->{_n}); + $gcd = $MBI->_gcd($gcd,$x->{_d}); + + if (!$MBI->_is_one($gcd)) + { + $x->{_n} = $MBI->_div($x->{_n},$gcd); + $x->{_d} = $MBI->_div($x->{_d},$gcd); + } + $x; + } + +############################################################################## +# sign manipulation + +sub bneg + { + # (BRAT or num_str) return BRAT + # negate number or make a negated number from string + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x if $x->modify('bneg'); + + # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN' + $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n})); + $x; + } + +############################################################################## +# special values + +sub _bnan + { + # used by parent class bnan() to initialize number to NaN + my $self = shift; + + if ($_trap_nan) + { + require Carp; + my $class = ref($self); + # "$self" below will stringify the object, this blows up if $self is a + # partial object (happens under trap_nan), so fix it beforehand + $self->{_d} = $MBI->_zero() unless defined $self->{_d}; + $self->{_n} = $MBI->_zero() unless defined $self->{_n}; + Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); + } + $self->{_n} = $MBI->_zero(); + $self->{_d} = $MBI->_zero(); + } + +sub _binf + { + # used by parent class bone() to initialize number to +inf/-inf + my $self = shift; + + if ($_trap_inf) + { + require Carp; + my $class = ref($self); + # "$self" below will stringify the object, this blows up if $self is a + # partial object (happens under trap_nan), so fix it beforehand + $self->{_d} = $MBI->_zero() unless defined $self->{_d}; + $self->{_n} = $MBI->_zero() unless defined $self->{_n}; + Carp::croak ("Tried to set $self to inf in $class\::_binf()"); + } + $self->{_n} = $MBI->_zero(); + $self->{_d} = $MBI->_zero(); + } + +sub _bone + { + # used by parent class bone() to initialize number to +1/-1 + my $self = shift; + $self->{_n} = $MBI->_one(); + $self->{_d} = $MBI->_one(); + } + +sub _bzero + { + # used by parent class bzero() to initialize number to 0 + my $self = shift; + $self->{_n} = $MBI->_zero(); + $self->{_d} = $MBI->_one(); + } + +############################################################################## +# mul/add/div etc + +sub badd + { + # add two rational numbers + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$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} !~ /^[+-]$/); + + # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 + # - + - = --------- = -- + # 4 3 4*3 12 + + # we do not compute the gcd() here, but simple do: + # 5 7 5*3 + 7*4 43 + # - + - = --------- = -- + # 4 3 4*3 12 + + # and bnorm() will then take care of the rest + + # 5 * 3 + $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d}); + + # 7 * 4 + my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} ); + + # 5 * 3 + 7 * 4 + ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign}); + + # 4 * 3 + $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d}); + + # normalize result, and possible round + $x->bnorm()->round(@r); + } + +sub bsub + { + # subtract two rational numbers + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + # flip sign of $x, call badd(), then flip sign of result + $x->{sign} =~ tr/+-/-+/ + unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 + $x->badd($y,@r); # does norm and round + $x->{sign} =~ tr/+-/-+/ + unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 + $x; + } + +sub bmul + { + # multiply two rational numbers + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + return $x->bnan() if $x->is_zero() || $y->is_zero(); + # result will always be +-inf: + # +inf * +/+inf => +inf, -inf * -/-inf => +inf + # +inf * -/-inf => -inf, -inf * +/+inf => -inf + return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-'); + } + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # XXX TODO: + # According to Knuth, this can be optimized by doing gcd twice (for d and n) + # and reducing in one step. This would save us the bnorm() at the end. + + # 1 2 1 * 2 2 1 + # - * - = ----- = - = - + # 4 3 4 * 3 12 6 + + $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n}); + $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round(@r); + } + +sub bdiv + { + # (dividend: BRAT or num_str, divisor: BRAT or num_str) return + # (BRAT,BRAT) (quo,rem) or BRAT (only rem) + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # XXX TODO: list context, upgrade + # According to Knuth, this can be optimized by doing gcd twice (for d and n) + # and reducing in one step. This would save us the bnorm() at the end. + + # 1 1 1 3 + # - / - == - * - + # 4 3 4 1 + + $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d}); + $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round(@r); + $x; + } + +sub bmod + { + # compute "remainder" (in Perl way) of $x / $y + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); + + return $x if $x->is_zero(); # 0 / 7 = 0, mod 0 + + # compute $x - $y * floor($x/$y), keeping the sign of $x + + # copy x to u, make it positive and then do a normal division ($u/$y) + my $u = bless { sign => '+' }, $self; + $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} ); + $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} ); + + # compute floor(u) + if (! $MBI->_is_one($u->{_d})) + { + $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate + # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway + } + + # now compute $y * $u + $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above + $u->{_n} = $MBI->_mul($u->{_n},$y->{_n}); + + my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive + # compute $x - $u + $x->bsub($u); + $x->{sign} = $xsign; # put sign back + + $x->bnorm()->round(@r); + } + +############################################################################## +# bdec/binc + +sub bdec + { + # decrement value (subtract 1) + my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + + if ($x->{sign} eq '-') + { + $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d}); # -5/2 => -7/2 + } + else + { + if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d? + { + # 1/3 -- => -2/3 + $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n}); + $x->{sign} = '-'; + } + else + { + $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2 + } + } + $x->bnorm()->round(@r); + } + +sub binc + { + # increment value (add 1) + my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + + if ($x->{sign} eq '-') + { + if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) + { + # -1/3 ++ => 2/3 (overflow at 0) + $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n}); + $x->{sign} = '+'; + } + else + { + $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2 + } + } + else + { + $x->{_n} = $MBI->_add($x->{_n},$x->{_d}); # 5/2 => 7/2 + } + $x->bnorm()->round(@r); + } + +############################################################################## +# is_foo methods (the rest is inherited) + +sub is_int + { + # return true if arg (BRAT or num_str) is an integer + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't + $MBI->_is_one($x->{_d}); # x/y && y != 1 => no integer + 0; + } + +sub is_zero + { + # return true if arg (BRAT or num_str) is zero + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); + 0; + } + +sub is_one + { + # return true if arg (BRAT or num_str) is +1 or -1 if signis given + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + my $sign = $_[2] || ''; $sign = '+' if $sign ne '-'; + return 1 + if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})); + 0; + } + +sub is_odd + { + # return true if arg (BFLOAT or num_str) is odd or false if even + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't + ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1 + 0; + } + +sub is_even + { + # return true if arg (BINT or num_str) is even or false if odd + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't + return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never + && $MBI->_is_even($x->{_n})); # but 4/1 is + 0; + } + +############################################################################## +# parts() and friends + +sub numerator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + # NaN, inf, -inf + return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/); + + my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign}; + $n; + } + +sub denominator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + # NaN + return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN'; + # inf, -inf + return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/; + + Math::BigInt->new($MBI->_str($x->{_d})); + } + +sub parts + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $c = 'Math::BigInt'; + + return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN'; + return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf'; + return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf'; + + my $n = $c->new( $MBI->_str($x->{_n})); + $n->{sign} = $x->{sign}; + my $d = $c->new( $MBI->_str($x->{_d})); + ($n,$d); + } + +sub length + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $nan unless $x->is_int(); + $MBI->_len($x->{_n}); # length(-123/1) => length(123) + } + +sub digit + { + my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_); + + return $nan unless $x->is_int(); + $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2) + } + +############################################################################## +# special calc routines + +sub bceil + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf + $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 + + $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate + $x->{_d} = $MBI->_one(); # d => 1 + $x->{_n} = $MBI->_inc($x->{_n}) + if $x->{sign} eq '+'; # +22/7 => 4/1 + $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0 + $x; + } + +sub bfloor + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf + $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 + + $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate + $x->{_d} = $MBI->_one(); # d => 1 + $x->{_n} = $MBI->_inc($x->{_n}) + if $x->{sign} eq '-'; # -22/7 => -4/1 + $x; + } + +sub bfac + { + my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + + # if $x is not an integer + if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d}))) + { + return $x->bnan(); + } + + $x->{_n} = $MBI->_fac($x->{_n}); + # since _d is 1, we don't need to reduce/norm the result + $x->round(@r); + } + +sub bpow + { + # power ($x ** $y) + + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x + return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; + return $x->bone(@r) if $y->is_zero(); + return $x->round(@r) if $x->is_one() || $y->is_one(); + + if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})) + { + # if $x == -1 and odd/even y => +1/-1 + return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); + # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; + } + # 1 ** -y => 1 / (1 ** |y|) + # so do test for negative $y after above's clause + + return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) + + # shortcut if y == 1/N (is then sqrt() respective broot()) + if ($MBI->_is_one($y->{_n})) + { + return $x->bsqrt(@r) if $MBI->_is_two($y->{_d}); # 1/2 => sqrt + return $x->broot($MBI->_str($y->{_d}),@r); # 1/N => root(N) + } + + # shortcut y/1 (and/or x/1) + if ($MBI->_is_one($y->{_d})) + { + # shortcut for x/1 and y/1 + if ($MBI->_is_one($x->{_d})) + { + $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1 + if ($y->{sign} eq '-') + { + # 0.2 ** -3 => 1/(0.2 ** 3) + ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap + } + # correct sign; + ** + => + + if ($x->{sign} eq '-') + { + # - * - => +, - * - * - => - + $x->{sign} = '+' if $MBI->_is_even($y->{_n}); + } + return $x->round(@r); + } + # x/z ** y/1 + $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y + $x->{_d} = $MBI->_pow($x->{_d},$y->{_n}); + if ($y->{sign} eq '-') + { + # 0.2 ** -3 => 1/(0.2 ** 3) + ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap + } + # correct sign; + ** + => + + if ($x->{sign} eq '-') + { + # - * - => +, - * - * - => - + $x->{sign} = '+' if $MBI->_is_even($y->{_n}); + } + return $x->round(@r); + } + +# print STDERR "# $x $y\n"; + + # otherwise: + + # n/d n ______________ + # a/b = -\/ (a/b) ** d + + # (a/b) ** n == (a ** n) / (b ** n) + $MBI->_pow($x->{_n}, $y->{_n} ); + $MBI->_pow($x->{_d}, $y->{_n} ); + + return $x->broot($MBI->_str($y->{_d}),@r); # n/d => root(n) + } + +sub blog + { + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,$class,@_); + } + + # blog(1,Y) => 0 + return $x->bzero() if $x->is_one() && $y->{sign} eq '+'; + + # $x <= 0 => NaN + return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+'; + + if ($x->is_int() && $y->is_int()) + { + return $self->new($x->as_number()->blog($y->as_number(),@r)); + } + + # do it with floats + $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) ); + } + +sub bexp + { + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,$class,@_); + } + + return $x->binf(@r) if $x->{sign} eq '+inf'; + return $x->bzero(@r) if $x->{sign} eq '-inf'; + + # we need to limit the accuracy to protect against overflow + my $fallback = 0; + my ($scale,@params); + ($x,@params) = $x->_find_round_parameters(@r); + + # also takes care of the "error in _find_round_parameters?" case + return $x if $x->{sign} eq 'NaN'; + + # no rounding at all, so must use fallback + if (scalar @params == 0) + { + # simulate old behaviour + $params[0] = $self->div_scale(); # and round to it as accuracy + $params[1] = undef; # P = undef + $scale = $params[0]+4; # at least four more for proper round + $params[2] = $r[2]; # round mode by caller or undef + $fallback = 1; # to clear a/p afterwards + } + else + { + # the 4 below is empirical, and there might be cases where it's not enough... + $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined + } + + return $x->bone(@params) if $x->is_zero(); + + # See the comments in Math::BigFloat on how this algorithm works. + # Basically we calculate A and B (where B is faculty(N)) so that A/B = e + + my $x_org = $x->copy(); + if ($scale <= 75) + { + # set $x directly from a cached string form + $x->{_n} = $MBI->_new("90933395208605785401971970164779391644753259799242"); + $x->{_d} = $MBI->_new("33452526613163807108170062053440751665152000000000"); + $x->{sign} = '+'; + } + else + { + # compute A and B so that e = A / B. + + # After some terms we end up with this, so we use it as a starting point: + my $A = $MBI->_new("90933395208605785401971970164779391644753259799242"); + my $F = $MBI->_new(42); my $step = 42; + + # Compute how many steps we need to take to get $A and $B sufficiently big + my $steps = Math::BigFloat::_len_to_steps($scale - 4); +# print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; + while ($step++ <= $steps) + { + # calculate $a * $f + 1 + $A = $MBI->_mul($A, $F); + $A = $MBI->_inc($A); + # increment f + $F = $MBI->_inc($F); + } + # compute $B as factorial of $steps (this is faster than doing it manually) + my $B = $MBI->_fac($MBI->_new($steps)); + +# print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n"; + + $x->{_n} = $A; + $x->{_d} = $B; + $x->{sign} = '+'; + } + + # $x contains now an estimate of e, with some surplus digits, so we can round + if (!$x_org->is_one()) + { + # raise $x to the wanted power and round it in one step: + $x->bpow($x_org, @params); + } + else + { + # else just round the already computed result + delete $x->{_a}; delete $x->{_p}; + # shortcut to not run through _find_round_parameters again + if (defined $params[0]) + { + $x->bround($params[0],$params[2]); # then round accordingly + } + else + { + $x->bfround($params[1],$params[2]); # then round accordingly + } + } + if ($fallback) + { + # clear a/p after round, since user did not request it + delete $x->{_a}; delete $x->{_p}; + } + + $x; + } + +sub bnok + { + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,$class,@_); + } + + # do it with floats + $x->_new_from_float( $x->_as_float()->bnok(Math::BigFloat->new("$y"),@r) ); + } + +sub _float_from_part + { + my $x = shift; + + my $f = Math::BigFloat->bzero(); + $f->{_m} = $MBI->_copy($x); + $f->{_e} = $MBI->_zero(); + + $f; + } + +sub _as_float + { + my $x = shift; + + local $Math::BigFloat::upgrade = undef; + local $Math::BigFloat::accuracy = undef; + local $Math::BigFloat::precision = undef; + # 22/7 => 3.142857143.. + + my $a = $x->accuracy() || 0; + if ($a != 0 || !$MBI->_is_one($x->{_d})) + { + # n/d + return scalar Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy()); + } + # just n + Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n})); + } + +sub broot + { + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + if ($x->is_int() && $y->is_int()) + { + return $self->new($x->as_number()->broot($y->as_number(),@r)); + } + + # do it with floats + $x->_new_from_float( $x->_as_float()->broot($y->_as_float(),@r) )->bnorm()->bround(@r); + } + +sub bmodpow + { + # set up parameters + my ($self,$x,$y,$m,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,$m,@r) = objectify(3,@_); + } + + # $x or $y or $m are NaN or +-inf => NaN + return $x->bnan() + if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || + $m->{sign} !~ /^[+-]$/; + + if ($x->is_int() && $y->is_int() && $m->is_int()) + { + return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r)); + } + + warn ("bmodpow() not fully implemented"); + $x->bnan(); + } + +sub bmodinv + { + # set up parameters + my ($self,$x,$y,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y,@r) = objectify(2,@_); + } + + # $x or $y are NaN or +-inf => NaN + return $x->bnan() + if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; + + if ($x->is_int() && $y->is_int()) + { + return $self->new($x->as_number()->bmodinv($y->as_number(),@r)); + } + + warn ("bmodinv() not fully implemented"); + $x->bnan(); + } + +sub bsqrt + { + my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + + return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 + return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf + return $x->round(@r) if $x->is_zero() || $x->is_one(); + + local $Math::BigFloat::upgrade = undef; + local $Math::BigFloat::downgrade = undef; + local $Math::BigFloat::precision = undef; + local $Math::BigFloat::accuracy = undef; + local $Math::BigInt::upgrade = undef; + local $Math::BigInt::precision = undef; + local $Math::BigInt::accuracy = undef; + + $x->{_n} = _float_from_part( $x->{_n} )->bsqrt(); + $x->{_d} = _float_from_part( $x->{_d} )->bsqrt(); + + # XXX TODO: we probably can optimze this: + + # if sqrt(D) was not integer + if ($x->{_d}->{_es} ne '+') + { + $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1 + $x->{_d} = $MBI->_copy( $x->{_d}->{_m} ); # 7.1/45.1 => 71/45.1 + } + # if sqrt(N) was not integer + if ($x->{_n}->{_es} ne '+') + { + $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1 + $x->{_n} = $MBI->_copy( $x->{_n}->{_m} ); # 710/45.1 => 710/451 + } + + # convert parts to $MBI again + $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10) + if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY'; + $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10) + if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY'; + + $x->bnorm()->round(@r); + } + +sub blsft + { + my ($self,$x,$y,$b,@r) = objectify(3,@_); + + $b = 2 unless defined $b; + $b = $self->new($b) unless ref ($b); + $x->bmul( $b->copy()->bpow($y), @r); + $x; + } + +sub brsft + { + my ($self,$x,$y,$b,@r) = objectify(3,@_); + + $b = 2 unless defined $b; + $b = $self->new($b) unless ref ($b); + $x->bdiv( $b->copy()->bpow($y), @r); + $x; + } + +############################################################################## +# round + +sub round + { + $_[0]; + } + +sub bround + { + $_[0]; + } + +sub bfround + { + $_[0]; + } + +############################################################################## +# comparing + +sub bcmp + { + # compare two signed numbers + + # set up parameters + my ($self,$x,$y) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y) = objectify(2,@_); + } + + 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 +1 if $x->{sign} eq '+inf'; + return -1 if $x->{sign} eq '-inf'; + return -1 if $y->{sign} eq '+inf'; + return +1; + } + # check sign for speed first + return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y + return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 + + # shortcut + my $xz = $MBI->_is_zero($x->{_n}); + my $yz = $MBI->_is_zero($y->{_n}); + return 0 if $xz && $yz; # 0 <=> 0 + return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y + return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 + + my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d}); + my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d}); + + my $cmp = $MBI->_acmp($t,$u); # signs are equal + $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse + $cmp; + } + +sub bacmp + { + # compare two numbers (as unsigned) + + # set up parameters + my ($self,$x,$y) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$y) = objectify(2,$class,@_); + } + + 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 -1; + } + + my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d}); + my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d}); + $MBI->_acmp($t,$u); # ignore signs + } + +############################################################################## +# output conversation + +sub numify + { + # convert 17/8 => float (aka 2.125) + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc + + # N/1 => N + my $neg = ''; $neg = '-' if $x->{sign} eq '-'; + return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d}); + + $x->_as_float()->numify() + 0.0; + } + +sub as_number + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + # NaN, inf etc + return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; + + my $u = Math::BigInt->bzero(); + $u->{sign} = $x->{sign}; + $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3 + $u; + } + +sub as_float + { + # return N/D as Math::BigFloat + + # set up parameters + my ($self,$x,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + ($self,$x,@r) = objectify(1,$class,@_) unless ref $_[0]; + + # NaN, inf etc + return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; + + my $u = Math::BigFloat->bzero(); + $u->{sign} = $x->{sign}; + # n + $u->{_m} = $MBI->_copy($x->{_n}); + $u->{_e} = $MBI->_zero(); + $u->bdiv( $MBI->_str($x->{_d}), @r); + # return $u + $u; + } + +sub as_bin + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x unless $x->is_int(); + + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $MBI->_as_bin($x->{_n}); + } + +sub as_hex + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x unless $x->is_int(); + + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $MBI->_as_hex($x->{_n}); + } + +sub as_oct + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x unless $x->is_int(); + + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $MBI->_as_oct($x->{_n}); + } + +############################################################################## + +sub from_hex + { + my $class = shift; + + $class->new(@_); + } + +sub from_bin + { + my $class = shift; + + $class->new(@_); + } + +sub from_oct + { + my $class = shift; + + my @parts; + for my $c (@_) + { + push @parts, Math::BigInt->from_oct($c); + } + $class->new ( @parts ); + } + +############################################################################## +# import + +sub import + { + my $self = shift; + my $l = scalar @_; + my $lib = ''; my @a; + my $try = 'try'; + + for ( my $i = 0; $i < $l ; $i++) + { + if ( $_[$i] eq ':constant' ) + { + # this rest causes overlord er load to step in + overload::constant float => sub { $self->new(shift); }; + } +# elsif ($_[$i] eq 'upgrade') +# { +# # this causes upgrading +# $upgrade = $_[$i+1]; # or undef to disable +# $i++; +# } + elsif ($_[$i] eq 'downgrade') + { + # this causes downgrading + $downgrade = $_[$i+1]; # or undef to disable + $i++; + } + elsif ($_[$i] =~ /^(lib|try|only)\z/) + { + $lib = $_[$i+1] || ''; # default Calc + $try = $1; # lib, try or only + $i++; + } + elsif ($_[$i] eq 'with') + { + # this argument is no longer used + #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc + $i++; + } + else + { + push @a, $_[$i]; + } + } + require Math::BigInt; + + # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP + if ($lib ne '') + { + my @c = split /\s*,\s*/, $lib; + foreach (@c) + { + $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters + } + $lib = join(",", @c); + } + my @import = ('objectify'); + push @import, $try => $lib if $lib ne ''; + + # MBI already loaded, so feed it our lib arguments + Math::BigInt->import( @import ); + + $MBI = Math::BigFloat->config()->{lib}; + + # register us with MBI to get notified of future lib changes + Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } ); + + # any non :constant stuff is handled by our parent, Exporter (loaded + # by Math::BigFloat, even if @_ is empty, to give it a chance + $self->SUPER::import(@a); # for subclasses + $self->export_to_level(1,$self,@a); # need this, too + } + +1; + +__END__ + +=head1 NAME + +Math::BigRat - Arbitrary big rational numbers + +=head1 SYNOPSIS + + use Math::BigRat; + + my $x = Math::BigRat->new('3/7'); $x += '5/9'; + + print $x->bstr(),"\n"; + print $x ** 2,"\n"; + + my $y = Math::BigRat->new('inf'); + print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n"; + + my $z = Math::BigRat->new(144); $z->bsqrt(); + +=head1 DESCRIPTION + +Math::BigRat complements Math::BigInt and Math::BigFloat by providing support +for arbitrary big rational numbers. + +=head2 MATH LIBRARY + +You can change the underlying module that does the low-level +math operations by using: + + use Math::BigRat try => 'GMP'; + +Note: This needs Math::BigInt::GMP installed. + +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::BigRat try => 'Foo,Math::BigInt::Bar'; + +If you want to get warned when the fallback occurs, replace "try" with +"lib": + + use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; + +If you want the code to die instead, replace "try" with +"only": + + use Math::BigRat only => 'Foo,Math::BigInt::Bar'; + +=head1 METHODS + +Any methods not listed here are derived from Math::BigFloat (or +Math::BigInt), so make sure you check these two modules for further +information. + +=head2 new() + + $x = Math::BigRat->new('1/3'); + +Create a new Math::BigRat object. Input can come in various forms: + + $x = Math::BigRat->new(123); # scalars + $x = Math::BigRat->new('inf'); # infinity + $x = Math::BigRat->new('123.3'); # float + $x = Math::BigRat->new('1/3'); # simple string + $x = Math::BigRat->new('1 / 3'); # spaced + $x = Math::BigRat->new('1 / 0.1'); # w/ floats + $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt + $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat + $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite + + # You can also give D and N as different objects: + $x = Math::BigRat->new( + Math::BigInt->new(-123), + Math::BigInt->new(7), + ); # => -123/7 + +=head2 numerator() + + $n = $x->numerator(); + +Returns a copy of the numerator (the part above the line) as signed BigInt. + +=head2 denominator() + + $d = $x->denominator(); + +Returns a copy of the denominator (the part under the line) as positive BigInt. + +=head2 parts() + + ($n,$d) = $x->parts(); + +Return a list consisting of (signed) numerator and (unsigned) denominator as +BigInts. + +=head2 numify() + + my $y = $x->numify(); + +Returns the object as a scalar. This will lose some data if the object +cannot be represented by a normal Perl scalar (integer or float), so +use L or L instead. + +This routine is automatically used whenever a scalar is required: + + my $x = Math::BigRat->new('3/1'); + @array = (0,1,2,3); + $y = $array[$x]; # set $y to 3 + +=head2 as_int()/as_number() + + $x = Math::BigRat->new('13/7'); + print $x->as_int(),"\n"; # '1' + +Returns a copy of the object as BigInt, truncated to an integer. + +C is an alias for C. + +=head2 as_float() + + $x = Math::BigRat->new('13/7'); + print $x->as_float(),"\n"; # '1' + + $x = Math::BigRat->new('2/3'); + print $x->as_float(5),"\n"; # '0.66667' + +Returns a copy of the object as BigFloat, preserving the +accuracy as wanted, or the default of 40 digits. + +This method was added in v0.22 of Math::BigRat (April 2008). + +=head2 as_hex() + + $x = Math::BigRat->new('13'); + print $x->as_hex(),"\n"; # '0xd' + +Returns the BigRat as hexadecimal string. Works only for integers. + +=head2 as_bin() + + $x = Math::BigRat->new('13'); + print $x->as_bin(),"\n"; # '0x1101' + +Returns the BigRat as binary string. Works only for integers. + +=head2 as_oct() + + $x = Math::BigRat->new('13'); + print $x->as_oct(),"\n"; # '015' + +Returns the BigRat as octal string. Works only for integers. + +=head2 from_hex()/from_bin()/from_oct() + + my $h = Math::BigRat->from_hex('0x10'); + my $b = Math::BigRat->from_bin('0b10000000'); + my $o = Math::BigRat->from_oct('020'); + +Create a BigRat from an hexadecimal, binary or octal number +in string form. + +=head2 length() + + $len = $x->length(); + +Return the length of $x in digitis for integer values. + +=head2 digit() + + print Math::BigRat->new('123/1')->digit(1); # 1 + print Math::BigRat->new('123/1')->digit(-1); # 3 + +Return the N'ths digit from X when X is an integer value. + +=head2 bnorm() + + $x->bnorm(); + +Reduce the number to the shortest form. This routine is called +automatically whenever it is needed. + +=head2 bfac() + + $x->bfac(); + +Calculates the factorial of $x. For instance: + + print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3 + print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5 + +Works currently only for integers. + +=head2 bround()/round()/bfround() + +Are not yet implemented. + +=head2 bmod() + + use Math::BigRat; + my $x = Math::BigRat->new('7/4'); + my $y = Math::BigRat->new('4/3'); + print $x->bmod($y); + +Set $x to the remainder of the division of $x by $y. + +=head2 bneg() + + $x->bneg(); + +Used to negate the object in-place. + +=head2 is_one() + + print "$x is 1\n" if $x->is_one(); + +Return true if $x is exactly one, otherwise false. + +=head2 is_zero() + + print "$x is 0\n" if $x->is_zero(); + +Return true if $x is exactly zero, otherwise false. + +=head2 is_pos()/is_positive() + + print "$x is >= 0\n" if $x->is_positive(); + +Return true if $x is positive (greater than or equal to zero), otherwise +false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't. + +C is an alias for C. + +=head2 is_neg()/is_negative() + + print "$x is < 0\n" if $x->is_negative(); + +Return true if $x is negative (smaller than zero), otherwise false. Please +note that '-inf' is also negative, while 'NaN' and '+inf' aren't. + +C is an alias for C. + +=head2 is_int() + + print "$x is an integer\n" if $x->is_int(); + +Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise +false. Please note that '-inf', 'inf' and 'NaN' aren't integer. + +=head2 is_odd() + + print "$x is odd\n" if $x->is_odd(); + +Return true if $x is odd, otherwise false. + +=head2 is_even() + + print "$x is even\n" if $x->is_even(); + +Return true if $x is even, otherwise false. + +=head2 bceil() + + $x->bceil(); + +Set $x to the next bigger integer value (e.g. truncate the number to integer +and then increment it by one). + +=head2 bfloor() + + $x->bfloor(); + +Truncate $x to an integer value. + +=head2 bsqrt() + + $x->bsqrt(); + +Calculate the square root of $x. + +=head2 broot() + + $x->broot($n); + +Calculate the N'th root of $x. + +=head2 badd()/bmul()/bsub()/bdiv()/bdec()/binc() + +Please see the documentation in L. + +=head2 copy() + + my $z = $x->copy(); + +Makes a deep copy of the object. + +Please see the documentation in L for further details. + +=head2 bstr()/bsstr() + + my $x = Math::BigInt->new('8/4'); + print $x->bstr(),"\n"; # prints 1/2 + print $x->bsstr(),"\n"; # prints 1/2 + +Return a string representating this object. + +=head2 bacmp()/bcmp() + +Used to compare numbers. + +Please see the documentation in L for further details. + +=head2 blsft()/brsft() + +Used to shift numbers left/right. + +Please see the documentation in L for further details. + +=head2 bpow() + + $x->bpow($y); + +Compute $x ** $y. + +Please see the documentation in L for further details. + +=head2 bexp() + + $x->bexp($accuracy); # calculate e ** X + +Calculates two integers A and B so that A/B is equal to C, where C is +Euler's number. + +This method was added in v0.20 of Math::BigRat (May 2007). + +See also L. + +=head2 bnok() + + $x->bnok($y); # x over y (binomial coefficient n over k) + +Calculates the binomial coefficient n over k, also called the "choose" +function. The result is equivalent to: + + ( n ) n! + | - | = ------- + ( k ) k!(n-k)! + +This method was added in v0.20 of Math::BigRat (May 2007). + +=head2 config() + + use Data::Dumper; + + print Dumper ( Math::BigRat->config() ); + print Math::BigRat->config()->{lib},"\n"; + +Returns a hash containing the configuration, e.g. the version number, lib +loaded etc. The following hash keys are currently filled in with the +appropriate information. + + key RO/RW Description + Example + ============================================================ + lib RO Name of the Math library + Math::BigInt::Calc + lib_version RO Version of 'lib' + 0.30 + class RO The class of config you just called + Math::BigRat + version RO version number of the class you used + 0.10 + upgrade RW To which class numbers are upgraded + undef + downgrade RW To which class numbers are downgraded + undef + precision RW Global precision + undef + accuracy RW Global accuracy + undef + round_mode RW Global round mode + even + div_scale RW Fallback accuracy for div + 40 + trap_nan RW Trap creation of NaN (undef = no) + undef + trap_inf RW Trap creation of +inf/-inf (undef = no) + undef + +By passing a reference to a hash you may set the configuration values. This +works only for values that a marked with a C above, anything else is +read-only. + +=head2 objectify() + +This is an internal routine that turns scalars into objects. + +=head1 BUGS + +Some things are not yet implemented, or only implemented half-way: + +=over 2 + +=item inf handling (partial) + +=item NaN handling (partial) + +=item rounding (not implemented except for bceil/bfloor) + +=item $x ** $y where $y is not an integer + +=item bmod(), blog(), bmodinv() and bmodpow() (partial) + +=back + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +L and L as well as L, +L and L. + +See L for a way to use +Math::BigRat. + +The package at L +may contain more documentation and examples as well as testcases. + +=head1 AUTHORS + +(C) by Tels L 2001 - 2009. + +Currently maintained by Jonathan "Duke" Leto L + +=cut diff --git a/dist/Math-BigRat/t/Math/BigRat/Test.pm b/dist/Math-BigRat/t/Math/BigRat/Test.pm new file mode 100644 index 0000000000..74f9f9d004 --- /dev/null +++ b/dist/Math-BigRat/t/Math/BigRat/Test.pm @@ -0,0 +1,122 @@ +package Math::BigRat::Test; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigRat; +use Math::BigFloat; +use vars qw($VERSION @ISA + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Math::BigRat Exporter); +$VERSION = 0.04; + +use overload; # inherit overload from BigRat + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +my $class = 'Math::BigRat::Test'; + +#ub 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]; +# # Store the floating point value +# my $self = Math::BigFloat->new($value,$a,$p,$round_mode); +# bless $self, $class; +# $self->{'_custom'} = 1; # make sure this never goes away +# return $self; +#} + +BEGIN + { + *fstr = \&bstr; + *fsstr = \&bsstr; + *objectify = \&Math::BigInt::objectify; + *AUTOLOAD = \&Math::BigRat::AUTOLOAD; + no strict 'refs'; + foreach my $method ( qw/ div acmp floor ceil root sqrt log fac modpow modinv/) + { + *{'b' . $method} = \&{'Math::BigRat::b' . $method}; + } + } + +sub fround + { + my ($x,$a) = @_; + + #print "$a $accuracy $precision $round_mode\n"; + Math::BigFloat->round_mode($round_mode); + Math::BigFloat->accuracy($a || $accuracy); + Math::BigFloat->precision(undef); + my $y = Math::BigFloat->new($x->bsstr(),undef,undef); + $class->new($y->fround($a)); + } + +sub ffround + { + my ($x,$p) = @_; + + Math::BigFloat->round_mode($round_mode); + Math::BigFloat->accuracy(undef); + Math::BigFloat->precision($p || $precision); + my $y = Math::BigFloat->new($x->bsstr(),undef,undef); + $class->new($y->ffround($p)); + } + +sub bstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + +# print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n"; + return $s.$x->{_n} if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + local $Math::BigFloat::accuracy = $accuracy || $x->{_a}; + local $Math::BigFloat::precision = $precision || $x->{_p}; + $s.$output->bstr(); + } + +sub numify + { + $_[0]->bsstr(); + } + +sub bsstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bsstr(); + } + +1; diff --git a/dist/Math-BigRat/t/big_ap.t b/dist/Math-BigRat/t/big_ap.t new file mode 100644 index 0000000000..1b45eddfe7 --- /dev/null +++ b/dist/Math-BigRat/t/big_ap.t @@ -0,0 +1,94 @@ +#!/usr/bin/perl -w + +# Test that accuracy() and precision() in BigInt/BigFloat do not disturb +# the rounding force in BigRat. + +use strict; +use Test::More tests => 17; + +use Math::BigInt; +use Math::BigFloat; +use Math::BigRat; + +my $r = 'Math::BigRat'; +my $proper = $r->new('12345678901234567890/2'); +my $proper_inc = $r->new('12345678901234567890/2')->binc(); +my $proper_dec = $r->new('12345678901234567890/2')->bdec(); +my $proper_int = Math::BigInt->new('12345678901234567890'); +my $proper_float = Math::BigFloat->new('12345678901234567890'); +my $proper2 = $r->new('12345678901234567890'); + +print "# Start\n"; + +Math::BigInt->accuracy(3); +Math::BigFloat->accuracy(5); + +my ($x,$y,$z); + +############################################################################## +# new() + +$z = $r->new('12345678901234567890/2'); +is ($z,$proper); + +$z = $r->new('1234567890123456789E1'); +is ($z,$proper2); + +$z = $r->new('12345678901234567890/1E0'); +is ($z,$proper2); +$z = $r->new('1234567890123456789e1/1'); +is ($z,$proper2); +$z = $r->new('1234567890123456789e1/1E0'); +is ($z,$proper2); + +$z = $r->new($proper_int); +is ($z,$proper2); + +$z = $r->new($proper_float); +is ($z,$proper2); + +############################################################################## +# bdiv + +$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2'); +$z = $x->copy->bdiv($y); +is ($z,$proper); + +############################################################################## +# bmul + +$x = $r->new("$proper"); $y = Math::BigRat->new('1'); +$z = $x->copy->bmul($y); +is ($z,$proper); +$z = $r->new('12345678901234567890/1E0'); +is ($z,$proper2); + +$z = $r->new($proper_int); +is ($z,$proper2); + +$z = $r->new($proper_float); +is ($z,$proper2); + +############################################################################## +# bdiv + +$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2'); +$z = $x->copy->bdiv($y); +is ($z,$proper); + +############################################################################## +# bmul + +$x = $r->new("$proper"); $y = Math::BigRat->new('1'); +$z = $x->copy->bmul($y); +is ($z,$proper); + +$x = $r->new("$proper"); $y = Math::BigRat->new('2'); +$z = $x->copy->bmul($y); +is ($z,$proper2); + +############################################################################## +# binc/bdec + +$x = $proper->copy()->binc(); is ($x,$proper_inc); +$x = $proper->copy()->bdec(); is ($x,$proper_dec); diff --git a/dist/Math-BigRat/t/bigfltpm.inc b/dist/Math-BigRat/t/bigfltpm.inc new file mode 100644 index 0000000000..fcc09c75be --- /dev/null +++ b/dist/Math-BigRat/t/bigfltpm.inc @@ -0,0 +1,1673 @@ +#include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + +use strict; + +my $z; + +while () + { + chomp; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = $class->new(\"$args[0]\");"; + if ($f eq "fnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->finf('$args[1]');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->fstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "exponent") { + # ->bstr() to see if an object is returned + $try .= '$x->exponent()->bstr();'; + } elsif ($f eq "mantissa") { + # ->bstr() to see if an object is returned + $try .= '$x->mantissa()->bstr();'; + } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) { + $try .= "\$x->$f();"; + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->f$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->fround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->ffround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->fsqrt();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->ffac();"; + } elsif ($f eq "flog") { + if (defined $args[1] && $args[1] ne '') + { + $try .= "\$y = $class->new($args[1]);"; + $try .= "$setup; \$x->flog(\$y);"; + } + else + { + $try .= "$setup; \$x->flog();"; + } + } + else + { + $try .= "\$y = $class->new(\"$args[1]\");"; + + if ($f eq "bgcd") + { + if (defined $args[2]) + { + $try .= " \$z = $class->new(\"$args[2]\"); "; + } + $try .= "$class\::bgcd(\$x, \$y"; + $try .= ", \$z" if (defined $args[2]); + $try .= " );"; + } + elsif ($f eq "blcm") + { + if (defined $args[2]) + { + $try .= " \$z = $class->new(\"$args[2]\"); "; + } + $try .= "$class\::blcm(\$x, \$y"; + $try .= ", \$z" if (defined $args[2]); + $try .= " );"; + } elsif ($f eq "fcmp") { + $try .= '$x->fcmp($y);'; + } elsif ($f eq "facmp") { + $try .= '$x->facmp($y);'; + } elsif ($f eq "fpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "bnok") { + $try .= '$x->bnok($y);'; + } elsif ($f eq "froot") { + $try .= "$setup; \$x->froot(\$y);"; + } elsif ($f eq "fadd") { + $try .= '$x + $y;'; + } elsif ($f eq "fsub") { + $try .= '$x - $y;'; + } elsif ($f eq "fmul") { + $try .= '$x * $y;'; + } elsif ($f eq "fdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->fdiv(\$y));"; + } elsif ($f eq "frsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "flsft") { + $try .= '$x << $y;'; + } elsif ($f eq "fmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + print "# Error: $@\n" if $@; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); + if (ref($ans1) eq "$class") + { + # float numbers are normalized (for now), so mantissa shouldn't have + # trailing zeros + #print $ans1->_trailing_zeros(),"\n"; + print "# Has trailing zeros after '$try'\n" + if !ok ($CL->_zeros( $ans1->{_m}), 0); + } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +ok ($y,1200); ok ($x,1200); + +############################################################################### +# Really huge, big, ultra-mega-biggy-monster exponents +# Technically, the exponents should not be limited (they are BigInts), but +# practically there are a few places were they are limited to a Perl scalar. +# This is sometimes for speed, sometimes because otherwise the number wouldn't +# fit into your memory (just think of 1e123456789012345678901234567890 + 1!) +# anyway. We don't test everything here, but let's make sure it just basically +# works. + +my $monster = '1e1234567890123456789012345678901234567890'; + +# new and exponent +ok ($class->new($monster)->bsstr(), + '1e+1234567890123456789012345678901234567890'); +ok ($class->new($monster)->exponent(), + '1234567890123456789012345678901234567890'); +# cmp +ok ($class->new($monster) > 0,1); + +# sub/mul +ok ($class->new($monster)->bsub( $monster),0); +ok ($class->new($monster)->bmul(2)->bsstr(), + '2e+1234567890123456789012345678901234567890'); + +# mantissa +$monster = '1234567890123456789012345678901234567890e2'; +ok ($class->new($monster)->mantissa(), + '123456789012345678901234567890123456789'); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +############################################################################### +# bone/binf etc as plain calls (Lite failed them) + +ok ($class->fzero(),0); +ok ($class->fone(),1); +ok ($class->fone('+'),1); +ok ($class->fone('-'),-1); +ok ($class->fnan(),'NaN'); +ok ($class->finf(),'inf'); +ok ($class->finf('+'),'inf'); +ok ($class->finf('-'),'-inf'); +ok ($class->finf('-inf'),'-inf'); + +$class->accuracy(undef); $class->precision(undef); # reset + +############################################################################### +# bug in bsstr()/numify() showed up in after-rounding in bdiv() + +$x = $class->new('0.008'); $y = $class->new(2); +$x->bdiv(3,$y); +ok ($x,'0.0027'); + +############################################################################### +# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() +# correctly modifies $x + + +$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); + +$class->precision(undef); +$x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); + +$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); + +{ + no strict 'refs'; + # A and P set => NaN + ${${class}.'::accuracy'} = 4; $x = $class->new(12); + $x->fsqrt(3); ok ($x,'NaN'); + # supplied arg overrides set global + $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); + $class->accuracy(undef); $class->precision(undef); # reset for further tests +} + +############################################################################# +# can we call objectify (broken until v1.52) + +{ + no strict; + $try = + '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);'; + $ans = eval $try; + ok ($ans,"$class 4 5"); +} + +############################################################################# +# is_one('-') (broken until v1.64) + +ok ($class->new(-1)->is_one(),0); +ok ($class->new(-1)->is_one('-'),1); + +############################################################################# +# bug 1/0.5 leaving 2e-0 instead of 2e0 + +ok ($class->new(1)->fdiv('0.5')->bsstr(),'2e+0'); + +############################################################################### +# [perl #30609] bug with $x -= $x not being 0, but 2*$x + +$x = $class->new(3); $x -= $x; ok ($x, 0); +$x = $class->new(-3); $x -= $x; ok ($x, 0); +$x = $class->new(3); $x += $x; ok ($x, 6); +$x = $class->new(-3); $x += $x; ok ($x, -6); + +$x = $class->new('NaN'); $x -= $x; ok ($x->is_nan(), 1); +$x = $class->new('inf'); $x -= $x; ok ($x->is_nan(), 1); +$x = $class->new('-inf'); $x -= $x; ok ($x->is_nan(), 1); + +$x = $class->new('NaN'); $x += $x; ok ($x->is_nan(), 1); +$x = $class->new('inf'); $x += $x; ok ($x->is_inf(), 1); +$x = $class->new('-inf'); $x += $x; ok ($x->is_inf('-'), 1); + +$x = $class->new('3.14'); $x -= $x; ok ($x, 0); +$x = $class->new('-3.14'); $x -= $x; ok ($x, 0); +$x = $class->new('3.14'); $x += $x; ok ($x, '6.28'); +$x = $class->new('-3.14'); $x += $x; ok ($x, '-6.28'); + +$x = $class->new('3.14'); $x *= $x; ok ($x, '9.8596'); +$x = $class->new('-3.14'); $x *= $x; ok ($x, '9.8596'); +$x = $class->new('3.14'); $x /= $x; ok ($x, '1'); +$x = $class->new('-3.14'); $x /= $x; ok ($x, '1'); +$x = $class->new('3.14'); $x %= $x; ok ($x, '0'); +$x = $class->new('-3.14'); $x %= $x; ok ($x, '0'); + +############################################################################### +# the following two were reported by "kenny" via hotmail.com: + +#perl -MMath::BigFloat -wle 'print Math::BigFloat->new(0)->bpow(".1")' +#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. + +$x = $class->new(0); $y = $class->new('0.1'); +ok ($x ** $y, 0, 'no warnings and zero result'); + +#perl -MMath::BigFloat -lwe 'print Math::BigFloat->new(".222222222222222222222222222222222222222222")->bceil()' +#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. + +$x = $class->new(".222222222222222222222222222222222222222222"); +ok ($x->bceil(), 1, 'no warnings and one as result'); + +############################################################################### +# test **=, <<=, >>= + +# ((2^148)-1)/17 +$x = $class->new(2); $x **= 148; $x++; $x->bdiv(17, 60)->bfloor(); $x->accuracy(undef); +ok ($x,"20988936657440586486151264256610222593863921"); +ok ($x->length(),length "20988936657440586486151264256610222593863921"); + +$x = $class->new('2'); +my $y = $class->new('18'); +ok ($x <<= $y, 2 << 18); +ok ($x, 2 << 18); +ok ($x >>= $y, 2); +ok ($x, 2); + +$x = $class->new('2'); +$y = $class->new('18.2'); +$x <<= $y; # 2 * (2 ** 18.2); + +ok ($x->copy()->bfround(-9), '602248.763144685'); +ok ($x >>= $y, 2); # 2 * (2 ** 18.2) / (2 ** 18.2) => 2 +ok ($x, 2); + +1; # all done + +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +__DATA__ +&bgcd +inf:12:NaN +-inf:12:NaN +12:inf:NaN +12:-inf:NaN +inf:inf:NaN +inf:-inf:NaN +-inf:-inf:NaN +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++0:+0:0 ++0:+1:1 ++1:+0:1 ++1:+1:1 ++2:+3:1 ++3:+2:1 +-3:+2:1 +-3:-2:1 +-144:-60:12 +144:-60:12 +144:60:12 +100:625:25 +4096:81:1 +1034:804:2 +27:90:56:1 +27:90:54:9 +&blcm +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++0:+0:NaN ++1:+0:0 ++0:+1:0 ++27:+90:270 ++1034:+804:415668 +$div_scale = 40; +&bnok ++inf:10:inf +NaN:NaN:NaN +NaN:1:NaN +1:NaN:NaN +1:1:1 +# k > n +1:2:0 +2:3:0 +# k < 0 +1:-2:0 +# 7 over 3 = 35 +7:3:35 +7:6:1 +100:90:17310309456440 +&flog +0::NaN +-1::NaN +-2::NaN +# base > 0, base != 1 +2:-1:NaN +2:0:NaN +2:1:NaN +# log(1) is always 1, regardless of $base +1::0 +1:1:0 +1:2:0 +2::0.6931471805599453094172321214581765680755 +2.718281828::0.9999999998311266953289851340574956564911 +$div_scale = 20; +2.718281828::0.99999999983112669533 +$div_scale = 15; +123::4.81218435537242 +10::2.30258509299405 +1000::6.90775527898214 +100::4.60517018598809 +2::0.693147180559945 +3.1415::1.14470039286086 +12345::9.42100640177928 +0.001::-6.90775527898214 +# bug until v1.71: +10:10:1 +100:100:1 +# reset for further tests +$div_scale = 40; +1::0 +&frsft +NaNfrsft:2:NaN +0:2:0 +1:1:0.5 +2:1:1 +4:1:2 +123:1:61.5 +32:3:4 +&flsft +NaNflsft:0:NaN +2:1:4 +4:3:32 +5:3:40 +1:2:4 +0:5:0 +&fnorm +1:1 +-0:0 +fnormNaN:NaN ++inf:inf +-inf:-inf +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 +.2E2:20 +1.E3:1000 +# some inputs that result in zero +0e0:0 ++0e0:0 ++0e+0:0 +-0e+0:0 +0e-0:0 +-0e-0:0 ++0e-0:0 +000:0 +00e2:0 +00e02:0 +000e002:0 +000e1230:0 +00e-3:0 +00e+3:0 +00e-03:0 +00e+03:0 +-000:0 +-00e2:0 +-00e02:0 +-000e002:0 +-000e1230:0 +-00e-3:0 +-00e+3:0 +-00e-03:0 +-00e+03:0 +&as_number +0:0 +1:1 +1.2:1 +2.345:2 +-2:-2 +-123.456:-123 +-200:-200 +# test for bug in brsft() not handling cases that return 0 +0.000641:0 +0.0006412:0 +0.00064123:0 +0.000641234:0 +0.0006412345:0 +0.00064123456:0 +0.000641234567:0 +0.0006412345678:0 +0.00064123456789:0 +0.1:0 +0.01:0 +0.001:0 +0.0001:0 +0.00001:0 +0.000001:0 +0.0000001:0 +0.00000001:0 +0.000000001:0 +0.0000000001:0 +0.00000000001:0 +0.12345:0 +0.123456:0 +0.1234567:0 +0.12345678:0 +0.123456789:0 +&finf +1:+:inf +2:-:-inf +3:abc:inf +&as_hex ++inf:inf +-inf:-inf +hexNaN:NaN +0:0x0 +5:0x5 +-5:-0x5 +&as_bin ++inf:inf +-inf:-inf +hexNaN:NaN +0:0b0 +5:0b101 +-5:-0b101 +&numify +# uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output +0:0e+1 ++1:1e+0 +1234:1234e+0 +NaN:NaN ++inf:inf +-inf:-inf +-5:-5e+0 +100:1e+2 +-100:-1e+2 +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +-abcfsstr:NaN +1234.567:1234567e-3 +123:123e+0 +-5:-5e+0 +-100:-1e+2 +&fstr ++inf:::inf +-inf:::-inf +abcfstr:::NaN +1234.567:9::1234.56700 +1234.567::-6:1234.567000 +12345:5::12345 +0.001234:6::0.00123400 +0.001234::-8:0.00123400 +0:4::0 +0::-4:0.0000 +&fnorm +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0e999:0 +0e-999:0 +-0e999:0 +-0e-999:0 +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:123.456 +0.01:0.01 +.002:0.002 ++.2:0.2 +-0.0003:-0.0003 +-.0000000004:-0.0000000004 +123456E2:12345600 +123456E-2:1234.56 +-123456E2:-12345600 +-123456E-2:-1234.56 +1e1:10 +2e-11:0.00000000002 +# excercise _split + .02e-1:0.002 + 000001:1 + -00001:-1 + -1:-1 + 000.01:0.01 + -000.0023:-0.0023 + 1.1e1:11 +-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 +&fpow +NaN:1:NaN +1:NaN:NaN +NaN:-1:NaN +-1:NaN:NaN +NaN:-21:NaN +-21:NaN:NaN +NaN:21:NaN +21:NaN:NaN +0:0:1 +0:1:0 +0:9:0 +0:-2:inf +2:2:4 +1:2:1 +1:3:1 +-1:2:1 +-1:3:-1 +123.456:2:15241.383936 +2:-2:0.25 +2:-3:0.125 +128:-2:0.00006103515625 +abc:123.456:NaN +123.456:abc:NaN ++inf:123.45:inf +-inf:123.45:-inf ++inf:-123.45:inf +-inf:-123.45:-inf +-2:2:4 +-2:3:-8 +-2:4:16 +-2:5:-32 +-3:2:9 +-3:3:-27 +-3:4:81 +-3:5:-243 +# 2 ** 0.5 == sqrt(2) +# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0) +2:0.5:1.41421356237309504880168872420969807857 +#2:0.2:1.148698354997035006798626946777927589444 +#6:1.5:14.6969384566990685891837044482353483518 +$div_scale = 20; +#62.5:12.5:26447206647554886213592.3959144 +$div_scale = 40; +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123.456789 +-123456.789:123456.789 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123.456789 +-123456.789:123456.789 +&fround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNfround:5:NaN ++10123456789:5:10123000000 +-10123456789:5:-10123000000 ++10123456789.123:5:10123000000 +-10123456789.123:5:-10123000000 ++10123456789:9:10123456700 +-10123456789:9:-10123456700 ++101234500:6:101234000 +-101234500:6:-101234000 +$round_mode = "zero" ++20123456789:5:20123000000 +-20123456789:5:-20123000000 ++20123456789.123:5:20123000000 +-20123456789.123:5:-20123000000 ++20123456789:9:20123456800 +-20123456789:9:-20123456800 ++201234500:6:201234000 +-201234500:6:-201234000 +$round_mode = "+inf" ++30123456789:5:30123000000 +-30123456789:5:-30123000000 ++30123456789.123:5:30123000000 +-30123456789.123:5:-30123000000 ++30123456789:9:30123456800 +-30123456789:9:-30123456800 ++301234500:6:301235000 +-301234500:6:-301234000 +$round_mode = "-inf" ++40123456789:5:40123000000 +-40123456789:5:-40123000000 ++40123456789.123:5:40123000000 +-40123456789.123:5:-40123000000 ++40123456789:9:40123456800 +-40123456789:9:-40123456800 ++401234500:6:401234000 +-401234500:6:-401235000 +$round_mode = "odd" ++50123456789:5:50123000000 +-50123456789:5:-50123000000 ++50123456789.123:5:50123000000 +-50123456789.123:5:-50123000000 ++50123456789:9:50123456800 +-50123456789:9:-50123456800 ++501234500:6:501235000 +-501234500:6:-501235000 +$round_mode = "even" ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601234000 +-601234500:6:-601234000 ++60123456789.0123:5:60123000000 +-60123456789.0123:5:-60123000000 +$round_mode = "common" ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:6:60123500000 +-60123456789:6:-60123500000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601235000 +-601234500:6:-601235000 ++601234400:6:601234000 +-601234400:6:-601234000 ++601234600:6:601235000 +-601234600:6:-601235000 ++601234300:6:601234000 ++60123456789.0123:5:60123000000 +-60123456789.0123:5:-60123000000 +&ffround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNffround:5:NaN ++1.23:-1:1.2 ++1.234:-1:1.2 ++1.2345:-1:1.2 ++1.23:-2:1.23 ++1.234:-2:1.23 ++1.2345:-2:1.23 ++1.23:-3:1.230 ++1.234:-3:1.234 ++1.2345:-3:1.234 +-1.23:-1:-1.2 ++1.27:-1:1.2 +-1.27:-1:-1.2 ++1.25:-1:1.2 +-1.25:-1:-1.2 ++1.35:-1:1.3 +-1.35:-1:-1.3 +-0.0061234567890:-1:0.0 +-0.0061:-1:0.0 +-0.00612:-1:0.0 +-0.00612:-2:0.00 +-0.006:-1:0.0 +-0.006:-2:0.00 +-0.0006:-2:0.00 +-0.0006:-3:0.000 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:0 +0.41:0:0 +$round_mode = "zero" ++2.23:-1:/2.2(?:0{5}\d+)? +-2.23:-1:/-2.2(?:0{5}\d+)? ++2.27:-1:/2.(?:3|29{5}\d+) +-2.27:-1:/-2.(?:3|29{5}\d+) ++2.25:-1:/2.2(?:0{5}\d+)? +-2.25:-1:/-2.2(?:0{5}\d+)? ++2.35:-1:/2.(?:3|29{5}\d+) +-2.35:-1:/-2.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "+inf" ++3.23:-1:/3.2(?:0{5}\d+)? +-3.23:-1:/-3.2(?:0{5}\d+)? ++3.27:-1:/3.(?:3|29{5}\d+) +-3.27:-1:/-3.(?:3|29{5}\d+) ++3.25:-1:/3.(?:3|29{5}\d+) +-3.25:-1:/-3.2(?:0{5}\d+)? ++3.35:-1:/3.(?:4|39{5}\d+) +-3.35:-1:/-3.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "-inf" ++4.23:-1:/4.2(?:0{5}\d+)? +-4.23:-1:/-4.2(?:0{5}\d+)? ++4.27:-1:/4.(?:3|29{5}\d+) +-4.27:-1:/-4.(?:3|29{5}\d+) ++4.25:-1:/4.2(?:0{5}\d+)? +-4.25:-1:/-4.(?:3|29{5}\d+) ++4.35:-1:/4.(?:3|29{5}\d+) +-4.35:-1:/-4.(?:4|39{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "odd" ++5.23:-1:/5.2(?:0{5}\d+)? +-5.23:-1:/-5.2(?:0{5}\d+)? ++5.27:-1:/5.(?:3|29{5}\d+) +-5.27:-1:/-5.(?:3|29{5}\d+) ++5.25:-1:/5.(?:3|29{5}\d+) +-5.25:-1:/-5.(?:3|29{5}\d+) ++5.35:-1:/5.(?:3|29{5}\d+) +-5.35:-1:/-5.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "even" ++6.23:-1:/6.2(?:0{5}\d+)? +-6.23:-1:/-6.2(?:0{5}\d+)? ++6.27:-1:/6.(?:3|29{5}\d+) +-6.27:-1:/-6.(?:3|29{5}\d+) ++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) +-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) ++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) +-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +0.01234567:-3:0.012 +0.01234567:-4:0.0123 +0.01234567:-5:0.01235 +0.01234567:-6:0.012346 +0.01234567:-7:0.0123457 +0.01234567:-8:0.01234567 +0.01234567:-9:0.012345670 +0.01234567:-12:0.012345670000 +&fcmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:-1 ++0:-1:1 ++1:+0:1 ++0:+1:-1 +-1:+1:-1 ++1:-1:1 +-1:-1:0 ++1:+1:0 +-1.1:0:-1 ++0:-1.1:1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:-1 +-12:-123:1 ++123:+124:-1 ++124:+123:1 +-123:-124:1 +-124:-123:-1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:1 +0:-0.1:1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:-1 +-0.1:0:-1 +0:0.0001234:-1 +0:-0.0001234:1 +0.0001234:0:1 +-0.0001234:0:-1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:-1 ++inf:5432112345:1 +-inf:-5432112345:-1 ++inf:-5432112345:1 +-inf:54321.12345:-1 ++inf:54321.12345:1 +-inf:-54321.12345:-1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&facmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:1 ++0:-1:-1 ++1:+0:1 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:-1:0 ++1:+1:0 +-1.1:0:1 ++0:-1.1:-1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:1 +-12:-123:-1 ++123:+124:-1 ++124:+123:1 +-123:-124:-1 +-124:-123:1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:-1 +0:-0.1:-1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:1 +-0.1:0:1 +0:0.0001234:-1 +0:-0.0001234:-1 +0.0001234:0:1 +-0.0001234:0:1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:1 ++inf:5432112345:1 +-inf:-5432112345:1 ++inf:-5432112345:1 +-inf:54321.12345:1 ++inf:54321.12345:1 +-inf:-54321.12345:1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 +5:inf:-1 +-1:inf:-1 +5:-inf:-1 +-1:-inf:-1 +# return undef ++inf:facmpNaN: +facmpNaN:inf: +-inf:facmpNaN: +facmpNaN:-inf: +&fdec +fdecNaN:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +1.23:0.23 +-1.23:-2.23 +100:99 +101:100 +-100:-101 +-99:-100 +-98:-99 +99:98 +&finc +fincNaN:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +1.23:2.23 +-1.23:-0.23 +100:101 +-100:-99 +-99:-98 +-101:-100 +99:100 +&fadd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:NaN +-inf:+inf:NaN ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +0.001234:0.0001234:0.0013574 +&fsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:NaN +-inf:-inf:NaN +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +&fmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +&fdiv-list +0:0:NaN,NaN +0:1:0,0 +9:4:2.25,1 +9:5:1.8,4 +# bug in v1.74 with bdiv in list context, when $y is 1 or -1 +2.1:-1:-2.1,0 +2.1:1:2.1,0 +-2.1:-1:2.1,0 +-2.1:1:-2.1,0 +&fdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:0.5 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:111111111.1111111111111111111111111111111 ++2000000000:+9:222222222.2222222222222222222222222222222 ++3000000000:+9:333333333.3333333333333333333333333333333 ++4000000000:+9:444444444.4444444444444444444444444444444 ++5000000000:+9:555555555.5555555555555555555555555555556 ++6000000000:+9:666666666.6666666666666666666666666666667 ++7000000000:+9:777777777.7777777777777777777777777777778 ++8000000000:+9:888888888.8888888888888888888888888888889 ++9000000000:+9:1000000000 ++35500000:+113:314159.2920353982300884955752212389380531 ++71000000:+226:314159.2920353982300884955752212389380531 ++106500000:+339:314159.2920353982300884955752212389380531 ++1000000000:+3:333333333.3333333333333333333333333333333 +2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 +123456:1:123456 +$div_scale = 20 ++1000000000:+9:111111111.11111111111 ++2000000000:+9:222222222.22222222222 ++3000000000:+9:333333333.33333333333 ++4000000000:+9:444444444.44444444444 ++5000000000:+9:555555555.55555555556 ++6000000000:+9:666666666.66666666667 ++7000000000:+9:777777777.77777777778 ++8000000000:+9:888888888.88888888889 ++9000000000:+9:1000000000 +1:10:0.1 +1:100:0.01 +1:1000:0.001 +1:10000:0.0001 +1:504:0.001984126984126984127 +2:1.987654321:1.0062111801179738436 +123456789.123456789123456789123456789:1:123456789.12345678912 +# the next two cases are the "old" behaviour, but are now (>v0.01) different +#+35500000:+113:314159.292035398230088 +#+71000000:+226:314159.292035398230088 ++35500000:+113:314159.29203539823009 ++71000000:+226:314159.29203539823009 ++106500000:+339:314159.29203539823009 ++1000000000:+3:333333333.33333333333 +$div_scale = 1 +# round to accuracy 1 after bdiv ++124:+3:40 +123456789.1234:1:100000000 +# reset scale for further tests +$div_scale = 40 +&fmod ++9:4:1 ++9:5:4 ++9000:56:40 ++56:9000:56 +# inf handling, see table in doc +0:inf:0 +0:-inf:0 +5:inf:5 +5:-inf:5 +-5:inf:-5 +-5:-inf:-5 +inf:5:0 +-inf:5:0 +inf:-5:0 +-inf:-5:0 +5:5:0 +-5:-5:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN +8:0:8 +inf:0:inf +# exceptions to reminder rule +-inf:0:-inf +-8:0:-8 +0:0:NaN +abc:abc:NaN +abc:1:abc:NaN +1:abc:NaN +0:0:NaN +0:1:0 +1:0:1 +0:-1:0 +-1:0:-1 +1:1:0 +-1:-1:0 +1:-1:0 +-1:1:0 +1:2:1 +2:1:0 +1000000000:9:1 +2000000000:9:2 +3000000000:9:3 +4000000000:9:4 +5000000000:9:5 +6000000000:9:6 +7000000000:9:7 +8000000000:9:8 +9000000000:9:0 +35500000:113:33 +71000000:226:66 +106500000:339:99 +1000000000:3:1 +10:5:0 +100:4:0 +1000:8:0 +10000:16:0 +999999999999:9:0 +999999999999:99:0 +999999999999:999:0 +999999999999:9999:0 +999999999999999:99999:0 +-9:+5:1 ++9:-5:-1 +-9:-5:-4 +-5:3:1 +-2:3:1 +4:3:1 +1:3:1 +-5:-3:-2 +-2:-3:-2 +4:-3:-2 +1:-3:-2 +4095:4095:0 +100041000510123:3:0 +152403346:12345:4321 +87654321:87654321:0 +# now some floating point tests +123:2.5:0.5 +1230:2.5:0 +123.4:2.5:0.9 +123e1:25:5 +-2.1:1:0.9 +2.1:1:0.1 +-2.1:-1:-0.1 +2.1:-1:-0.9 +-3:1:0 +3:1:0 +-3:-1:0 +3:-1:0 +&ffac +Nanfac:NaN +-1:NaN ++inf:inf +-inf:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 +&froot +# sqrt() ++0:2:0 ++1:2:1 +-1:2:NaN +# -$x ** (1/2) => -$y, but not in froot() +-123.456:2:NaN ++inf:2:inf +-inf:2:NaN +2:2:1.41421356237309504880168872420969807857 +-2:2:NaN +4:2:2 +9:2:3 +16:2:4 +100:2:10 +123.456:2:11.11107555549866648462149404118219234119 +15241.38393:2:123.4559999756998444766131352122991626468 +1.44:2:1.2 +12:2:3.464101615137754587054892683011744733886 +0.49:2:0.7 +0.0049:2:0.07 +# invalid ones +1:NaN:NaN +-1:NaN:NaN +0:NaN:NaN +-inf:NaN:NaN ++inf:NaN:NaN +NaN:0:NaN +NaN:2:NaN +NaN:inf:NaN +NaN:inf:NaN +12:-inf:NaN +12:inf:NaN ++0:0:NaN ++1:0:NaN +-1:0:NaN +-2:0:NaN +-123.45:0:NaN ++inf:0:NaN +12:1:12 +-12:1:NaN +8:-1:NaN +-8:-1:NaN +# cubic root +8:3:2 +-8:3:NaN +# fourths root +16:4:2 +81:4:3 +# see t/bigroot() for more tests +&fsqrt ++0:0 +-1:NaN +-2:NaN +-16:NaN +-123.45:NaN +nanfsqrt:NaN ++inf:inf +-inf:NaN +1:1 +2:1.41421356237309504880168872420969807857 +4:2 +9:3 +16:4 +100:10 +123.456:11.11107555549866648462149404118219234119 +15241.38393:123.4559999756998444766131352122991626468 +1.44:1.2 +# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 +1.44E10:120000 +2e10:141421.356237309504880168872420969807857 +144e20:120000000000 +# proved to be an endless loop under 7-9 +12:3.464101615137754587054892683011744733886 +0.49:0.7 +0.0049:0.07 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_positive +0:0 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&parts +0:0 1 +1:1 0 +123:123 0 +-123:-123 0 +-1200:-12 2 +NaNparts:NaN NaN ++inf:inf inf +-inf:-inf inf +&exponent +0:1 +1:0 +123:0 +-123:0 +-1200:2 ++inf:inf +-inf:inf +NaNexponent:NaN +&mantissa +0:0 +1:1 +123:123 +-123:-123 +-1200:-12 ++inf:inf +-inf:-inf +NaNmantissa:NaN +&length +123:3 +-123:3 +0:1 +1:1 +12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +0.12345:0 +0.123456:0 +0.1234567:0 +0.12345678:0 +0.123456789:0 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/dist/Math-BigRat/t/bigfltrt.t b/dist/Math-BigRat/t/bigfltrt.t new file mode 100644 index 0000000000..325e6fa77e --- /dev/null +++ b/dist/Math-BigRat/t/bigfltrt.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 1; + +BEGIN { + unshift @INC, 't'; +} + +use Math::BigRat::Test lib => 'Calc'; # test via this Subclass + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat::Test"; +$CL = "Math::BigInt::Calc"; + +pass(); + +# fails still too many tests +#require 't/bigfltpm.inc'; # all tests here for sharing diff --git a/dist/Math-BigRat/t/biglog.t b/dist/Math-BigRat/t/biglog.t new file mode 100644 index 0000000000..42e9ac8d64 --- /dev/null +++ b/dist/Math-BigRat/t/biglog.t @@ -0,0 +1,72 @@ +#!/usr/bin/perl -w + +# Test blog function (and bpow, since it uses blog), as well as bexp(). + +use strict; +use Test::More tests => 17; + +use Math::BigRat; + +my $cl = "Math::BigRat"; + +############################################################################# +# test log($n) + +# does not work yet +#is ($cl->new(2)->blog(), '0', "blog(2)"); +#is ($cl->new(288)->blog(), '5',"blog(288)"); +#is ($cl->new(2000)->blog(), '7', "blog(2000)"); + +############################################################################# +# test exp($n) + +is ($cl->new(1)->bexp()->as_int(), '2', "bexp(1)"); +is ($cl->new(2)->bexp()->as_int(), '7',"bexp(2)"); +is ($cl->new(3)->bexp()->as_int(), '20', "bexp(3)"); + +# rounding not implemented yet +#is ($cl->new(3)->bexp(10), '20', "bexp(3,10)"); + +# $x < 0 => NaN +ok ($cl->new(-2)->blog(), 'NaN'); +ok ($cl->new(-1)->blog(), 'NaN'); +ok ($cl->new(-10)->blog(), 'NaN'); +ok ($cl->new(-2,2)->blog(), 'NaN'); + +############################################################################# +# test bexp() with cached results + +is ($cl->new(1)->bexp(), + '90933395208605785401971970164779391644753259799242' . '/' . + '33452526613163807108170062053440751665152000000000', + 'bexp(1)'); +is ($cl->new(2)->bexp(1,40), $cl->new(1)->bexp(1,45)->bpow(2,40), 'bexp(2)'); + +is ($cl->new("12.5")->bexp(1,61), $cl->new(1)->bexp(1,65)->bpow(12.5,61), 'bexp(12.5)'); + +############################################################################# +# test bexp() with big values (non-cached) + +is ($cl->new(1)->bexp(1,100)->as_float(100), + '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427', + 'bexp(100)'); + +is ($cl->new("12.5")->bexp(1,91), $cl->new(1)->bexp(1,95)->bpow(12.5,91), + 'bexp(12.5) to 91 digits'); + +############################################################################# +# some integer results +is ($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32"); +is ($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32"); +is ($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65"); + +my $x = Math::BigInt->new( '777' ) ** 256; +my $base = Math::BigInt->new( '12345678901234' ); +is ($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); + +$x = Math::BigInt->new( '777' ) ** 777; +$base = Math::BigInt->new( '777' ); +is ($x->copy()->blog($base), 777, 'blog(777**777, 777)'); + +# all done +1; diff --git a/dist/Math-BigRat/t/bigrat.t b/dist/Math-BigRat/t/bigrat.t new file mode 100644 index 0000000000..b900ffa195 --- /dev/null +++ b/dist/Math-BigRat/t/bigrat.t @@ -0,0 +1,324 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 200; + +# basic testing of Math::BigRat + +use Math::BigRat; +use Math::BigInt; +use Math::BigFloat; + +# shortcuts +my $cr = 'Math::BigRat'; +my $mbi = 'Math::BigInt'; +my $mbf = 'Math::BigFloat'; + +my ($x,$y,$z); + +$x = Math::BigRat->new(1234); is ($x,1234); +isa_ok ($x, 'Math::BigRat'); +is ($x->isa('Math::BigFloat'), 0); +is ($x->isa('Math::BigInt'), 0); + +############################################################################## +# new and bnorm() + +foreach my $func (qw/new bnorm/) + { + $x = $cr->$func(1234); is ($x,1234); + + $x = $cr->$func('1234/1'); is ($x,1234); + $x = $cr->$func('1234/2'); is ($x,617); + + $x = $cr->$func('100/1.0'); is ($x,100); + $x = $cr->$func('10.0/1.0'); is ($x,10); + $x = $cr->$func('0.1/10'); is ($x,'1/100'); + $x = $cr->$func('0.1/0.1'); is ($x,'1'); + $x = $cr->$func('1e2/10'); is ($x,10); + $x = $cr->$func('5/1e2'); is ($x,'1/20'); + $x = $cr->$func('1e2/1e1'); is ($x,10); + $x = $cr->$func('1 / 3'); is ($x,'1/3'); + $x = $cr->$func('-1 / 3'); is ($x,'-1/3'); + $x = $cr->$func('NaN'); is ($x,'NaN'); + $x = $cr->$func('inf'); is ($x,'inf'); + $x = $cr->$func('-inf'); is ($x,'-inf'); + $x = $cr->$func('1/'); is ($x,'NaN'); + + $x = $cr->$func("0x7e"); is ($x,126); + + # input ala '1+1/3' isn't parsed ok yet + $x = $cr->$func('1+1/3'); is ($x,'NaN'); + + $x = $cr->$func('1/1.2'); is ($x,'5/6'); + $x = $cr->$func('1.3/1.2'); is ($x,'13/12'); + $x = $cr->$func('1.2/1'); is ($x,'6/5'); + + ############################################################################ + # other classes as input + + $x = $cr->$func($mbi->new(1231)); is ($x,'1231'); + $x = $cr->$func($mbf->new(1232)); is ($x,'1232'); + $x = $cr->$func($mbf->new(1232.3)); is ($x,'12323/10'); + } + +my $n = 'numerator'; +my $d = 'denominator'; + +$x = $cr->new('-0'); is ($x,'0'); is ($x->$n(), '0'); is ($x->$d(),'1'); +$x = $cr->new('NaN'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); +$x = $cr->new('-NaN'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); +$x = $cr->new('-1r4'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); + +$x = $cr->new('+inf'); is ($x,'inf'); is ($x->$n(), 'inf'); is ($x->$d(),'1'); +$x = $cr->new('-inf'); is ($x,'-inf'); is ($x->$n(), '-inf'); is ($x->$d(),'1'); +$x = $cr->new('123a4'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); + +# wrong inputs +$x = $cr->new('1e2e2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); +$x = $cr->new('1+2+2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); +# failed due to BigFloat bug +$x = $cr->new('1.2.2'); is ($x,'NaN'); is ($x->$n(), 'NaN'); is ($x->$d(),'NaN'); + +is ($cr->new('123a4'),'NaN'); +is ($cr->new('123e4'),'1230000'); +is ($cr->new('-NaN'),'NaN'); +is ($cr->new('NaN'),'NaN'); +is ($cr->new('+inf'),'inf'); +is ($cr->new('-inf'),'-inf'); + +############################################################################## +# two Bigints + +is ($cr->new($mbi->new(3),$mbi->new(7))->badd(1),'10/7'); +is ($cr->new($mbi->new(-13),$mbi->new(7)),'-13/7'); +is ($cr->new($mbi->new(13),$mbi->new(-7)),'-13/7'); +is ($cr->new($mbi->new(-13),$mbi->new(-7)),'13/7'); + +############################################################################## +# mixed arguments + +is ($cr->new('3/7')->badd(1),'10/7'); +is ($cr->new('3/10')->badd(1.1),'7/5'); +is ($cr->new('3/7')->badd($mbi->new(1)),'10/7'); +is ($cr->new('3/10')->badd($mbf->new('1.1')),'7/5'); + +is ($cr->new('3/7')->bsub(1),'-4/7'); +is ($cr->new('3/10')->bsub(1.1),'-4/5'); +is ($cr->new('3/7')->bsub($mbi->new(1)),'-4/7'); +is ($cr->new('3/10')->bsub($mbf->new('1.1')),'-4/5'); + +is ($cr->new('3/7')->bmul(1),'3/7'); +is ($cr->new('3/10')->bmul(1.1),'33/100'); +is ($cr->new('3/7')->bmul($mbi->new(1)),'3/7'); +is ($cr->new('3/10')->bmul($mbf->new('1.1')),'33/100'); + +is ($cr->new('3/7')->bdiv(1),'3/7'); +is ($cr->new('3/10')->bdiv(1.1),'3/11'); +is ($cr->new('3/7')->bdiv($mbi->new(1)),'3/7'); +is ($cr->new('3/10')->bdiv($mbf->new('1.1')),'3/11'); + +############################################################################## +$x = $cr->new('1/4'); $y = $cr->new('1/3'); + +is ($x + $y, '7/12'); +is ($x * $y, '1/12'); +is ($x / $y, '3/4'); + +$x = $cr->new('7/5'); $x *= '3/2'; +is ($x,'21/10'); +$x -= '0.1'; +is ($x,'2'); # not 21/10 + +$x = $cr->new('2/3'); $y = $cr->new('3/2'); +is ($x > $y,''); +is ($x < $y,1); +is ($x == $y,''); + +$x = $cr->new('-2/3'); $y = $cr->new('3/2'); +is ($x > $y,''); +is ($x < $y,'1'); +is ($x == $y,''); + +$x = $cr->new('-2/3'); $y = $cr->new('-2/3'); +is ($x > $y,''); +is ($x < $y,''); +is ($x == $y,'1'); + +$x = $cr->new('-2/3'); $y = $cr->new('-1/3'); +is ($x > $y,''); +is ($x < $y,'1'); +is ($x == $y,''); + +$x = $cr->new('-124'); $y = $cr->new('-122'); +is ($x->bacmp($y),1); + +$x = $cr->new('-124'); $y = $cr->new('-122'); +is ($x->bcmp($y),-1); + +$x = $cr->new('3/7'); $y = $cr->new('5/7'); +is ($x+$y,'8/7'); + +$x = $cr->new('3/7'); $y = $cr->new('5/7'); +is ($x*$y,'15/49'); + +$x = $cr->new('3/5'); $y = $cr->new('5/7'); +is ($x*$y,'3/7'); + +$x = $cr->new('3/5'); $y = $cr->new('5/7'); +is ($x/$y,'21/25'); + +$x = $cr->new('7/4'); $y = $cr->new('1'); +is ($x % $y,'3/4'); + +$x = $cr->new('7/4'); $y = $cr->new('5/13'); +is ($x % $y,'11/52'); + +$x = $cr->new('7/4'); $y = $cr->new('5/9'); +is ($x % $y,'1/12'); + +$x = $cr->new('-144/9')->bsqrt(); is ($x,'NaN'); +$x = $cr->new('144/9')->bsqrt(); is ($x,'4'); +$x = $cr->new('3/4')->bsqrt(); is ($x, + '1732050807568877293527446341505872366943/' + .'2000000000000000000000000000000000000000'); + +############################################################################## +# bpow + +$x = $cr->new('2/1'); $z = $x->bpow('3/1'); is ($x,'8'); +$x = $cr->new('1/2'); $z = $x->bpow('3/1'); is ($x,'1/8'); +$x = $cr->new('1/3'); $z = $x->bpow('4/1'); is ($x,'1/81'); +$x = $cr->new('2/3'); $z = $x->bpow('4/1'); is ($x,'16/81'); + +$x = $cr->new('2/3'); $z = $x->bpow('5/3'); +is ($x, '31797617848703662994667839220546583581/62500000000000000000000000000000000000'); + +############################################################################## +# bfac + +$x = $cr->new('1'); $x->bfac(); is ($x,'1'); +for (my $i = 0; $i < 8; $i++) + { + $x = $cr->new("$i/1")->bfac(); is ($x,$mbi->new($i)->bfac()); + } + +# test for $self->bnan() vs. $x->bnan(); +$x = $cr->new('-1'); $x->bfac(); is ($x,'NaN'); + +############################################################################## +# binc/bdec + +$x = $cr->new('3/2'); is ($x->binc(),'5/2'); +$x = $cr->new('15/6'); is ($x->bdec(),'3/2'); + +############################################################################## +# bfloor/bceil + +$x = $cr->new('-7/7'); is ($x->$n(), '-1'); is ($x->$d(), '1'); +$x = $cr->new('-7/7')->bfloor(); is ($x->$n(), '-1'); is ($x->$d(), '1'); + +############################################################################## +# bsstr + +$x = $cr->new('7/5')->bsstr(); is ($x,'7/5'); +$x = $cr->new('-7/5')->bsstr(); is ($x,'-7/5'); + +############################################################################## +# numify() + +my @array = qw/1 2 3 4 5 6 7 8 9/; +$x = $cr->new('8/8'); is ($array[$x],2); +$x = $cr->new('16/8'); is ($array[$x],3); +$x = $cr->new('17/8'); is ($array[$x],3); +$x = $cr->new('33/8'); is ($array[$x],5); +$x = $cr->new('-33/8'); is ($array[$x],6); +$x = $cr->new('-8/1'); is ($array[$x],2); # -8 => 2 + +$x = $cr->new('33/8'); is ($x->numify() * 1000, 4125); +$x = $cr->new('-33/8'); is ($x->numify() * 1000, -4125); +$x = $cr->new('inf'); is ($x->numify(), 'inf'); +$x = $cr->new('-inf'); is ($x->numify(), '-inf'); +$x = $cr->new('NaN'); is ($x->numify(), 'NaN'); + +$x = $cr->new('4/3'); is ($x->numify(), 4/3); + +############################################################################## +# as_hex(), as_bin(), as_oct() + +$x = $cr->new('8/8'); +is ($x->as_hex(), '0x1'); is ($x->as_bin(), '0b1'); is ($x->as_oct(), '01'); +$x = $cr->new('80/8'); +is ($x->as_hex(), '0xa'); is ($x->as_bin(), '0b1010'); is ($x->as_oct(), '012'); + +############################################################################## +# broot(), blog(), bmodpow() and bmodinv() + +$x = $cr->new(2) ** 32; +$y = $cr->new(4); +$z = $cr->new(3); + +is ($x->copy()->broot($y), 2 ** 8); +is (ref($x->copy()->broot($y)), $cr); + +is ($x->copy()->bmodpow($y,$z), 1); +is (ref($x->copy()->bmodpow($y,$z)), $cr); + +$x = $cr->new(8); +$y = $cr->new(5033); +$z = $cr->new(4404); + +is ($x->copy()->bmodinv($y), $z); +is (ref($x->copy()->bmodinv($y)), $cr); + +# square root with exact result +$x = $cr->new('1.44'); +is ($x->copy()->broot(2), '6/5'); +is (ref($x->copy()->broot(2)), $cr); + +# log with exact result +$x = $cr->new('256.1'); +is ($x->copy()->blog(2), '8000563442710106079310294693803606983661/1000000000000000000000000000000000000000'); +is (ref($x->copy()->blog(2)), $cr); + +$x = $cr->new(144); +is ($x->copy()->broot('2'), 12, 'v/144 = 12'); + +$x = $cr->new(12*12*12); +is ($x->copy()->broot('3'), 12, '(12*12*12) ** 1/3 = 12'); + +############################################################################## +# from_hex(), from_bin(), from_oct() + +$x = Math::BigRat->from_hex('0x100'); +is ($x, '256', 'from_hex'); +$x = $cr->from_hex('0x100'); +is ($x, '256', 'from_hex'); + +$x = Math::BigRat->from_bin('0b100'); +is ($x, '4', 'from_bin'); +$x = $cr->from_bin('0b100'); +is ($x, '4', 'from_bin'); + +$x = Math::BigRat->from_oct('0100'); +is ($x, '64', 'from_oct'); +$x = $cr->from_oct('0100'); +is ($x, '64', 'from_oct'); + +############################################################################## +# as_float() + +$x = Math::BigRat->new('1/2'); my $f = $x->as_float(); + +is ($x, '1/2', '$x unmodified'); +is ($f, '0.5', 'as_float(0.5)'); + +$x = Math::BigRat->new('2/3'); $f = $x->as_float(5); + +is ($x, '2/3', '$x unmodified'); +is ($f, '0.66667', 'as_float(2/3,5)'); + +############################################################################## +# done + +1; diff --git a/dist/Math-BigRat/t/bigratpm.inc b/dist/Math-BigRat/t/bigratpm.inc new file mode 100644 index 0000000000..13ec6240d8 --- /dev/null +++ b/dist/Math-BigRat/t/bigratpm.inc @@ -0,0 +1,905 @@ +#include this file into another test for subclass testing... + +is ($class->config()->{lib},$CL); + +$setup = ''; + +while () + { + chomp; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "bnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + my $a = $args[1] || ''; + $try .= "\$x->binf('$a');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "numerator") { + # ->bstr() to see if an object is returned + $try .= '$x->numerator()->bstr();'; + } elsif ($f eq "denominator") { + # ->bstr() to see if an object is returned + $try .= '$x->denominator()->bstr();'; + } elsif ($f =~ /^(length|numify)$/) { + $try .= "\$x->$f();"; + # some unary ops (can't test the fxxx form, since no AUTOLOAD in BigRat) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|pos|neg|negative|positive|odd|even|nan|int)\z/) { + $try .= "\$x->$f();"; + } elsif ($f =~ /^(as_number|as_int)\z/){ + $try .= "\$x->$1();"; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + } elsif ($f eq "digit") { + $try .= "\$x->digit($args[1]);"; + } elsif ($f eq "fround") { + $try .= "$setup; \$x->bround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->bfround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->bsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->blog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->bfac();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "bcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "bacmp") { + $try .= '$x->bacmp($y);'; + } elsif ($f eq "bpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "fpow") { + $try .= '$x->bpow($y);'; + } elsif ($f eq "badd") { + $try .= '$x + $y;'; + } elsif ($f eq "bsub") { + $try .= '$x - $y;'; + } elsif ($f eq "bmul") { + $try .= '$x * $y;'; + } elsif ($f eq "bdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->bdiv(\$y));"; + } elsif ($f eq "brsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "blsft") { + $try .= '$x << $y;'; + } elsif ($f eq "bmod") { + $try .= '$x % $y;'; + } elsif( $f eq "bmodinv") { + $try .= "\$x->bmodinv(\$y);"; + } elsif( $f eq "blog") { + $try .= "\$x->blog(\$y);"; + } else { + $try .= "\$z = $class->new(\"$args[2]\");"; + + # Functions with three arguments + if( $f eq "bmodpow") { + $try .= "\$x->bmodpow(\$y,\$z);"; + } else { warn "Unknown op '$f'"; } + } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + like ($ans1, qr/$pat/); + } + else + { + if ($ans eq "") + { + is ($ans1, undef); + } + else + { + is ($ans1, $ans) or diag("Tried: '$try'"); +# if (ref($ans1) eq "$class") +# { +# # float numbers are normalized (for now), so mantissa shouldn't have +# # trailing zeros +# #print $ans1->_trailing_zeros(),"\n"; +# print "# Has trailing zeros after '$try'\n" +# if !is ($ans1->{_m}->_trailing_zeros(), 0); +# } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +is ($y,1200); is ($x,1200); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->bzero(); is ($x->{_a}, undef); is ($x->{_p}, undef); +$x = $class->new(2); $x->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef); +$x = $class->new(2); $x->bone(); is ($x->{_a}, undef); is ($x->{_p}, undef); +$x = $class->new(2); $x->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef); + +__DATA__ +&digit +123:2:1 +1234:0:4 +1234:1:3 +1234:2:2 +1234:3:1 +1234:-1:1 +1234:-2:2 +1234:-3:3 +1234:-4:4 +0:0:0 +0:1:0 +&bmodinv +# format: number:modulus:result +# bmodinv Data errors +abc:abc:NaN +abc:5:NaN +5:abc:NaN +# bmodinv Expected Results from normal use +1:5:1 +3:5:2 +-2:5:2 +8:5033:4404 +1234567891:13:6 +-1234567891:13:7 +324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902 +## bmodinv Error cases / useless use of function +3:-5:NaN +inf:5:NaN +5:inf:NaN +-inf:5:NaN +5:-inf:NaN +&as_number +144/7:20 +12/1:12 +-12/1:-12 +-12/3:-4 +NaN:NaN ++inf:inf +-inf:-inf +&as_int +144/7:20 +12/1:12 +-12/1:-12 +-12/3:-4 +NaN:NaN ++inf:inf +-inf:-inf +&bmodpow +# format: number:exponent:modulus:result +# bmodpow Data errors +abc:abc:abc:NaN +5:abc:abc:NaN +abc:5:abc:NaN +abc:abc:5:NaN +5:5:abc:NaN +5:abc:5:NaN +abc:5:5:NaN +# bmodpow Expected results +0:0:2:1 +1:0:2:1 +0:0:1:0 +8:7:5032:3840 +8:-1:5033:4404 +98436739867439843769485798542749827593285729587325:43698764986460981048259837659386739857456983759328457:6943857329857295827698367:3104744730915914415259518 +# bmodpow Error cases +8:8:-5:NaN +8:-1:16:NaN +inf:5:13:NaN +5:inf:13:NaN +&bmod +NaN:1:NaN +1:NaN:NaN +1:1:0 +2:2:0 +12:6:0 +7/4:4/14:1/28 +7/4:4/16:0 +-7/4:4/16:0 +-7/4:-4/16:0 +7/4:-4/16:0 +7/4:4/32:0 +-7/4:4/32:0 +-7/4:-4/32:0 +7/4:-4/32:0 +7/4:4/28:1/28 +-7/4:4/28:-1/28 +7/4:-4/28:1/28 +-7/4:-4/28:-1/28 +&fsqrt +1:1 +0:0 +NaN:NaN ++inf:inf +-inf:NaN +144:12 +# sqrt(144) / sqrt(4) = 12/2 = 6/1 +144/4:6 +25/16:5/4 +-3:NaN +&flog +NaN:NaN +0:NaN +-2:NaN +&blog +NaN:NaN:NaN +0:NaN:NaN +NaN:0:NaN +NaN:1:NaN +1:NaN:NaN +0:2:NaN +0:-2:NaN +3:-2:NaN +&finf +1:+:inf +2:-:-inf +3:abc:inf +&numify +0:0 ++1:1 +1234:1234 +3/4:0.75 +5/2:2.5 +3/2:1.5 +5/4:1.25 +NaN:NaN ++inf:inf +-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1:1/1 +3/1:3/1 +0.1:1/10 +&bnorm +1:1 +-0:0 +bnormNaN:NaN ++inf:inf +-inf:-inf +inf/inf:NaN +5/inf:0 +5/-inf:0 +inf/5:inf +-inf/5:-inf +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 +.2E2:20 +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 ++00000800/00000010:80 +-00000800/00000010:-80 ++00000800/-00000010:-80 +-00000800/-00000010:80 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:15432/125 +0.01:1/100 +.002:1/500 ++.2:1/5 +-0.0003:-3/10000 +-.0000000004:-1/2500000000 +123456E2:12345600 +123456E-2:30864/25 +-123456E2:-12345600 +-123456E-2:-30864/25 +1e1:10 +2e-11:1/50000000000 +12/10:6/5 +0.1/0.1:1 +100/0.1:1000 +0.1/10:1/100 +1 / 3:1/3 +1/ 3:1/3 +1 /3:1/3 +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123456789/1000000 +-123456.789:123456789/1000 +123/7:-123/7 +-123/7:123/7 +123/-7:123/7 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123456789/1000000 +-123456.789:123456789/1000 +&badd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:NaN +-inf:+inf:NaN ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +1/3:1/3:2/3 +2/3:-1/3:1/3 +&bsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:NaN +-inf:-inf:NaN +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +2/3:1/3:1/3 +7/27:3/54:11/54 +-2/3:+2/3:-4/3 +-2/3:-2/3:0 +0:-123:123 +0:123:-123 +&bmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +1/4:1/3:1/12 +&bdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:1/2 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:1000000000/9 ++2000000000:+9:2000000000/9 ++3000000000:+9:1000000000/3 ++4000000000:+9:4000000000/9 ++5000000000:+9:5000000000/9 ++6000000000:+9:2000000000/3 ++7000000000:+9:7000000000/9 ++8000000000:+9:8000000000/9 ++9000000000:+9:1000000000 ++35500000:+113:35500000/113 ++71000000:+226:35500000/113 ++106500000:+339:35500000/113 ++1000000000:+3:1000000000/3 +2:25.024996000799840031993601279744051189762:1000000000000000000000000000000000000000/12512498000399920015996800639872025594881 +123456:1:123456 +1/4:1/3:3/4 +# reset scale for further tests +$div_scale = 40 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +1/3:0 +3/1:1 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_pos +0:0 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_positive +0:0 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_neg +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&parts +0:0 1 +1:1 1 +123:123 1 +-123:-123 1 +-1200:-1200 1 +5/7:5 7 +-5/7:-5 7 +NaNparts:NaN NaN ++inf:inf inf +-inf:-inf inf +&length +123:3 +-123:3 +0:1 +1:1 +12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +0/3:1 +1/3:0 +-0/3:1 +5/inf:1 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +1/3:0 +100/100:1 +0.1/0.1:1 +5/inf:0 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +3/7:0 +6/7:0 +7/7:1 +8/7:1 +13/7:1 +14/7:2 +15/7:2 +-3/7:-1 +-6/7:-1 +-7/1:-7 +-8/7:-2 +-13/7:-2 +-14/7:-2 +-15/7:-3 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 +3/7:1 +6/7:1 +8/7:2 +13/7:2 +14/7:2 +15/7:3 +-3/7:0 +-6/7:0 +-8/7:-1 +-13/7:-1 +-14/7:-2 +-15/7:-2 +&ffac +NaN:NaN +1:1 +-1:NaN +&bpow +# bpow test for overload of ** +2:2:4 +3:3:27 +&bacmp ++0:-0:0 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:+2:-1 ++2:-1:1 +-123456789:+987654321:-1 ++123456789:-987654321:-1 ++987654321:+123456789:1 +-987654321:+123456789:1 +-123:+4567889:-1 +# NaNs +acmpNaN:123: +123:acmpNaN: +acmpNaN:acmpNaN: +# infinity ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 ++inf:123:1 +-inf:123:1 ++inf:-123:1 +-inf:-123:1 ++inf:1/23:1 +-inf:1/23:1 ++inf:-1/23:1 +-inf:-1/23:1 ++inf:12/3:1 +-inf:12/3:1 ++inf:-12/3:1 +-inf:-12/3:1 +123:inf:-1 +-123:inf:-1 +123:-inf:-1 +-123:-inf:-1 +1/23:inf:-1 +-1/23:inf:-1 +1/23:-inf:-1 +-1/23:-inf:-1 +12/3:inf:-1 +-12/3:inf:-1 +12/3:-inf:-1 +-12/3:-inf:-1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +1/3:2/3:-1 +2/3:1/3:1 +2/3:2/3:0 +&fpow +2/1:3/1:8 +3/1:3/1:27 +5/2:3/1:125/8 +-2/1:3/1:-8 +-3/1:3/1:-27 +-5/2:3/1:-125/8 +-2/1:4/1:16 +-3/1:4/1:81 +-5/2:4/1:625/16 +-5/2:-4/1:16/625 +1/5:-3:125 +-1/5:-3:-125 +&numerator +NaN:NaN +inf:inf +-inf:-inf +3/7:3 +-3/7:-3 +0:0 +1:1 +5/-3:-5 +&denominator +NaN:NaN +inf:1 +-inf:1 +3/7:7 +0:1 +1/1:1 +-1/1:1 +-3/7:7 +4/-5:5 +&finc +3/2:5/2 +-15/6:-3/2 +NaN:NaN +-1/3:2/3 +-2/7:5/7 +&fdec +15/6:3/2 +-3/2:-5/2 +1/3:-2/3 +2/7:-5/7 +NaN:NaN diff --git a/dist/Math-BigRat/t/bigratpm.t b/dist/Math-BigRat/t/bigratpm.t new file mode 100644 index 0000000000..d0a499ce4e --- /dev/null +++ b/dist/Math-BigRat/t/bigratpm.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 686; + +use Math::BigRat lib => 'Calc'; + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat"; +$CL = "Math::BigInt::Calc"; + +require 't/bigratpm.inc'; # all tests here for sharing diff --git a/dist/Math-BigRat/t/bigratup.t b/dist/Math-BigRat/t/bigratup.t new file mode 100644 index 0000000000..a00c655649 --- /dev/null +++ b/dist/Math-BigRat/t/bigratup.t @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w + +# Test whether $Math::BigInt::upgrade breaks our neck + +use strict; +use Test::More tests => 5; + +use Math::BigInt upgrade => 'Math::BigRat'; +use Math::BigRat; + +my $rat = 'Math::BigRat'; +my ($x,$y,$z); + +############################################################################## +# bceil/bfloor + +$x = $rat->new('49/4'); is ($x->bfloor(),'12', 'floor(49/4)'); +$x = $rat->new('49/4'); is ($x->bceil(),'13', 'ceil(49/4)'); + +############################################################################## +# bsqrt + +$x = $rat->new('144'); is ($x->bsqrt(),'12', 'bsqrt(144)'); +$x = $rat->new('144/16'); is ($x->bsqrt(),'3', 'bsqrt(144/16)'); +$x = $rat->new('1/3'); is ($x->bsqrt(), + '1000000000000000000000000000000000000000/1732050807568877293527446341505872366943', + 'bsqrt(1/3)'); + +# all tests successfull + +1; diff --git a/dist/Math-BigRat/t/bigroot.t b/dist/Math-BigRat/t/bigroot.t new file mode 100644 index 0000000000..24599482e1 --- /dev/null +++ b/dist/Math-BigRat/t/bigroot.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w + +# Test broot function (and bsqrt() function, since it is used by broot()). + +# It is too slow to be simple included in bigfltpm.inc, where it would get +# executed 3 times. + +# But it is better to test the numerical functionality, instead of not testing +# it at all. + +use strict; +use Test::More tests => 8 * 2; + +use Math::BigFloat; +use Math::BigInt; + +my $cl = "Math::BigFloat"; +my $c = "Math::BigInt"; + +# 2 ** 240 = +# 1766847064778384329583297500742918515827483896875618958121606201292619776 + +test_broot ('2','240', 8, undef, '1073741824'); +test_broot ('2','240', 9, undef, '106528681.3099908308759836475139583940127'); +test_broot ('2','120', 9, undef, '10321.27324073880096577298929482324664787'); +test_broot ('2','120', 17, undef, '133.3268493632747279600707813049418888729'); + +test_broot ('2','120', 8, undef, '32768'); +test_broot ('2','60', 8, undef, '181.0193359837561662466161566988413540569'); +test_broot ('2','60', 9, undef, '101.5936673259647663841091609134277286651'); +test_broot ('2','60', 17, undef, '11.54672461623965153271017217302844672562'); + +sub test_broot + { + my ($x,$n,$y,$scale,$result) = @_; + + my $s = $scale || 'undef'; + is ($cl->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $cl $x->bpow($n)->broot($y,$s) == $result"); + $result =~ s/\..*//; + is ($c->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $c $x->bpow($n)->broot($y,$s) == $result"); + } diff --git a/dist/Math-BigRat/t/hang.t b/dist/Math-BigRat/t/hang.t new file mode 100644 index 0000000000..b2b94a0011 --- /dev/null +++ b/dist/Math-BigRat/t/hang.t @@ -0,0 +1,18 @@ +#!/usr/bin/perl -w + +# test for bug #34584: hang in exp(1/2) + +use strict; +use Test::More tests => 1; + +use Math::BigRat; + +my $result = Math::BigRat->new('1/2')->bexp(); + +is ("$result", "9535900335500879457687887524133067574481/5783815921445270815783609372070483523265", + "exp(1/2) worked"); + +############################################################################## +# done + +1; diff --git a/dist/Math-BigRat/t/requirer.t b/dist/Math-BigRat/t/requirer.t new file mode 100644 index 0000000000..06ce1f4faa --- /dev/null +++ b/dist/Math-BigRat/t/requirer.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl -w + +# check that simple requiring BigRat works + +use strict; +use Test::More tests => 1; + +my ($x); + +require Math::BigRat; $x = Math::BigRat->new(1); ++$x; + +is ($x, 2, '$x got successfully modified'); + +# all tests done diff --git a/dist/Math-BigRat/t/trap.t b/dist/Math-BigRat/t/trap.t new file mode 100644 index 0000000000..2811524a18 --- /dev/null +++ b/dist/Math-BigRat/t/trap.t @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +# test that config ( trap_nan => 1, trap_inf => 1) really works/dies + +use strict; +use Test::More tests => 29; + +use Math::BigRat; + +my $mbi = 'Math::BigRat'; +my ($cfg,$x); + +foreach my $class ($mbi) + { + # can do and defaults are okay? + can_ok ($class, 'config'); + is ($class->config()->{trap_nan}, 0); + is ($class->config()->{trap_inf}, 0); + + # can set? + $cfg = $class->config( trap_nan => 1 ); is ($cfg->{trap_nan},1); + + # can set via hash ref? + $cfg = $class->config( { trap_nan => 1 } ); is ($cfg->{trap_nan},1); + + # also test that new() still works normally + eval ("\$x = \$class->new('42'); \$x->bnan();"); + like ($@, qr/^Tried to set/); + is ($x,42); # after new() never modified + + # can reset? + $cfg = $class->config( trap_nan => 0 ); is ($cfg->{trap_nan},0); + + # can set? + $cfg = $class->config( trap_inf => 1 ); is ($cfg->{trap_inf},1); + eval ("\$x = \$class->new('4711'); \$x->binf();"); + like ($@, qr/^Tried to set/); + is ($x,4711); # after new() never modified + + # +$x/0 => +inf + eval ("\$x = \$class->new('4711'); \$x->bdiv(0);"); + like ($@, qr/^Tried to set/); + is ($x,4711); # after new() never modified + + # -$x/0 => -inf + eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);"); + like ($@, qr/^Tried to set/); + is ($x,-815); # after new() never modified + + $cfg = $class->config( trap_nan => 1 ); + # 0/0 => NaN + eval ("\$x = \$class->new('0'); \$x->bdiv(0);"); + like ($@, qr/^Tried to set/); + is ($x,0); # after new() never modified + } + +############################################################################## +# BigRat + +$cfg = Math::BigRat->config( trap_nan => 1 ); + +for my $trap (qw/0.1a +inf inf -inf/) + { + my $x = Math::BigRat->new('7/4'); + + eval ("\$x = \$mbi->new('$trap');"); + is ($x,'7/4'); # never modified since it dies + eval ("\$x = \$mbi->new('$trap');"); + is ($x,'7/4'); # never modified since it dies + eval ("\$x = \$mbi->new('$trap/7');"); + is ($x,'7/4'); # never modified since it dies + } + +# all tests done -- cgit v1.2.1