lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc
lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc
+lib/Math/BigInt/t/bare_mif.t Rounding tests under BareCalc
lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t
lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works
lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.34';
+$VERSION = '1.35';
require 5.005;
use Exporter;
use File::Spec;
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# (BFLOAT or num_str, BFLOAT or num_str) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+
+ # 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} !~ /^[+-]$/))
{
# Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BFLOAT or num_str, BFLOAT or num_str) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+
+ # 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,@_);
+ }
# handle +-inf and NaN's
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
{
# add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
# return result as BFLOAT
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
# inf and NaN handling
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# (BigFloat or num_str, BigFloat or num_str) return BigFloat
# subtract second arg from first, modify first
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
if ($y->is_zero()) # still round for not adding zero
{
{
# simulate old behaviour
$params[1] = $self->div_scale(); # and round to it as accuracy
+ $params[0] = undef;
$scale = $params[1]+4; # at least four more for proper round
$params[3] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
return $x->bzero(@params) if $x->is_one();
return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
- #return $x->bone('+',@params) if $x->bcmp($base) == 0;
+ return $x->bone('+',@params) if $x->bcmp($base) == 0;
# when user set globals, they would interfere with our calculation, so
# disable then and later re-enable them
{
# multiply two numbers -- stolen from Knuth Vol 2 pg 233
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
{
# (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
# (BFLOAT,BFLOAT) (quo,rem) or BFLOAT (only rem)
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
sub bmod
{
# (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
my ($d,$re) = $self->SUPER::_div_inf($x,$y);
- return $re->round($a,$p,$r,$y);
+ $x->{sign} = $re->{sign};
+ $x->{_e} = $re->{_e};
+ $x->{_m} = $re->{_m};
+ return $x->round($a,$p,$r,$y);
}
return $x->bnan() if $x->is_zero() && $y->is_zero();
return $x if $y->is_zero();
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_e}->{sign} ne '+')); # digits after dot?
- return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+ return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
# use BigInt's bfac() for faster calc
$x->{_m}->blsft($x->{_e},10); # un-norm m
# compute power of two numbers, second arg is used as integer
# modifies first argument
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
return $x if $x->{sign} =~ /^[+-]inf$/;
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
return $x;
}
return $x if $x->{sign} !~ /^[+-]$/;
- # print "MBF bfround $x to scale $scale mode $mode\n";
# don't round if x already has lower precision
return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
$x->{_a} = undef; # and clear A
if ($scale < 0)
{
- # print "bfround scale $scale e $x->{_e}\n";
# round right from the '.'
- return $x if $x->{_e} >= 0; # nothing to round
+
+ return $x if $x->{_e}->{sign} eq '+'; # e >= 0 => nothing to round
+
$scale = -$scale; # positive for simplicity
my $len = $x->{_m}->length(); # length of mantissa
- my $dad = -$x->{_e}; # digits after dot
+
+ # the following poses a restriction on _e, but if _e is bigger than a
+ # scalar, you got other problems (memory etc) anyway
+ my $dad = -($x->{_e}->numify()); # digits after dot
my $zad = 0; # zeros after dot
- $zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style
+ $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style
+
#print "scale $scale dad $dad zad $zad len $len\n";
-
# number bsstr len zad dad
# 0.123 123e-3 3 0 3
# 0.0123 123e-4 3 1 4
$scale = $dbd+$scale;
}
}
- # print "round to $x->{_m} to $scale\n";
}
else
{
+ # round left from the '.'
+
# 123 => 100 means length(123) = 3 - $scale (2) => 1
my $dbt = $x->{_m}->length();
# digits before dot
- my $dbd = $dbt + $x->{_e};
+ my $dbd = $dbt + $x->{_e}->numify();
# should be the same, so treat it as this
$scale = 1 if $scale == 0;
# shortcut if already integer
{
$scale = $dbd - $scale;
}
-
}
- # print "using $scale for $x->{_m} with '$mode'\n";
# pass sign to bround for rounding modes '+inf' and '-inf'
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode);
# if $x has digits after dot
if ($x->{_e}->{sign} eq '-')
{
- #$x->{_m}->brsft(-$x->{_e},10);
- #$x->{_e}->bzero();
- #$x-- if $x->{sign} eq '-';
-
$x->{_e}->{sign} = '+'; # negate e
$x->{_m}->brsft($x->{_e},10); # cut off digits after dot
$x->{_e}->bzero(); # trunc/norm
sub brsft
{
- # shift right by $y (divide by power of 2)
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ # shift right by $y (divide by power of $n)
+
+ # set up parameters
+ my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ }
return $x if $x->modify('brsft');
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
- $x->bdiv($n ** $y,$a,$p,$r,$y);
+ $n = 2 if !defined $n; $n = $self->new($n);
+ $x->bdiv($n->bpow($y),$a,$p,$r,$y);
}
sub blsft
{
- # shift right by $y (divide by power of 2)
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ # shift left by $y (multiply by power of $n)
+
+ # set up parameters
+ my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+ }
- return $x if $x->modify('brsft');
+ return $x if $x->modify('blsft');
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
- $x->bmul($n ** $y,$a,$p,$r,$y);
+ $n = 2 if !defined $n; $n = $self->new($n);
+ $x->bmul($n->bpow($y),$a,$p,$r,$y);
}
###############################################################################
$x->length(); # number of digits (w/o sign and '.')
($l,$f) = $x->length(); # number of digits, and length of fraction
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set P $x to $n
+
+ Math::BigFloat->precision(); # get/set global P for all BigFloat objects
+ Math::BigFloat->accuracy(); # get/set global A for all BigFloat objects
+
=head1 DESCRIPTION
All operators (inlcuding basic math operations) are overloaded if you
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.59';
+$VERSION = '1.60';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
'<=>' => sub { $_[2] ?
ref($_[0])->bcmp($_[1],$_[0]) :
- ref($_[0])->bcmp($_[0],$_[1])},
+ $_[0]->bcmp($_[1])},
'cmp' => sub {
$_[2] ?
"$_[1]" cmp $_[0]->bstr() :
return $a; # shortcut
}
- if (ref($x))
- {
- # $object->accuracy() or fallback to global
- return $x->{_a} || ${"${class}::accuracy"};
- }
- return ${"${class}::accuracy"};
+ my $r;
+ # $object->accuracy() or fallback to global
+ $r = $x->{_a} if ref($x);
+ # but don't return global undef, when $x's accuracy is 0!
+ $r = ${"${class}::accuracy"} if !defined $r;
+ $r;
}
sub precision
return $p; # shortcut
}
- if (ref($x))
- {
- # $object->precision() or fallback to global
- return $x->{_p} || ${"${class}::precision"};
- }
- return ${"${class}::precision"};
+ my $r;
+ # $object->precision() or fallback to global
+ $r = $x->{_p} if ref($x);
+ # but don't return global undef, when $x's precision is 0!
+ $r = ${"${class}::precision"} if !defined $r;
+ $r;
}
sub config
$self->{sign} = '+';
if (@_ > 0)
{
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+ if (@_ > 3)
+ {
+ # call like: $x->bzero($a,$p,$r,$y);
+ ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
+ }
+ else
+ {
+ $self->{_a} = $_[0]
+ if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
+ $self->{_p} = $_[1]
+ if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
+ }
}
- return $self;
+ $self;
}
sub bone
my $self = shift;
my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
$self = $class if !defined $self;
-
+
if (!ref($self))
{
my $c = $self; $self = {}; bless $self, $c;
$self->{sign} = $sign;
if (@_ > 0)
{
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+ if (@_ > 3)
+ {
+ # call like: $x->bone($sign,$a,$p,$r,$y);
+ ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
+ }
+ else
+ {
+ $self->{_a} = $_[0]
+ if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
+ $self->{_p} = $_[1]
+ if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
+ }
}
- return $self;
+ $self;
}
##############################################################################
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT or num_str, BINT or num_str) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+
+ # 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} !~ /^[+-]$/))
{
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 = $x->is_zero();
- my $yz = $y->is_zero();
- 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
-
+ # have same sign, so compare absolute values. Don't make tests for zero here
+ # because it's actually slower than testin in Calc (especially w/ Pari et al)
+
# post-normalized compare for internal use (honors signs)
if ($x->{sign} eq '+')
{
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swaped (lib returns 0,1,-1)
}
sub bacmp
# Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
- my ($self,$x,$y) = objectify(2,@_);
+ # 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
{
# add second arg (BINT or string) to first (BINT) (modifies first)
# return result as BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('badd');
return $upgrade->badd($x,$y,@r) if defined $upgrade &&
$x->{sign} = $sx;
}
}
- $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub bsub
{
# (BINT or num_str, BINT or num_str) return num_str
# subtract second arg from first, modify first
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('bsub');
if ($y->is_zero())
{
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
$y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
if ($x->{sign} eq '+')
{
$x->{value} = $CALC->_inc($x->{value});
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
elsif ($x->{sign} eq '-')
{
$x->{value} = $CALC->_dec($x->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# inf, nan handling etc
$x->badd($self->__one(),$a,$p,$r); # badd does round
$x->{value} = $CALC->_inc($x->{value});
$x->{sign} = '-' if $zero; # 0 => 1 => -1
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# > 0
elsif ($x->{sign} eq '+')
{
$x->{value} = $CALC->_dec($x->{value});
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# inf, nan handling etc
$x->badd($self->__one('-'),$a,$p,$r); # badd does round
{
# multiply two numbers -- stolen from Knuth Vol 2 pg 233
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('bmul');
$x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
- $x->round(@r);
+
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub _div_inf
# x / +-inf => 0, remainder x (works even if x == 0)
if ($y->{sign} =~ /^[+-]inf$/)
{
- my $t = $x->copy(); # binf clobbers up $x
+ my $t = $x->copy(); # bzero clobbers up $x
return wantarray ? ($x->bzero(),$t) : $x->bzero()
}
{
# (dividend: BINT or num_str, divisor: BINT or num_str) return
# (BINT,BINT) (quo,rem) or BINT (only rem)
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('bdiv');
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
- #print "mbi bdiv $x $y\n";
return $upgrade->bdiv($upgrade->new($x),$y,@r)
if defined $upgrade && !$y->isa($self);
my $rem = $self->bzero();
($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
+ $rem->{_a} = $x->{_a};
+ $rem->{_p} = $x->{_p};
$x->round(@r);
if (! $CALC->_is_zero($rem->{value}))
{
{
$rem->{sign} = '+'; # dont leave -0
}
- $rem->round(@r);
- return ($x,$rem);
+ return ($x,$rem->round(@r));
}
$x->{value} = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $x->round(@r);
+
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
###############################################################################
{
# modulus (or remainder)
# (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('bmod');
$r[3] = $y; # no push!
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
{
my ($d,$r) = $self->_div_inf($x,$y);
- return $r->round(@r);
+ $x->{sign} = $r->{sign};
+ $x->{value} = $r->{value};
+ return $x->round(@r);
}
if ($CALC->can('_mod'))
$x->{sign} = $y->{sign};
if ($xsign ne $y->{sign})
{
- my $t = [ @{$x->{value}} ]; # copy $x
- $x->{value} = [ @{$y->{value}} ]; # copy $y to $x
+ my $t = $CALC->_copy($x->{value}); # copy $x
+ $x->{value} = $CALC->_copy($y->{value}); # copy $y to $x
$x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
}
}
{
$x->{sign} = '+'; # dont leave -0
}
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
# modify in place
# alogrithm. if the number is not relatively prime to the modulus
# (i.e. their gcd is not one) then NaN is returned.
- my ($self,$num,$mod,@r) = objectify(2,@_);
+ # 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 $num if $num->modify('bmodinv');
+ return $x if $x->modify('bmodinv');
- return $num->bnan()
- if ($mod->{sign} ne '+' # -, NaN, +inf, -inf
- || $num->is_zero() # or num == 0
- || $num->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
+ return $x->bnan()
+ if ($y->{sign} ne '+' # -, NaN, +inf, -inf
+ || $x->is_zero() # or num == 0
+ || $x->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
);
- # put least residue into $num if $num was negative, and thus make it positive
- $num->bmod($mod) if $num->{sign} eq '-';
+ # put least residue into $x if $x was negative, and thus make it positive
+ $x->bmod($y) if $x->{sign} eq '-';
if ($CALC->can('_modinv'))
{
- $num->{value} = $CALC->_modinv($num->{value},$mod->{value});
- $num->bnan() if !defined $num->{value} ; # in case there was no
- return $num;
+ $x->{value} = $CALC->_modinv($x->{value},$y->{value});
+ $x->bnan() if !defined $x->{value} ; # in case there was none
+ return $x;
}
my ($u, $u1) = ($self->bzero(), $self->bone());
- my ($a, $b) = ($mod->copy(), $num->copy());
+ my ($a, $b) = ($y->copy(), $x->copy());
# first step need always be done since $num (and thus $b) is never 0
# Note that the loop is aligned so that the check occurs between #2 and #1
# if the gcd is not 1, then return NaN! It would be pointless to
# have called bgcd to check this first, because we would then be performing
# the same Euclidean Algorithm *twice*
- return $num->bnan() unless $a->is_one();
+ return $x->bnan() unless $a->is_one();
- $u1->bmod($mod);
- $num->{value} = $u1->{value};
- $num->{sign} = $u1->{sign};
- $num;
+ $u1->bmod($y);
+ $x->{value} = $u1->{value};
+ $x->{sign} = $u1->{sign};
+ $x;
}
sub bmodpow
}
# in the trivial case,
- return $num->bzero() if $mod->is_one();
- return $num->bone() if $num->is_zero() or $num->is_one();
+ return $num->bzero(@r) if $mod->is_one();
+ return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
# $num->bmod($mod); # if $x is large, make it smaller first
my $acc = $num->copy(); # but this is not really faster...
# (BINT or num_str, BINT or num_str) return BINT
# compute factorial numbers
# modifies first argument
- my ($self,$x,@r) = objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bfac');
return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
- return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+ return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
if ($CALC->can('_fac'))
{
my $n = $x->copy();
$x->bone();
+ # seems we need not to temp. clear A/P of $x since the result is the same
my $f = $self->new(2);
while ($f->bacmp($n) < 0)
{
$x->bmul($f); $f->binc();
}
- $x->bmul($f); # last step
- $x->round(@r); # round
+ $x->bmul($f,@r); # last step and also round
}
sub bpow
# (BINT or num_str, BINT or num_str) return BINT
# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
# modifies first argument
- my ($self,$x,$y,@r) = objectify(2,@_);
+
+ # 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->modify('bpow');
$r[3] = $y; # no push!
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->bone('+',@r) if $y->is_zero();
return $x->round(@r) if $x->is_one() || $y->is_one();
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
if ($CALC->can('_pow'))
{
$x->{value} = $CALC->_pow($x->{value},$y->{value});
- return $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ return $x;
}
# based on the assumption that shifting in base 10 is fast, and that mul
# stripping them out of the multiplication, and add $count * $y zeros
# afterwards like this:
# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
-# creates deep recursion?
+# creates deep recursion since brsft/blsft use bpow sometimes.
# my $zeros = $x->_trailing_zeros();
# if ($zeros > 0)
# {
# $x->bpow($y); # recursion (will not branch into here again)
# $zeros = $y * $zeros; # real number of zeros to add
# $x->blsft($zeros,10);
-# return $x->round($a,$p,$r);
+# return $x->round(@r);
# }
my $pow2 = $self->__one();
$x->bmul($x);
}
$x->bmul($pow2);
- $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub blsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
-
+
+ # set up parameters
+ my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,@r) = objectify(2,@_);
+ }
+
return $x if $x->modify('blsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->round($a,$p,$r) if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
if (defined $t)
{
- $x->{value} = $t; return $x->round($a,$p,$r);
+ $x->{value} = $t; return $x->round(@r);
}
# fallback
- return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
+ return $x->bmul( $self->bpow($n, $y, @r), @r );
}
sub brsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
- my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$n,@r) = objectify(2,@_);
+ }
return $x if $x->modify('brsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->round($a,$p,$r) if $y->is_zero();
- return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
+ return $x->round(@r) if $y->is_zero();
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
# this only works for negative numbers when shifting in base 2
if (($x->{sign} eq '-') && ($n == 2))
{
- return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
+ return $x->round(@r) if $x->is_one('-'); # -1 => -1
if (!$y->is_one())
{
# although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
my $res = $self->new('0b'.$bin); # add prefix and convert back
$res->binc(); # remember to increment
$x->{value} = $res->{value}; # take over value
- return $x->round($a,$p,$r); # we are done now, magic, isn't?
+ return $x->round(@r); # we are done now, magic, isn't?
}
$x->bdec(); # n == 2, but $y == 1: this fixes it
}
if (defined $t)
{
$x->{value} = $t;
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
# fallback
- $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
+ $x->bdiv($self->bpow($n,$y, @r), @r);
$x;
}
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x & y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # 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->modify('band');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->bzero() if $y->is_zero() || $x->is_zero();
+ return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
my $sign = 0; # sign of result
$sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
if ($CALC->can('_and') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_and($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bior
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x | y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # 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->modify('bior');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
my $sign = 0; # sign of result
$sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
if ($CALC->can('_or') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_or($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bxor
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x ^ y
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ # 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->modify('bxor');
+ $r[3] = $y; # no push!
local $Math::BigInt::upgrade = undef;
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x if $y->is_zero();
+ return $x->round(@r) if $y->is_zero();
my $sign = 0; # sign of result
$sign = 1 if $x->{sign} ne $y->{sign};
if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_xor($x->{value},$y->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
my $m = $self->bone(); my ($xr,$yr);
$m->bmul($x10000);
}
$x->bneg() if $sign;
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub length
{
# return the nth decimal digit, negative values count backward, 0 is right
my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- $n = 0 if !defined $n;
- $CALC->_digit($x->{value},$n);
+ $CALC->_digit($x->{value},$n||0);
}
sub _trailing_zeros
# if not: since we do not know underlying internal representation:
my $es = "$x"; $es =~ /([0]*)$/;
return 0 if !defined $1; # no zeros
- return CORE::length("$1"); # as string, not as +0!
+ CORE::length("$1"); # as string, not as +0!
}
sub bsqrt
{
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bsqrt');
return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
- return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
- return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
+ return $x->round(@r) if $x->is_one(); # 1 => 1
- return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
+ return $upgrade->bsqrt($x,@r) if defined $upgrade;
if ($CALC->can('_sqrt'))
{
$x->{value} = $CALC->_sqrt($x->{value});
- return $x->round($a,$p,$r);
+ return $x->round(@r);
}
- return $x->bone($a,$p) if $x < 4; # 2,3 => 1
+ return $x->bone('+',@r) if $x < 4; # 2,3 => 1
my $y = $x->copy();
my $l = int($x->length()/2);
$x /= $two;
}
$x-- if $x * $x > $y; # overshot?
- $x->round($a,$p,$r);
+ $x->round(@r);
}
sub exponent
# that's inefficient
my $zeros = $m->_trailing_zeros();
$m->brsft($zeros,10) if $zeros != 0;
-# $m /= 10 ** $zeros if $zeros != 0;
$m;
}
# since we do not know underlying represention of $x, use decimal string
#my $r = substr ($$xs,-$follow);
my $r = substr ("$x",-$follow);
- return 1 if $r =~ /[^0]/; return 0;
+ return 1 if $r =~ /[^0]/;
+ 0;
}
sub fround
$pl++; $pl ++ if $pad >= $len;
$digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
- # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
-
# in case of 01234 we round down, for 6789 up, and only in case 5 we look
# closer at the remaining digits of the original $x, remember decision
my $round_up = 1; # default round up
);
my $put_back = 0; # not yet modified
- # old code, depend on internal representation
- # split mantissa at $pad and then pad with zeros
- #my $s5 = int($pad / 5);
- #my $i = 0;
- #while ($i < $s5)
- # {
- # $x->{value}->[$i++] = 0; # replace with 5 x 0
- # }
- #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
- #my $rem = $pad % 5; # so much left over
- #if ($rem > 0)
- # {
- # #print "remainder $rem\n";
- ## #print "elem $x->{value}->[$s5]\n";
- # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
- # }
- #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
- #print ${$CALC->_str($pad->{value})}," $len\n";
-
if (($pad > 0) && ($pad <= $len))
{
substr($$xs,-$pad,$pad) = '0' x $pad;
$pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
# we modify directly the string variant instead of creating a number and
- # adding it
+ # adding it, since that is faster (we already have the string)
my $c = 0; $pad ++; # for $pad == $len case
while ($pad <= $len)
{
}
$$xs = '1'.$$xs if $c == 0;
- # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
+ $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0)
{
# return integer less or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- # not needed: return $x if $x->modify('bfloor');
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
sub bceil
{
# return integer greater or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- # not needed: return $x if $x->modify('bceil');
- return $x->round($a,$p,$r);
+ $x->round(@r);
}
##############################################################################
my $self = shift;
my $x = $self->bone(); # $x->{value} = $CALC->_one();
$x->{sign} = shift || '+';
- return $x;
+ $x;
}
sub _swap
Math::BigInt->config(); # return hash containing configuration/version
+ # precision and accuracy (see section about rounding for more)
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set P $x to $n
+
+ Math::BigInt->precision(); # get/set global P for all BigInt objects
+ Math::BigInt->accuracy(); # get/set global A for all BigInt objects
+
=head1 DESCRIPTION
All operators (inlcuding basic math operations) are overloaded if you
my ($c,$cx,$cy) = @_;
- # fast comp based on array elements
+ # fast comp based on number of array elements (aka pseudo-length)
my $lxy = scalar @$cx - scalar @$cy;
return -1 if $lxy < 0; # already differs, ret
return 1 if $lxy > 0; # ditto
}
print "# INC = @INC\n";
- plan tests => 1599;
+ plan tests => 1627;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2368;
+ plan tests => 2392;
}
use Math::BigInt lib => 'BareCalc';
$class = "Math::BigInt";
$CL = "Math::BigInt::BareCalc";
-my $version = '1.54'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.60'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
--- /dev/null
+#!/usr/bin/perl -w
+
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes under BareCalc
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/bare_mif.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 617
+ + 1; # our onw tests
+ }
+
+print "# ",Math::BigInt->config()->{lib},"\n";
+
+use Math::BigInt lib => 'BareCalc';
+use Math::BigFloat lib => 'BareCalc';
+
+use vars qw/$mbi $mbf/;
+
+$mbi = 'Math::BigInt';
+$mbf = 'Math::BigFloat';
+
+ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+
+require 'mbimbf.inc';
+
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
+ok ($class->new($monster)->bsstr(),
+ '1e+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');
+
+###############################################################################
# zero,inf,one,nan
$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$ans = eval $try;
ok ($ans,"$class 4 5");
+###############################################################################
+# test whether an opp calls objectify properly or not (or at least does what
+# it should do given non-objects, w/ or w/o objectify())
+
+ok ($class->new(123)->badd(123),246);
+ok ($class->badd(123,321),444);
+ok ($class->badd(123,$class->new(321)),444);
+
+ok ($class->new(123)->bsub(122),1);
+ok ($class->bsub(321,123),198);
+ok ($class->bsub(321,$class->new(123)),198);
+
+ok ($class->new(123)->bmul(123),15129);
+ok ($class->bmul(123,123),15129);
+ok ($class->bmul(123,$class->new(123)),15129);
+
+ok ($class->new(15129)->bdiv(123),123);
+ok ($class->bdiv(15129,123),123);
+ok ($class->bdiv(15129,$class->new(123)),123);
+
+ok ($class->new(15131)->bmod(123),2);
+ok ($class->bmod(15131,123),2);
+ok ($class->bmod(15131,$class->new(123)),2);
+
+ok ($class->new(2)->bpow(16),65536);
+ok ($class->bpow(2,16),65536);
+ok ($class->bpow(2,$class->new(16)),65536);
+
+ok ($class->new(2**15)->brsft(1),2**14);
+ok ($class->brsft(2**15,1),2**14);
+ok ($class->brsft(2**15,$class->new(1)),2**14);
+
+ok ($class->new(2**13)->blsft(1),2**14);
+ok ($class->blsft(2**13,1),2**14);
+ok ($class->blsft(2**13,$class->new(1)),2**14);
+
1; # all done
###############################################################################
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 2; # own tests
}
###############################################################################
# bool
-$x = Math::BigInt->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
-$x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
+$x = $class->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
+$x = $class->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
###############################################################################
# objectify()
ok ($args[4],7); ok (ref($args[4]),'');
###############################################################################
+# test whether an opp calls objectify properly or not (or at least does what
+# it should do given non-objects, w/ or w/o objectify())
+
+ok ($class->new(123)->badd(123),246);
+ok ($class->badd(123,321),444);
+ok ($class->badd(123,$class->new(321)),444);
+
+ok ($class->new(123)->bsub(122),1);
+ok ($class->bsub(321,123),198);
+ok ($class->bsub(321,$class->new(123)),198);
+
+ok ($class->new(123)->bmul(123),15129);
+ok ($class->bmul(123,123),15129);
+ok ($class->bmul(123,$class->new(123)),15129);
+
+ok ($class->new(15129)->bdiv(123),123);
+ok ($class->bdiv(15129,123),123);
+ok ($class->bdiv(15129,$class->new(123)),123);
+
+ok ($class->new(15131)->bmod(123),2);
+ok ($class->bmod(15131,123),2);
+ok ($class->bmod(15131,$class->new(123)),2);
+
+ok ($class->new(2)->bpow(16),65536);
+ok ($class->bpow(2,16),65536);
+ok ($class->bpow(2,$class->new(16)),65536);
+
+ok ($class->new(2**15)->brsft(1),2**14);
+ok ($class->brsft(2**15,1),2**14);
+ok ($class->brsft(2**15,$class->new(1)),2**14);
+
+ok ($class->new(2**13)->blsft(1),2**14);
+ok ($class->blsft(2**13,1),2**14);
+ok ($class->blsft(2**13,$class->new(1)),2**14);
+
+###############################################################################
# test for floating-point input (other tests in bnorm() below)
$z = 1050000000000000; # may be int on systems with 64bit?
ok ($x,$y);
-###############################################################################
-# see if mul shortcut for small numbers works
-
-$x = '9' x $bl;
-$x = $class->new($x);
-# 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
-ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+ #############################################################################
+ # see if mul shortcut for small numbers works
- }
+ $x = '9' x $bl;
+ $x = $class->new($x);
+ # 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
+ ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+}
###############################################################################
# bug with rest "-0" in div, causing further div()s to fail
ok ($y,'0'); is_valid($y); # $y not '-0'
###############################################################################
-# bug in $x->bmod($y) if $x < 0 and $y > 0
+# bug in $x->bmod($y)
+# if $x < 0 and $y > 0
$x = $class->new('-629'); ok ($x->bmod(5033),4404);
###############################################################################
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2368;
+ plan tests => 2392;
}
use Math::BigInt;
BEGIN
{
- $| = 1; # 7 values 6 groups 4 oprators 2 classes
- plan tests => 7 * 6 * 4 * 2;
chdir 't' if -d 't';
unshift @INC, '../lib';
}
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/inf_nan.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ # values groups oprators classes tests
+ plan tests => 7 * 6 * 5 * 4 * 2 +
+ 7 * 6 * 2 * 4 * 1; # bmod
+ }
use Math::BigInt;
use Math::BigFloat;
+use Math::BigInt::Subclass;
+use Math::BigFloat::Subclass;
+
+my @classes =
+ qw/Math::BigInt Math::BigFloat
+ Math::BigInt::Subclass Math::BigFloat::Subclass
+ /;
my (@args,$x,$y,$z);
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] + $args[1] should be $args[2] but is $x\n",
- if !ok ($x->badd($y)->bstr(),$args[2]);
+ my $r = $x->badd($y);
+
+ print "# x $class $args[0] + $args[1] should be $args[2] but is $x\n",
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] + $args[1] should be $args[2] but is $r\n",
+ if !ok ($x->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] - $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bsub($y)->bstr(),$args[2]);
+ my $r = $x->bsub($y);
+
+ print "# x $class $args[0] - $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] - $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
$args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $class $args[0] * $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bmul($y)->bstr(),$args[2]);
+ my $r = $x->bmul($y);
+
+ print "# x $class $args[0] * $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] * $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
}
}
/)
{
@args = split /:/,$_;
- for my $class (qw/Math::BigInt Math::BigFloat/)
+ for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- print "# $class $args[0] / $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bdiv($y)->bstr(),$args[2]);
+
+ my $t = $x->copy();
+ my $tmod = $t->copy();
+
+ # bdiv in scalar context
+ my $r = $x->bdiv($y);
+ print "# x $class $args[0] / $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bstr(),$args[2]);
+ print "# r $class $args[0] / $args[1] should be $args[2] but is $r\n"
+ if !ok ($r->bstr(),$args[2]);
+
+ # bmod and bdiv in list context
+ my ($d,$rem) = $t->bdiv($y);
+
+ # bdiv in list context
+ print "# t $class $args[0] / $args[1] should be $args[2] but is $t\n"
+ if !ok ($t->bstr(),$args[2]);
+ print "# d $class $args[0] / $args[1] should be $args[2] but is $d\n"
+ if !ok ($d->bstr(),$args[2]);
+
+ # bmod
+ my $m = $tmod->bmod($y);
+
+ # bmod() agrees with bdiv?
+ print "# m $class $args[0] % $args[1] should be $rem but is $m\n"
+ if !ok ($m->bstr(),$rem->bstr());
+ # bmod() return agrees with set value?
+ print "# o $class $args[0] % $args[1] should be $m ($rem) but is $tmod\n"
+ if !ok ($tmod->bstr(),$m->bstr());
+
}
}
${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
-ok (Math::BigFloat->new('123.456'),'123.456');
+ok ($mbf->new('123.456'),'123.456');
${"$mbi\::accuracy"} = undef; # reset
###############################################################################
$x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); ok ($x,'123.4');
###############################################################################
+# test (also under Bare) that bfac() rounds at last step
+
+ok ($mbi->new(12)->bfac(),'479001600');
+ok ($mbi->new(12)->bfac(2),'480000000');
+$x = $mbi->new(12); $x->accuracy(2); ok ($x->bfac(),'480000000');
+$x = $mbi->new(13); $x->accuracy(2); ok ($x->bfac(),'6200000000');
+$x = $mbi->new(13); $x->accuracy(3); ok ($x->bfac(),'6230000000');
+$x = $mbi->new(13); $x->accuracy(4); ok ($x->bfac(),'6227000000');
+# this does 1,2,3...9,10,11,12...20
+$x = $mbi->new(20); $x->accuracy(1); ok ($x->bfac(),'2000000000000000000');
+
+###############################################################################
+# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
+$x = $mbi->new('123456')->bsqrt(2,undef); ok ($x,'350'); # not 351
+$x = $mbi->new('3')->bsqrt(2,undef); ok ($x->accuracy(),2);
+
+$mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf');
+ok ($x,'360'); # not 355 nor 350
+
+$x = $mbi->new('126025')->bsqrt(undef,2); ok ($x,'400'); # not 355
+
+
+###############################################################################
# test mixed arguments
$x = $mbf->new(10);
###############################################################################
# test whether bone/bzero take additional A & P, or reset it etc
-foreach my $class ($mbi,$mbf)
+foreach my $c ($mbi,$mbf)
{
- $x = $class->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ $x = $c->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
+ $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
+ $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
- $x = $class->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
+ $x = $c->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
+ $x = $c->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+ $x = $c->new(2); $x->bone('+',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bone('+',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
+ $x = $c->new(2); $x->bone('-',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bone('-',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
- $x = $class->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+ $x = $c->new(2); $x->bzero(2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
+ $x = $c->new(2); $x->bzero(undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
+ }
+
+###############################################################################
+# test whether bone/bzero honour globals
- $x = $class->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
- $x = $class->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+for my $c ($mbi,$mbf)
+ {
+ $c->accuracy(2);
+ $x = $c->bone(); ok ($x->accuracy(),2);
+ $x = $c->bzero(); ok ($x->accuracy(),2);
+ $c->accuracy(undef);
+
+ $c->precision(-2);
+ $x = $c->bone(); ok ($x->precision(),-2);
+ $x = $c->bzero(); ok ($x->precision(),-2);
+ $c->precision(undef);
}
###############################################################################
# new with set accuracy/precision and with parameters
-foreach my $class ($mbi,$mbf)
+foreach my $c ($mbi,$mbf)
{
- ok ($class->new(123,4,-3),'NaN'); # with parameters
- ${"$class\::accuracy"} = 42;
- ${"$class\::precision"} = 2;
- ok ($class->new(123),'NaN'); # with globals
- ${"$class\::accuracy"} = undef;
- ${"$class\::precision"} = undef;
+ ok ($c->new(123,4,-3),'NaN'); # with parameters
+ ${"$c\::accuracy"} = 42;
+ ${"$c\::precision"} = 2;
+ ok ($c->new(123),'NaN'); # with globals
+ ${"$c\::accuracy"} = undef;
+ ${"$c\::precision"} = undef;
}
# binary ops
# print "Check a=$a p=$p\n";
# print "# Tried: '$try'\n";
- ok ($x->{_a}, $a) && ok_undef ($x->{_p}) if $a ne '';
- ok ($x->{_p}, $p) && ok_undef ($x->{_a}) if $p ne '';
+ if ($a ne '')
+ {
+ if (!(ok ($x->{_a}, $a) && ok_undef ($x->{_p})))
+ {
+ print "# Check: A=$a and P=undef\n";
+ print "# Tried: '$try'\n";
+ }
+ }
+ if ($p ne '')
+ {
+ if (!(ok ($x->{_p}, $p) && ok_undef ($x->{_a})))
+ {
+ print "# Check: A=undef and P=$p\n";
+ print "# Tried: '$try'\n";
+ }
+ }
}
# all done
{
my $x = shift;
- ok (1,1) and return if !defined $x;
+ ok (1,1) and return 1 if !defined $x;
ok ($x,'undef');
print "# Called from ",join(' ',caller()),"\n";
+ return 0;
}
###############################################################################
1,,:123,4,:0
1,,:123,,-4:0
1,,-4:123,,:0
+&band
+1,,:3,,:1
+1234,1,:0,,:0
+1234,,:0,1,:0
+1234,,-1:0,,:0
+1234,,:0,,-1:0
+0xFF,,:0x10,,:0x0x10
+0xFF,2,:0xFF,,:250
+0xFF,,:0xFF,2,:250
+0xFF,,1:0xFF,,:250
+0xFF,,:0xFF,,1:250
+&bxor
+1,,:3,,:2
+1234,1,:0,,:1000
+1234,,:0,1,:1000
+1234,,3:0,,:1000
+1234,,:0,,3:1000
+0xFF,,:0x10,,:239
+# 250 ^ 255 => 5
+0xFF,2,:0xFF,,:5
+0xFF,,:0xFF,2,:5
+0xFF,,1:0xFF,,:5
+0xFF,,:0xFF,,1:5
+# 250 ^ 4095 = 3845 => 3800
+0xFF,2,:0xFFF,,:3800
+# 255 ^ 4100 = 4347 => 4300
+0xFF,,:0xFFF,2,:4300
+0xFF,,2:0xFFF,,:3800
+# 255 ^ 4100 = 10fb => 4347 => 4300
+0xFF,,:0xFFF,,2:4300
+&bior
+1,,:3,,:3
+1234,1,:0,,:1000
+1234,,:0,1,:1000
+1234,,3:0,,:1000
+1234,,:0,,3:1000
+0xFF,,:0x10,,:0x0xFF
+# FF | FA = FF => 250
+250,2,:0xFF,,:250
+0xFF,,:250,2,:250
+0xFF,,1:0xFF,,:250
+0xFF,,:0xFF,,1:250
+&bpow
+2,,:3,,:8
+2,,:0,,:1
+2,2,:0,,:1
+2,,:0,2,:1
}
print "# INC = @INC\n";
- plan tests => 438
+ plan tests => 617
+ 16; # own tests
}
-use Math::BigInt 1.53;
-use Math::BigFloat 1.30;
+use Math::BigInt 1.60;
+use Math::BigFloat 1.35;
use vars qw/$mbi $mbf/;
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2368
+ plan tests => 2392
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 438;
+ plan tests => 617;
}
use Math::BigInt::Subclass;
}
print "# INC = @INC\n";
- plan tests => 1599
+ plan tests => 1627
+ 1;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff