lib/Math/BigFloat/Trace.pm bignum tracing
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
+lib/Math/BigInt/Scalar.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/bigintc.t See if BigInt/Calc.pm works
lib/Math/BigInt/t/bigintpm.inc Shared tests for bigintpm.t and sub_mbi.t
lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works
+lib/Math/BigInt/t/bigints.t See if BigInt.pm works
lib/Math/BigInt/t/calling.t Test calling conventions
lib/Math/BigInt/t/config.t Test Math::BigInt->config()
lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.35';
+$VERSION = '1.37';
require 5.005;
use Exporter;
use File::Spec;
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-';
- my $sep = 'e'.$sign;
- $x->{_m}->bstr().$sep.$x->{_e}->bstr();
+ my $esign = $x->{_e}->{sign}; $esign = '' if $esign eq '-';
+ my $sep = 'e'.$esign;
+ my $sign = $x->{sign}; $sign = '' if $sign eq '+';
+ $sign . $x->{_m}->bstr() . $sep . $x->{_e}->bstr();
}
sub numify
($self,$x,$y) = objectify(2,@_);
}
+ return $upgrade->bcmp($x,$y) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
+
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# handle +-inf and NaN
($self,$x,$y) = objectify(2,@_);
}
+ return $upgrade->bacmp($x,$y) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
+
# handle +-inf and NaN's
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
{
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
+ # disable them and later re-enable them
no strict 'refs';
my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
# promote BigInts and it's subclasses (except when already a BigFloat)
$y = $self->new($y) unless $y->isa('Math::BigFloat');
- #print "bdiv $y ",ref($y),"\n";
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef; # should be parent class vs MBI
# shortcut to not run trough _find_round_parameters again
if (defined $params[1])
{
+ $x->{_a} = undef; # clear before round
$x->bround($params[1],$params[3]); # then round accordingly
}
else
{
+ $x->{_p} = undef; # clear before round
$x->bfround($params[2],$params[3]); # then round accordingly
}
if ($fallback)
}
# when user set globals, they would interfere with our calculation, so
- # disable then and later re-enable them
+ # disable them and later re-enable them
no strict 'refs';
my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
}
# when user set globals, they would interfere with our calculation, so
- # disable then and later re-enable them
+ # disable them and later re-enable them
no strict 'refs';
my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
my $lib = ''; my @a;
for ( my $i = 0; $i < $l ; $i++)
{
-# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
if ( $_[$i] eq ':constant' )
{
# this rest causes overlord er load to step in
}
##############################################################################
-# internal calculation routines
+
+sub as_hex
+ {
+ # return number as hexadecimal string (only for integers defined)
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return '0x0' if $x->is_zero();
+
+ return 'NaN' if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+
+ my $z = $x->{_m}->copy();
+ if (!$x->{_e}->is_zero()) # > 0
+ {
+ $z->blsft($x->{_e},10);
+ }
+ $z->{sign} = $x->{sign};
+ $z->as_hex();
+ }
+
+sub as_bin
+ {
+ # return number as binary digit string (only for integers defined)
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return '0b0' if $x->is_zero();
+
+ return 'NaN' if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+
+ my $z = $x->{_m}->copy();
+ if (!$x->{_e}->is_zero()) # > 0
+ {
+ $z->blsft($x->{_e},10);
+ }
+ $z->{sign} = $x->{sign};
+ $z->as_bin();
+ }
sub as_number
{
my $class = "Math::BigInt";
require 5.005;
-# This is a patched v1.60, containing a fix for the "1234567890\n" bug
-$VERSION = '1.60';
+$VERSION = '1.62';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
my $ref = \$wanted;
if ($wanted =~ /^[+-]/)
{
- # remove sign without touching wanted
+ # remove sign without touching wanted to make it work with constants
my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
}
$self->{value} = $CALC->_new($ref);
return 'inf'; # +inf
}
my ($m,$e) = $x->parts();
- # e can only be positive
- my $sign = 'e+';
- # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
+ my $sign = 'e+'; # e can only be positive
return $m->bstr().$sign.$e->bstr();
}
{
# Make a "normal" scalar from a BigInt object
my $x = shift; $x = $class->new($x) unless ref $x;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/;
my $num = $CALC->_num($x->{value});
return -$num if $x->{sign} eq '-';
$num;
($self,$x,$y) = objectify(2,@_);
}
+ return $upgrade->bcmp($x,$y) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
+
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# handle +-inf and NaN
($self,$x,$y) = objectify(2,@_);
}
+ return $upgrade->bacmp($x,$y) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
+
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
# handle +-inf and NaN
sub bmodinv
{
- # modular inverse. given a number which is (hopefully) relatively
+ # Modular inverse. given a number which is (hopefully) relatively
# prime to the modulus, calculate its inverse using Euclid's
- # alogrithm. if the number is not relatively prime to the modulus
+ # alogrithm. If the number is not relatively prime to the modulus
# (i.e. their gcd is not one) then NaN is returned.
# set up parameters
my ($self,$x,$y,@r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # 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('bmodinv');
return $x->bnan()
- if ($y->{sign} ne '+' # -, NaN, +inf, -inf
- || $x->is_zero() # or num == 0
- || $x->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
+ if ($y->{sign} ne '+' # -, NaN, +inf, -inf
+ || $x->is_zero() # or num == 0
+ || $x->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
);
# put least residue into $x if $x was negative, and thus make it positive
if ($CALC->can('_modinv'))
{
- $x->{value} = $CALC->_modinv($x->{value},$y->{value});
- $x->bnan() if !defined $x->{value} ; # in case there was none
+ my $sign;
+ ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
+ $x->bnan() if !defined $x->{value}; # in case no GCD found
+ return $x if !defined $sign; # already real result
+ $x->{sign} = $sign; # flip/flop see below
+ $x->bmod($y); # calc real result
return $x;
}
-
my ($u, $u1) = ($self->bzero(), $self->bone());
my ($a, $b) = ($y->copy(), $x->copy());
# a case with 28 loops still gains about 3% with this layout.
my $q;
($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
- # Euclid's Algorithm
- while (!$b->is_zero())
+ # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
+ # two values in $u and $u1, we use only $u1 afterwards)
+ my $sign = 1; # flip-flop
+ while (!$b->is_zero()) # found GCD if $b == 0
{
- ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
+ # the original algorithm had:
+ # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
+ # The following creates exact the same sequence of numbers in $u1,
+ # except for the sign ($u1 is now always positive). Since formerly
+ # the sign of $u1 was alternating between '-' and '+', the $sign
+ # flip-flop will take care of that, so that at the end of the loop
+ # we have the real sign of $u1. Keeping numbers positive gains us
+ # speed since badd() is faster than bsub() and makes it possible
+ # to have the algorithmn in Calc for even more speed.
+
+ ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
+ $sign = - $sign; # flip sign
+
($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
}
- # 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*
+ # 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 $x->bnan() unless $a->is_one();
- $u1->bmod($y);
- $x->{value} = $u1->{value};
- $x->{sign} = $u1->{sign};
+ $u1->bneg() if $sign != 1; # need to flip?
+
+ $u1->bmod($y); # calc result
+ $x->{value} = $u1->{value}; # and copy over to $x
+ $x->{sign} = $u1->{sign}; # to modify in place
$x;
}
# we have fewer digits than we want to scale to
my $len = $x->length();
+ # convert $scale to a scalar in case it is an object (put's a limit on the
+ # number length, but this would already limited by memory constraints), makes
+ # it faster
+ $scale = $scale->numify() if ref ($scale);
+
# scale < 0, but > -len (not >=!)
if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
{
my $xs = $CALC->_str($x->{value});
my $pl = -$pad-1;
-
+
# pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
# pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
$digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
if ($round_up) # what gave test above?
{
$put_back = 1;
- $pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
+ $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, since that is faster (we already have the string)
# 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
# .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
- return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
+ #return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
- my ($m,$e) = split /[Ee]/,$$x;
+ my ($m,$e,$last) = split /[Ee]/,$$x;
+ return if defined $last; # last defined => 1e2E3 or others
$e = '0' if !defined $e || $e eq "";
+
# sign,value for exponent,mantint,mantfrac
my ($es,$ev,$mis,$miv,$mfv);
# valid exponent?
$es = $1; $ev = $2;
# valid mantissa?
return if $m eq '.' || $m eq '';
- my ($mi,$mf,$last) = split /\./,$m;
- return if defined $last; # last defined => 1.2.3 or others
+ my ($mi,$mf,$lastf) = split /\./,$m;
+ return if defined $lastf; # last defined => 1.2.3 or others
$mi = '0' if !defined $mi;
$mi .= '0' if $mi =~ /^[\-\+]?$/;
$mf = '0' if !defined $mf || $mf eq '';
$one = Math::BigInt->bone(); # create a +1
$one = Math::BigInt->bone('-'); # create a -1
- # Testing
- $x->is_zero(); # true if arg is +0
- $x->is_nan(); # true if arg is NaN
- $x->is_one(); # true if arg is +1
- $x->is_one('-'); # true if arg is -1
- $x->is_odd(); # true if odd, false for even
- $x->is_even(); # true if even, false for odd
- $x->is_positive(); # true if >= 0
- $x->is_negative(); # true if < 0
- $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
- $x->is_int(); # true if $x is an integer (not a float)
-
- $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
- $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
- $x->sign(); # return the sign, either +,- or NaN
- $x->digit($n); # return the nth digit, counting from right
- $x->digit(-$n); # return the nth digit, counting from left
+ # Testing (don't modify their arguments)
+ # (return true if the condition is met, otherwise false)
+
+ $x->is_zero(); # if $x is +0
+ $x->is_nan(); # if $x is NaN
+ $x->is_one(); # if $x is +1
+ $x->is_one('-'); # if $x is -1
+ $x->is_odd(); # if $x is odd
+ $x->is_even(); # if $x is even
+ $x->is_positive(); # if $x >= 0
+ $x->is_negative(); # if $x < 0
+ $x->is_inf(sign); # if $x is +inf, or -inf (sign is default '+')
+ $x->is_int(); # if $x is an integer (not a float)
+
+ # comparing and digit/sign extration
+ $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
+ $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
+ $x->sign(); # return the sign, either +,- or NaN
+ $x->digit($n); # return the nth digit, counting from right
+ $x->digit(-$n); # return the nth digit, counting from left
# The following all modify their first argument:
- # set
- $x->bzero(); # set $x to 0
- $x->bnan(); # set $x to NaN
- $x->bone(); # set $x to +1
- $x->bone('-'); # set $x to -1
- $x->binf(); # set $x to inf
- $x->binf('-'); # set $x to -inf
-
- $x->bneg(); # negation
- $x->babs(); # absolute value
- $x->bnorm(); # normalize (no-op)
- $x->bnot(); # two's complement (bit wise not)
- $x->binc(); # increment x by 1
- $x->bdec(); # decrement x by 1
+ $x->bzero(); # set $x to 0
+ $x->bnan(); # set $x to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
+ $x->binf(); # set $x to inf
+ $x->binf('-'); # set $x to -inf
+
+ $x->bneg(); # negation
+ $x->babs(); # absolute value
+ $x->bnorm(); # normalize (no-op in BigInt)
+ $x->bnot(); # two's complement (bit wise not)
+ $x->binc(); # increment $x by 1
+ $x->bdec(); # decrement $x by 1
- $x->badd($y); # addition (add $y to $x)
- $x->bsub($y); # subtraction (subtract $y from $x)
- $x->bmul($y); # multiplication (multiply $x by $y)
- $x->bdiv($y); # divide, set $x to quotient
- # return (quo,rem) or quo if scalar
-
- $x->bmod($y); # modulus (x % y)
- $x->bmodpow($exp,$mod); # modular exponentation (($num**$exp) % $mod))
- $x->bmodinv($mod); # the inverse of $x in the given modulus $mod
-
- $x->bpow($y); # power of arguments (x ** y)
- $x->blsft($y); # left shift
- $x->brsft($y); # right shift
- $x->blsft($y,$n); # left shift, by base $n (like 10)
- $x->brsft($y,$n); # right shift, by base $n (like 10)
+ $x->badd($y); # addition (add $y to $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bdiv($y); # divide, set $x to quotient
+ # return (quo,rem) or quo if scalar
+
+ $x->bmod($y); # modulus (x % y)
+ $x->bmodpow($exp,$mod); # modular exponentation (($num**$exp) % $mod))
+ $x->bmodinv($mod); # the inverse of $x in the given modulus $mod
+
+ $x->bpow($y); # power of arguments (x ** y)
+ $x->blsft($y); # left shift
+ $x->brsft($y); # right shift
+ $x->blsft($y,$n); # left shift, by base $n (like 10)
+ $x->brsft($y,$n); # right shift, by base $n (like 10)
- $x->band($y); # bitwise and
- $x->bior($y); # bitwise inclusive or
- $x->bxor($y); # bitwise exclusive or
- $x->bnot(); # bitwise not (two's complement)
+ $x->band($y); # bitwise and
+ $x->bior($y); # bitwise inclusive or
+ $x->bxor($y); # bitwise exclusive or
+ $x->bnot(); # bitwise not (two's complement)
- $x->bsqrt(); # calculate square-root
- $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+ $x->bsqrt(); # calculate square-root
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
- $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
- $x->bround($N); # accuracy: preserve $N digits
- $x->bfround($N); # round to $Nth digit, no-op for BigInts
+ $x->round($A,$P,$mode); # round to accuracy or precision using mode $r
+ $x->bround($N); # accuracy: preserve $N digits
+ $x->bfround($N); # round to $Nth digit, no-op for BigInts
- # The following do not modify their arguments in BigInt, but do in BigFloat:
- $x->bfloor(); # return integer less or equal than $x
- $x->bceil(); # return integer greater or equal than $x
+ # The following do not modify their arguments in BigInt,
+ # but do so in BigFloat:
+
+ $x->bfloor(); # return integer less or equal than $x
+ $x->bceil(); # return integer greater or equal than $x
# The following do not modify their arguments:
- bgcd(@values); # greatest common divisor (no OO style)
- blcm(@values); # lowest common multiplicator (no OO style)
+ bgcd(@values); # greatest common divisor (no OO style)
+ blcm(@values); # lowest common multiplicator (no OO style)
- $x->length(); # return number of digits in number
- ($x,$f) = $x->length(); # length of number and length of fraction part,
- # latter is always 0 digits long for BigInt's
-
- $x->exponent(); # return exponent as BigInt
- $x->mantissa(); # return (signed) mantissa as BigInt
- $x->parts(); # return (mantissa,exponent) as BigInt
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+ $x->length(); # return number of digits in number
+ ($x,$f) = $x->length(); # length of number and length of fraction part,
+ # latter is always 0 digits long for BigInt's
+
+ $x->exponent(); # return exponent as BigInt
+ $x->mantissa(); # return (signed) mantissa as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->as_number(); # return as BigInt (in BigInt: same as copy())
- # conversation to string
- $x->bstr(); # normalized string
- $x->bsstr(); # normalized string in scientific notation
- $x->as_hex(); # as signed hexadecimal string with prefixed 0x
- $x->as_bin(); # as signed binary string with prefixed 0b
+ # conversation to string (do not modify their argument)
+ $x->bstr(); # normalized string
+ $x->bsstr(); # normalized string in scientific notation
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+ $x->as_bin(); # as signed binary string with prefixed 0b
- 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 A $x to $n
+ $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 A $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
+ # Global methods
+ Math::BigInt->precision(); # get/set global P for all BigInt objects
+ Math::BigInt->accuracy(); # get/set global A for all BigInt objects
+ Math::BigInt->config(); # return hash containing configuration
=head1 DESCRIPTION
=item Input
Input values to these routines may be either Math::BigInt objects or
-strings of the form C</^[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
+strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
-You can include one underscore between any two digits. The input string may
-have leading and trailing whitespace, which will be ignored. In later
-versions, a more strict (no whitespace at all) or more lax (whitespace
-allowed everywhere) input checking will also be possible.
+You can include one underscore between any two digits.
This means integer values like 1.01E2 or even 1000E-2 are also accepted.
Non integer values result in NaN.
=head1 METHODS
-Each of the methods below accepts three additional parameters. These arguments
-$A, $P and $R are accuracy, precision and round_mode. Please see more in the
-section about ACCURACY and ROUNDIND.
+Each of the methods below (except config(), accuracy() and precision())
+accepts three additional parameters. These arguments $A, $P and $R are
+accuracy, precision and round_mode. Please see the section about
+L<ACCURACY and PRECISION> for more information.
=head2 config
use Data::Dumper;
print Dumper ( Math::BigInt->config() );
+ print Math::BigInt->config()->{lib},"\n";
Returns a hash containing the configuration, e.g. the version number, lib
-loaded etc.
+loaded etc. The following hash keys are currently filled in with the
+appropriate information.
+
+ key Description
+ Example
+ ============================================================
+ lib Name of the Math library
+ Math::BigInt::Calc
+ lib_version Version of 'lib'
+ 0.30
+ class The class of config you just called
+ Math::BigInt
+ upgrade To which class numbers are upgraded
+ Math::BigFloat
+ downgrade To which class numbers are downgraded
+ undef
+ precision Global precision
+ undef
+ accuracy Global accuracy
+ undef
+ round_mode Global round mode
+ even
+ version version number of the class you used
+ 1.61
+ div_scale Fallback acccuracy for div
+ 40
+
+It is currently not supported to set the configuration parameters by passing
+a hash ref to C<config()>.
=head2 accuracy
$x->accuracy(5); # local for $x
- $class->accuracy(5); # global for all members of $class
+ CLASS->accuracy(5); # global for all members of CLASS
+ $A = $x->accuracy(); # read out
+ $A = CLASS->accuracy(); # read out
Set or get the global or local accuracy, aka how many significant digits the
-results have. Please see the section about L<ACCURACY AND PRECISION> for
-further details.
+results have.
+
+Please see the section about L<ACCURACY AND PRECISION> for further details.
Value must be greater than zero. Pass an undef value to disable it:
print $x->accuracy(),"\n"; # still 4
print $y->accuracy(),"\n"; # 5, since global is 5
+Note: Works also for subclasses like Math::BigFloat. Each class has it's own
+globals separated from Math::BigInt, but it is possible to subclass
+Math::BigInt and make the globals of the subclass aliases to the ones from
+Math::BigInt.
+
+=head2 precision
+
+ $x->precision(-2); # local for $x, round right of the dot
+ $x->precision(2); # ditto, but round left of the dot
+ CLASS->accuracy(5); # global for all members of CLASS
+ CLASS->precision(-5); # ditto
+ $P = CLASS->precision(); # read out
+ $P = $x->precision(); # read out
+
+Set or get the global or local precision, aka how many digits the result has
+after the dot (or where to round it when passing a positive number). In
+Math::BigInt, passing a negative number precision has no effect since no
+numbers have digits after the dot.
+
+Please see the section about L<ACCURACY AND PRECISION> for further details.
+
+Value must be greater than zero. Pass an undef value to disable it:
+
+ $x->precision(undef);
+ Math::BigInt->precision(undef);
+
+Returns the current precision. For C<$x->precision()> it will return either the
+local precision of $x, or if not defined, the global. This means the return
+value represents the accuracy that will be in effect for $x:
+
+ $y = Math::BigInt->new(1234567); # unrounded
+ print Math::BigInt->precision(4),"\n"; # set 4, print 4
+ $x = Math::BigInt->new(123456); # will be automatically rounded
+
+Note: Works also for subclasses like Math::BigFloat. Each class has it's own
+globals separated from Math::BigInt, but it is possible to subclass
+Math::BigInt and make the globals of the subclass aliases to the ones from
+Math::BigInt.
+
=head2 brsft
$x->brsft($y,$n);
=head2 bnorm
- $x->bnorm(); # normalize (no-op)
+ $x->bnorm(); # normalize (no-op)
=head2 bnot
- $x->bnot(); # two's complement (bit wise not)
+ $x->bnot(); # two's complement (bit wise not)
=head2 binc
- $x->binc(); # increment x by 1
+ $x->binc(); # increment x by 1
=head2 bdec
- $x->bdec(); # decrement x by 1
+ $x->bdec(); # decrement x by 1
=head2 badd
- $x->badd($y); # addition (add $y to $x)
+ $x->badd($y); # addition (add $y to $x)
=head2 bsub
- $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
=head2 bmul
- $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bmul($y); # multiplication (multiply $x by $y)
=head2 bdiv
- $x->bdiv($y); # divide, set $x to quotient
- # return (quo,rem) or quo if scalar
+ $x->bdiv($y); # divide, set $x to quotient
+ # return (quo,rem) or quo if scalar
=head2 bmod
- $x->bmod($y); # modulus (x % y)
+ $x->bmod($y); # modulus (x % y)
=head2 bmodinv
- $num->bmodinv($mod); # modular inverse
+ num->bmodinv($mod); # modular inverse
Returns the inverse of C<$num> in the given modulus C<$mod>. 'C<NaN>' is
returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
=head2 bmodpow
- $num->bmodpow($exp,$mod); # modular exponentation ($num**$exp % $mod)
+ $num->bmodpow($exp,$mod); # modular exponentation
+ # ($num**$exp % $mod)
Returns the value of C<$num> taken to the power C<$exp> in the modulus
C<$mod> using binary exponentation. C<bmodpow> is far superior to
writing
- $num ** $exp % $mod
+ $num ** $exp % $mod
because C<bmodpow> is much faster--it reduces internal variables into
the modulus whenever possible, so it operates on smaller numbers.
C<bmodpow> also supports negative exponents.
- bmodpow($num, -1, $mod)
+ bmodpow($num, -1, $mod)
is exactly equivalent to
- bmodinv($num, $mod)
+ bmodinv($num, $mod)
=head2 bpow
- $x->bpow($y); # power of arguments (x ** y)
+ $x->bpow($y); # power of arguments (x ** y)
=head2 blsft
- $x->blsft($y); # left shift
- $x->blsft($y,$n); # left shift, by base $n (like 10)
+ $x->blsft($y); # left shift
+ $x->blsft($y,$n); # left shift, in base $n (like 10)
=head2 brsft
- $x->brsft($y); # right shift
- $x->brsft($y,$n); # right shift, by base $n (like 10)
+ $x->brsft($y); # right shift
+ $x->brsft($y,$n); # right shift, in base $n (like 10)
=head2 band
- $x->band($y); # bitwise and
+ $x->band($y); # bitwise and
=head2 bior
- $x->bior($y); # bitwise inclusive or
+ $x->bior($y); # bitwise inclusive or
=head2 bxor
- $x->bxor($y); # bitwise exclusive or
+ $x->bxor($y); # bitwise exclusive or
=head2 bnot
- $x->bnot(); # bitwise not (two's complement)
+ $x->bnot(); # bitwise not (two's complement)
=head2 bsqrt
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square-root
=head2 bfac
- $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
=head2 round
- $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
+ $x->round($A,$P,$round_mode);
+
+Round $x to accuracy C<$A> or precision C<$P> using the round mode
+C<$round_mode>.
=head2 bround
- $x->bround($N); # accuracy: preserve $N digits
+ $x->bround($N); # accuracy: preserve $N digits
=head2 bfround
- $x->bfround($N); # round to $Nth digit, no-op for BigInts
+ $x->bfround($N); # round to $Nth digit, no-op for BigInts
=head2 bfloor
=head2 bgcd
- bgcd(@values); # greatest common divisor (no OO style)
+ bgcd(@values); # greatest common divisor (no OO style)
=head2 blcm
- blcm(@values); # lowest common multiplicator (no OO style)
+ blcm(@values); # lowest common multiplicator (no OO style)
head2 length
=head2 parts
- $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
=head2 copy
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
=head2 as_number
- $x->as_number(); # return as BigInt (in BigInt: same as copy())
+ $x->as_number(); # return as BigInt (in BigInt: same as copy())
=head2 bsrt
- $x->bstr(); # normalized string
+ $x->bstr(); # return normalized string
=head2 bsstr
- $x->bsstr(); # normalized string in scientific notation
+ $x->bsstr(); # normalized string in scientific notation
=head2 as_hex
- $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
=head2 as_bin
- $x->as_bin(); # as signed binary string with prefixed 0b
+ $x->as_bin(); # as signed binary string with prefixed 0b
=head1 ACCURACY and PRECISION
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.30';
+$VERSION = '0.32';
# Package to store unsigned big integers in decimal and do math with them
{
# (ref to int_num_array, ref to int_num_array)
# routine to add 1 to a base 1eX numbers
- # This routine clobbers up array x, but not y.
+ # This routine modifies array x
my ($c,$x) = @_;
for my $i (@$x)
{
# (ref to int_num_array, ref to int_num_array)
# routine to add 1 to a base 1eX numbers
- # This routine clobbers up array x, but not y.
+ # This routine modifies array x
my ($c,$x) = @_;
my $MAX = $BASE-1; # since MAX_VAL based on MBASE
__strip_zeros($sy);
}
-sub _square_use_mul
- {
- # compute $x ** 2 or $x * $x in-place and return $x
- my ($c,$x) = @_;
-
- # From: Handbook of Applied Cryptography by A. Menezes, P. van Oorschot and
- # S. Vanstone., Chapter 14
-
- #14.16 Algorithm Multiple-precision squaring
- #INPUT: positive integer x = (xt 1 xt 2 ... x1 x0)b.
- #OUTPUT: x * x = x ** 2 in radix b representation.
- #1. For i from 0 to (2t - 1) do: wi <- 0.
- #2. For i from 0 to (t - 1) do the following:
- # 2.1 (uv)b w2i + xi * xi, w2i v, c u.
- # 2.2 For j from (i + 1)to (t - 1) do the following:
- # (uv)b <- wi+j + 2*xj * xi + c, wi+j <- v, c <- u.
- # 2.3 wi+t <- u.
- #3. Return((w2t-1 w2t-2 ... w1 w0)b).
-
-# # Note: That description is crap. Half of the symbols are not explained or
-# # used with out beeing set.
-# my $t = scalar @$x; # count
-# my ($c,$i,$j);
-# for ($i = 0; $i < $t; $i++)
-# {
-# $x->[$i] = $x->[$i*2] + $x[$i]*$x[$i];
-# $x->[$i*2] = $x[$i]; $c = $x[$i];
-# for ($j = $i+1; $j < $t; $j++)
-# {
-# $x->[$i] = $x->[$i+$j] + 2 * $x->[$i] * $x->[$j];
-# $x->[$i+$j] = $x[$j]; $c = $x[$i];
-# }
-# $x->[$i+$t] = $x[$i];
-# }
- $x;
- }
-
sub _mul_use_mul
{
# (ref to int_num_array, ref to int_num_array)
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if $xv == $yv; # same references?
-# $yv = [@$xv] if "$xv" eq "$yv"; # same references?
-
- # since multiplying $x with $x would fail here, use the faster squaring
-# return _square($c,$xv) if $xv == $yv; # same reference?
if ($LEN_CONVERT != 0)
{
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if $xv == $yv; # same references?
-# $yv = [@$xv] if "$xv" eq "$yv"; # same references?
- # since multiplying $x with $x would fail here, use the faster squaring
-# return _square($c,$xv) if $xv == $yv; # same reference?
if ($LEN_CONVERT != 0)
{
my $lxy = scalar @$cx - scalar @$cy;
return -1 if $lxy < 0; # already differs, ret
return 1 if $lxy > 0; # ditto
-
+
# now calculate length based on digits, not parts
- $lxy = _len($c,$cx) - _len($c,$cy); # difference
+ # we need only the length of the last element, since both array have the
+ # same number of parts
+ $lxy = length(int($cx->[-1])) - length(int($cy->[-1]));
return -1 if $lxy < 0;
return 1 if $lxy > 0;
- # hm, same lengths, but same contents?
- my $i = 0; my $a;
- # first way takes 5.49 sec instead of 4.87, but has the early out advantage
- # so grep is slightly faster, but more inflexible. hm. $_ instead of $k
- # yields 5.6 instead of 5.5 sec huh?
+ # hm, same lengths, but same contents? So we need to check all parts:
+ my $a; my $j = scalar @$cx - 1;
# manual way (abort if unequal, good for early ne)
- my $j = scalar @$cx - 1;
while ($j >= 0)
{
last if ($a = $cx->[$j] - $cy->[$j]); $j--;
}
-# my $j = scalar @$cx;
-# while (--$j >= 0)
-# {
-# last if ($a = $cx->[$j] - $cy->[$j]);
-# }
return 1 if $a > 0;
return -1 if $a < 0;
- 0; # equal
-
- # while it early aborts, it is even slower than the manual variant
- #grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
- # grep way, go trough all (bad for early ne)
- #grep { $a = $_ - $cy->[$i++]; } @$cx;
- #return $a;
+ 0; # numbers are equal
}
sub _len
{
- # compute number of digits in bigint, minus the sign
+ # compute number of digits
# int() because add/sub sometimes leaves strings (like '00005') instead of
# '5' in this place, thus causing length() to report wrong length
my $cx = $_[1];
- return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
+ (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
}
sub _digit
my $elem = int($n / $BASE_LEN); # which array element
my $digit = $n % $BASE_LEN; # which digit in this element
$elem = '0000'.@$x[$elem]; # get element padded with 0's
- return substr($elem,-$digit-1,1);
+ substr($elem,-$digit-1,1);
}
sub _zeros
# multiples of $BASE_LEN
my $dst = 0; # destination
my $src = _num($c,$y); # as normal int
+ my $xlen = (@$x-1)*$BASE_LEN+length(int($x->[-1])); # len of x in digits
+ if ($src > $xlen)
+ {
+ # 12345 67890 shifted right by more than 10 digits => 0
+ splice (@$x,1); # leave only one element
+ $x->[0] = 0; # set to zero
+ return $x;
+ }
my $rem = $src % $BASE_LEN; # remainder to shift
$src = int($src / $BASE_LEN); # source
if ($rem == 0)
my $n = _copy($c,$cx);
$cx = [$last];
- #$cx = _one();
while (!(@$n == 1 && $n->[0] == $step))
{
_mul($c,$cx,$n); _dec($c,$n);
$cx;
}
-use constant DEBUG => 0;
-
-my $steps = 0;
-
-sub steps { $steps };
+# for debugging:
+ use constant DEBUG => 0;
+ my $steps = 0;
+ sub steps { $steps };
sub _sqrt
{
- # square-root of $x
- # ref to array, return ref to array
+ # square-root of $x in place
+ # Compute a guess of the result (rule of thumb), then improve it via
+ # Newton's method.
my ($c,$x) = @_;
if (scalar @$x == 1)
{
- # fit's into one Perl scalar
+ # fit's into one Perl scalar, so result can be computed directly
$x->[0] = int(sqrt($x->[0]));
return $x;
}
# since our guess will "grow"
my $l = int((_len($c,$x)-1) / 2);
- my $lastelem = $x->[-1]; # for guess
+ my $lastelem = $x->[-1]; # for guess
my $elems = scalar @$x - 1;
# not enough digits, but could have more?
- if ((length($lastelem) <= 3) && ($elems > 1))
+ if ((length($lastelem) <= 3) && ($elems > 1))
{
# right-align with zero pad
my $len = length($lastelem) & 1;
print "$lastelem => " if DEBUG;
$lastelem .= substr($x->[-2] . '0' x $BASE_LEN,0,$BASE_LEN);
# former odd => make odd again, or former even to even again
- $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
+ $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
print "$lastelem\n" if DEBUG;
}
my $r = $l % $BASE_LEN; # 10000 00000 00000 00000 ($BASE_LEN=5)
$l = int($l / $BASE_LEN);
print "l = $l " if DEBUG;
-
- splice @$x,$l; # keep ref($x), but modify it
-
+
+ splice @$x,$l; # keep ref($x), but modify it
+
# we make the first part of the guess not '1000...0' but int(sqrt($lastelem))
# that gives us:
- # 14400 00000 => sqrt(14400) => 120
- # 144000 000000 => sqrt(144000) => 379
+ # 14400 00000 => sqrt(14400) => guess first digits to be 120
+ # 144000 000000 => sqrt(144000) => guess 379
- # $x->[$l--] = int('1' . '0' x $r); # old way of guessing
print "$lastelem (elems $elems) => " if DEBUG;
$lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even?
my $g = sqrt($lastelem); $g =~ s/\.//; # 2.345 => 2345
$x->[$l--] = int(substr($g . '0' x $r,0,$r+1));
print "now ",$x->[-1] if DEBUG;
print " would have been ", int('1' . '0' x $r),"\n" if DEBUG;
-
+
# If @$x > 1, we could compute the second elem of the guess, too, to create
- # an even better guess. Not implemented yet.
+ # an even better guess. Not implemented yet. Does it improve performance?
$x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
-
+
print "start x= ",${_str($c,$x)},"\n" if DEBUG;
my $two = _two();
my $last = _zero();
$last = _copy($c,$x);
_add($c,$x, _div($c,_copy($c,$y),$x));
_div($c,$x, $two );
- print " x= ",${_str($c,$x)},"\n" if DEBUG;
+ print " x= ",${_str($c,$x)},"\n" if DEBUG;
}
print "\nsteps in sqrt: $steps, " if DEBUG;
_dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot?
##############################################################################
# special modulus functions
-# not ready yet, since it would need to deal with unsigned numbers
-sub _modinv1
+sub _modinv
{
- # inverse modulus
- my ($c,$num,$mod) = @_;
+ # modular inverse
+ my ($c,$x,$y) = @_;
- my $u = _zero(); my $u1 = _one();
- my $a = _copy($c,$mod); my $b = _copy($c,$num);
+ my $u = _zero($c); my $u1 = _one($c);
+ my $a = _copy($c,$y); my $b = _copy($c,$x);
# Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the
- # result ($u) at the same time
+ # result ($u) at the same time. See comments in BigInt for why this works.
+ my $q;
+ ($a, $q, $b) = ($b, _div($c,$a,$b)); # step 1
+ my $sign = 1;
while (!_is_zero($c,$b))
{
-# print ${_str($c,$a)}, " ", ${_str($c,$b)}, " ", ${_str($c,$u)}, " ",
-# ${_str($c,$u1)}, "\n";
- ($a, my $q, $b) = ($b, _div($c,$a,$b));
-# print ${_str($c,$a)}, " ", ${_str($c,$q)}, " ", ${_str($c,$b)}, "\n";
- # original: ($u,$u1) = ($u1, $u - $u1 * $q);
- my $t = _copy($c,$u);
- $u = _copy($c,$u1);
- _mul($c,$u1,$q);
- $u1 = _sub($t,$u1);
-# print ${_str($c,$a)}, " ", ${_str($c,$b)}, " ", ${_str($c,$u)}, " ",
-# ${_str($c,$u1)}, "\n";
+ my $t = _add($c, # step 2:
+ _mul($c,_copy($c,$u1), $q) , # t = u1 * q
+ $u ); # + u
+ $u = $u1; # u = u1, u1 = t
+ $u1 = $t;
+ $sign = -$sign;
+ ($a, $q, $b) = ($b, _div($c,$a,$b)); # step 1
}
# if the gcd is not 1, then return NaN
- return undef unless _is_one($c,$a);
-
- $num = _mod($c,$u,$mod);
-# print ${_str($c,$num)},"\n";
- $num;
+ return (undef,undef) unless _is_one($c,$a);
+
+ $sign = $sign == 1 ? '+' : '-';
+ ($u1,$sign);
}
sub _modpow
}
print "# INC = @INC\n";
- plan tests => 1627;
+ plan tests => 1643;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2552;
+ plan tests => 2527;
}
use Math::BigInt lib => 'BareCalc';
$class = "Math::BigInt";
$CL = "Math::BigInt::BareCalc";
-my $version = '1.60'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.61'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
}
print "# INC = @INC\n";
- plan tests => 617
+ plan tests => 661
+ 1; # our onw tests
}
ok ($class->config()->{lib},$CL);
+use strict;
+
while (<DATA>)
{
chomp;
} elsif ($f eq "mantissa") {
# ->bstr() to see if an object is returned
$try .= '$x->mantissa()->bstr();';
- } elsif ($f eq "numify") {
- $try .= "\$x->numify();";
- } elsif ($f eq "length") {
- $try .= "\$x->length();";
+ } 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 "as_number") {
- $try .= '$x->as_number();';
} elsif ($f eq "finc") {
$try .= '++$x;';
} elsif ($f eq "fdec") {
my $monster = '1e1234567890123456789012345678901234567890';
# new
-ok ($class->new($monster)->bsstr(),
- '1e+1234567890123456789012345678901234567890');
+ok ($class->new($monster)->bsstr(),
+ '1e+1234567890123456789012345678901234567890');
# cmp
ok ($class->new($monster) > 0,1);
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
-$class->accuracy(undef); $class->precision(undef); # reset
$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46');
$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464');
-# 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
+{
+ 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)
-$try = '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);';
-$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);
+{
+ no strict;
+ $try =
+ '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);';
+ $ans = eval $try;
+ ok ($ans,"$class 4 5");
+}
1; # all done
-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
&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
+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
}
print "# INC = @INC\n";
- plan tests => 1627
+ plan tests => 1643
+ 2; # own tests
}
{
$| = 1;
chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
+ unshift @INC, '../lib'; # for running manually
}
use Math::BigInt::Calc;
BEGIN
{
- my $additional = 0;
- $additional = 27 if $Math::BigInt::Calc::VERSION > 0.18;
- plan tests => 80 + $additional;
+ plan tests => 276;
}
-# testing of Math::BigInt::Calc, primarily for interface/api and not for the
-# math functionality
+# testing of Math::BigInt::Calc
-my $C = 'Math::BigInt::Calc'; # pass classname to sub's
+my $C = 'Math::BigInt::Calc'; # pass classname to sub's
# _new and _str
my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
# is_zero, _is_one, _one, _zero
-ok ($C->_is_zero($x),0);
-ok ($C->_is_one($x),0);
+ok ($C->_is_zero($x)||0,0);
+ok ($C->_is_one($x)||0,0);
-ok ($C->_is_one($C->_one()),1); ok ($C->_is_one($C->_zero()),0);
-ok ($C->_is_zero($C->_zero()),1); ok ($C->_is_zero($C->_one()),0);
+ok (${$C->_str($C->_zero())},"0");
+ok (${$C->_str($C->_one())},"1");
+
+# _two() (only used internally)
+ok (${$C->_str($C->_two())},"2");
+
+ok ($C->_is_one($C->_one()),1);
+
+ok ($C->_is_one($C->_zero()) || 0,0);
+
+ok ($C->_is_zero($C->_zero()),1);
+
+ok ($C->_is_zero($C->_one()) || 0,0);
# is_odd, is_even
-ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0);
-ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1);
+ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero())||0,0);
+ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1);
+
+# _len
+$x = $C->_new(\"1"); ok ($C->_len($x),1);
+$x = $C->_new(\"12"); ok ($C->_len($x),2);
+$x = $C->_new(\"123"); ok ($C->_len($x),3);
+$x = $C->_new(\"1234"); ok ($C->_len($x),4);
+$x = $C->_new(\"12345"); ok ($C->_len($x),5);
+$x = $C->_new(\"123456"); ok ($C->_len($x),6);
+$x = $C->_new(\"1234567"); ok ($C->_len($x),7);
+$x = $C->_new(\"12345678"); ok ($C->_len($x),8);
+$x = $C->_new(\"123456789"); ok ($C->_len($x),9);
+
+$x = $C->_new(\"8"); ok ($C->_len($x),1);
+$x = $C->_new(\"21"); ok ($C->_len($x),2);
+$x = $C->_new(\"321"); ok ($C->_len($x),3);
+$x = $C->_new(\"4321"); ok ($C->_len($x),4);
+$x = $C->_new(\"54321"); ok ($C->_len($x),5);
+$x = $C->_new(\"654321"); ok ($C->_len($x),6);
+$x = $C->_new(\"7654321"); ok ($C->_len($x),7);
+$x = $C->_new(\"87654321"); ok ($C->_len($x),8);
+$x = $C->_new(\"987654321"); ok ($C->_len($x),9);
+
+for (my $i = 1; $i < 9; $i++)
+ {
+ my $a = "$i" . '0' x ($i-1);
+ $x = $C->_new(\$a);
+ print "# Tried len '$a'\n" unless ok ($C->_len($x),$i);
+ }
# _digit
$x = $C->_new(\"123456789");
ok ($C->_digit($x,-3),3);
# _copy
-$x = $C->_new(\"12356");
-ok (${$C->_str($C->_copy($x))},12356);
+foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/)
+ {
+ $x = $C->_new(\"$_");
+ ok (${$C->_str($C->_copy($x))},"$_");
+ ok (${$C->_str($x)},"$_"); # did _copy destroy original x?
+ }
# _zeros
$x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6);
$x = $C->_new(\"256"); $y = $C->_new(\"4");
ok (${$C->_str($C->_rsft($x,$y,2))},256 >> 4);
+$x = $C->_new(\"6411906467305339182857313397200584952398");
+$y = $C->_new(\"45");
+ok (${$C->_str($C->_rsft($x,$y,10))},0);
+
# _acmp
$x = $C->_new(\"123456789");
$y = $C->_new(\"987654321");
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
+$x = $C->_new(\"1234567890123456789");
+$y = $C->_new(\"987654321012345678");
+ok ($C->_acmp($x,$y),1);
+ok ($C->_acmp($y,$x),-1);
+ok ($C->_acmp($x,$x),0);
+ok ($C->_acmp($y,$y),0);
+
+$x = $C->_new(\"1234");
+$y = $C->_new(\"987654321012345678");
+ok ($C->_acmp($x,$y),-1);
+ok ($C->_acmp($y,$x),1);
+ok ($C->_acmp($x,$x),0);
+ok ($C->_acmp($y,$y),0);
+
+# _modinv
+$x = $C->_new(\"8");
+$y = $C->_new(\"5033");
+my ($xmod,$sign) = $C->_modinv($x,$y);
+ok (${$C->_str($xmod)},'629'); # -629 % 5033 == 4404
+ok ($sign, '-');
+
# _div
$x = $C->_new(\"3333"); $y = $C->_new(\"1111");
ok (${$C->_str(scalar $C->_div($x,$y))},3);
($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
# _num
-$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
+foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/)
+ {
+ $x = $C->_new(\"$_");
+ ok (ref($x)||'','ARRAY'); ok (${$C->_str($x)},"$_");
+ $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_);
+ }
# _sqrt
$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12');
$x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120');
$x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800');
$x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800');
+$x = $C->_new(\"12"); ok (${$C->_str($C->_fac($x))},'479001600');
+
+##############################################################################
+# _inc and _dec
+foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/)
+ {
+ $x = $C->_new(\"$_"); $C->_inc($x);
+ print "# \$x = ",${$C->_str($x)},"\n"
+ unless ok (${$C->_str($x)},substr($_,0,length($_)-1) . '2');
+ $C->_dec($x); ok (${$C->_str($x)},$_);
+ }
+foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/)
+ {
+ $x = $C->_new(\"$_"); $C->_inc($x);
+ print "# \$x = ",${$C->_str($x)},"\n"
+ unless ok (${$C->_str($x)},substr($_,0,length($_)-2) . '20');
+ $C->_dec($x); ok (${$C->_str($x)},$_);
+ }
+foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/)
+ {
+ $x = $C->_new(\"$_"); $C->_inc($x);
+ print "# \$x = ",${$C->_str($x)},"\n"
+ unless ok (${$C->_str($x)}, '1' . '0' x (length($_)));
+ $C->_dec($x); ok (${$C->_str($x)},$_);
+ }
-# _inc
$x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001');
$C->_dec($x); ok (${$C->_str($x)},'1000');
-my $BL = Math::BigInt::Calc::_base_len();
+my $BL;
+{
+ no strict 'refs';
+ $BL = &{"$C"."::_base_len"}();
+}
+
$x = '1' . '0' x $BL;
$z = '1' . '0' x ($BL-1); $z .= '1';
$x = $C->_new(\$x); $C->_inc($x); ok (${$C->_str($x)},$z);
# should not happen:
# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
+###############################################################################
# _mod
$x = $C->_new(\"1000"); $y = $C->_new(\"3");
ok (${$C->_str(scalar $C->_mod($x,$y))},1);
ok ($C->_check(123),'123 is not a reference');
###############################################################################
-# _to_large and _to_small (last since they toy with BASE_LEN etc)
+# __strip_zeros
+
+{
+ no strict 'refs';
+ # correct empty arrays
+ $x = &{$C."::__strip_zeros"}([]); ok (@$x,1); ok ($x->[0],0);
+ # don't strip single elements
+ $x = &{$C."::__strip_zeros"}([0]); ok (@$x,1); ok ($x->[0],0);
+ $x = &{$C."::__strip_zeros"}([1]); ok (@$x,1); ok ($x->[0],1);
+ # don't strip non-zero elements
+ $x = &{$C."::__strip_zeros"}([0,1]);
+ ok (@$x,2); ok ($x->[0],0); ok ($x->[1],1);
+ $x = &{$C."::__strip_zeros"}([0,1,2]);
+ ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
+
+ # but strip leading zeros
+ $x = &{$C."::__strip_zeros"}([0,1,2,0]);
+ ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
+
+ $x = &{$C."::__strip_zeros"}([0,1,2,0,0]);
+ ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
+
+ $x = &{$C."::__strip_zeros"}([0,1,2,0,0,0]);
+ ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
+
+ # collapse multiple zeros
+ $x = &{$C."::__strip_zeros"}([0,0,0,0]);
+ ok (@$x,1); ok ($x->[0],0);
+}
-exit if $Math::BigInt::Calc::VERSION < 0.19;
+###############################################################################
+# _to_large and _to_small (last since they toy with BASE_LEN etc)
$C->_base_len(5,7); $x = [ qw/67890 12345 67890 12345/ ]; $C->_to_large($x);
ok (@$x,3);
my $version = ${"$class\::VERSION"};
+use strict;
+
##############################################################################
# for testing inheritance of _swap
$try = "\$x = $class->bnorm(\"$args[0]\");";
# some is_xxx tests
} elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
- $try .= "\$x->$f();";
- } elsif ($f eq "as_hex") {
- $try .= '$x->as_hex();';
- } elsif ($f eq "as_bin") {
- $try .= '$x->as_bin();';
+ $try .= "\$x->$f() || 0;";
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]');";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
} elsif ($f eq "bone") {
$try .= "\$x->bone('$args[1]');";
- # some unary ops
+ # some unary ops
} elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) {
$try .= "\$x->$f();";
- } elsif ($f eq "length") {
- $try .= '$x->length();';
+ } elsif ($f =~ /^(numify|length|stringify|as_hex|as_bin)$/) {
+ $try .= "\$x->$f();";
} elsif ($f eq "exponent"){
# ->bstr() to see if an object is returned
$try .= '$x = $x->exponent()->bstr();';
$try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
$try .= '"$m,$e";';
} else {
+ # binary ops
$try .= "\$y = $class->new('$args[1]');";
if ($f eq "bcmp")
{
$x = $class->new($z); ok ($x->bsstr(),'1e+129');
###############################################################################
+# test for whitespace inlcuding newlines to be handled correctly
+
+# ok ($Math::BigInt::strict,1); # the default
+
+foreach my $c (
+ qw/1 12 123 1234 12345 123456 1234567 12345678 123456789 1234567890/)
+ {
+ my $m = $class->new($c);
+ ok ($class->new("$c"),$m);
+ ok ($class->new(" $c"),$m);
+ ok ($class->new("$c "),$m);
+ ok ($class->new(" $c "),$m);
+ ok ($class->new("\n$c"),$m);
+ ok ($class->new("$c\n"),$m);
+ ok ($class->new("\n$c\n"),$m);
+ ok ($class->new(" \n$c\n"),$m);
+ ok ($class->new(" \n$c \n"),$m);
+ ok ($class->new(" \n$c\n "),$m);
+ ok ($class->new(" \n$c\n1"),'NaN');
+ ok ($class->new("1 \n$c\n1"),'NaN');
+ }
+
+###############################################################################
# prime number tests, also test for **= and length()
# found on: http://www.utm.edu/research/primes/notes/by_year.html
###############################################################################
###############################################################################
-# the followin tests only make sense with Math::BigInt::Calc or BareCalc
+# the followin tests only make sense with Math::BigInt::Calc or BareCalc or
+# FastCalc
-exit if $CALC !~ /^Math::BigInt::(Calc|BareCalc)$/; # for Pari et al.
+exit if $CALC !~ /^Math::BigInt::(|Bare|Fast)Calc$/; # for Pari et al.
###############################################################################
# check proper length of internal arrays
-inf:NaN:
NaN:-inf:
&bnorm
--0\n:0
--123\n:-123
--1234\n:-1234
--12345\n:-12345
--123456\n:-123456
--1234567\n:-1234567
--12345678\n:-12345678
--123456789\n:-123456789
--1234567890\n:-1234567890
--12345678901\n:-12345678901
-0\n:0
-123\n:123
-1234\n:1234
-12345\n:12345
-123456\n:123456
-1234567\n:1234567
-12345678\n:12345678
-123456789\n:123456789
-1234567890\n:1234567890
-12345678901\n:12345678901
-\n0:0
-\n123:123
-\n1234:1234
-\n12345:12345
-\n123456:123456
-\n1234567:1234567
-\n12345678:12345678
-\n123456789:123456789
-\n1234567890:1234567890
-\n12345678901:12345678901
-\n0\n:0
-\n123\n:123
-\n1234\n:1234
-\n12345\n:12345
-\n123456\n:123456
-\n1234567\n:1234567
-\n12345678\n:12345678
-\n123456789\n:123456789
-\n1234567890\n:1234567890
-\n12345678901\n:12345678901
-\t0\n:0
-\t123\n:123
-\t1234\n:1234
-\t12345\n:12345
-\t123456\n:123456
-\t1234567\n:1234567
-\t12345678\n:12345678
-\t123456789\n:123456789
-\t1234567890\n:1234567890
-\t12345678901\n:12345678901
-\n0\t:0
-\n123\t:123
-\n1234\t:1234
-\n12345\t:12345
-\n123456\t:123456
-\n1234567\t:1234567
-\n12345678\t:12345678
-\n123456789\t:123456789
-\n1234567890\t:1234567890
-\n12345678901\t:12345678901
-0\n\n:0
-123\n\n:123
-1234\n\n:1234
-12345\n\n:12345
-123456\n\n:123456
-1234567\n\n:1234567
-12345678\n\n:12345678
-123456789\n\n:123456789
-1234567890\n\n:1234567890
-12345678901\n\n:12345678901
-\n\n0:0
-\n\n123:123
-\n\n1234:1234
-\n\n12345:12345
-\n\n123456:123456
-\n\n1234567:1234567
-\n\n12345678:12345678
-\n\n123456789:123456789
-\n\n1234567890:1234567890
-\n\n12345678901:12345678901
123:123
# binary input
0babc:NaN
-820265627:1:2:-410132814
-205066405:1:2:-102533203
&bsstr
++inf:inf
+-inf:-inf
1e+34:1e+34
123.456E3:123456e+0
100:1e+2
-abc:NaN
+bsstrabc:NaN
+-5:-5e+0
+-100:-1e+2
+&numify
+numifyabc:NaN
++inf:inf
+-inf:-inf
+5:5
+-5:-5
+100:100
+-100:-100
&bneg
bnegNaN:NaN
+inf:-inf
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
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2552;
+ plan tests => 2527;
}
use Math::BigInt;
unshift @INC, $location;
}
print "# INC = @INC\n";
- plan tests => 141;
+ my $tests = 161;
+ plan tests => $tests;
if ($] < 5.006)
{
- for (1..141) { skip (1,'Not supported on older Perls'); }
+ for (1..$tests) { skip (1,'Not supported on older Perls'); }
exit;
}
}
use Math::BigFloat;
my ($x,$y,$z,$u);
-my $version = '1.46'; # adjust manually to match latest release
+my $version = '1.61'; # adjust manually to match latest release
###############################################################################
# check whether op's accept normal strings, even when inherited by subclasses
&bstr
5:5
10:10
+-10:-10
abc:NaN
'+inf':inf
'-inf':-inf
0:0e+1
2:2e+0
200:2e+2
+-5:-5e+0
+-100:-1e+2
+abc:NaN
+'+inf':inf
&babs
-1:1
1:1
ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968');
{
- no warnings 'portable';
+ local $^W = 0; # protect against "non-portable" warnings
# hexadecimal constants
ok (0x123456789012345678901234567890,
Math::BigInt->new('0x123456789012345678901234567890'));
# Make sure you always quote any bare floating-point values, lest 123.46 will
# be stringified to 123.4599999999 due to limited float prevision.
+use strict;
my ($x,$y,$z,$u,$rc);
###############################################################################
# test defaults and set/get
-ok_undef (${"$mbi\::accuracy"});
-ok_undef (${"$mbi\::precision"});
-ok_undef ($mbi->accuracy());
-ok_undef ($mbi->precision());
-ok (${"$mbi\::div_scale"},40);
-ok (${"$mbi\::round_mode"},'even');
-ok ($mbi->round_mode(),'even');
-
-ok_undef (${"$mbf\::accuracy"});
-ok_undef (${"$mbf\::precision"});
-ok_undef ($mbf->precision());
-ok_undef ($mbf->precision());
-ok (${"$mbf\::div_scale"},40);
-ok (${"$mbf\::round_mode"},'even');
-ok ($mbf->round_mode(),'even');
+{
+ no strict 'refs';
+ ok_undef (${"$mbi\::accuracy"});
+ ok_undef (${"$mbi\::precision"});
+ ok_undef ($mbi->accuracy());
+ ok_undef ($mbi->precision());
+ ok (${"$mbi\::div_scale"},40);
+ ok (${"$mbi\::round_mode"},'even');
+ ok ($mbi->round_mode(),'even');
+
+ ok_undef (${"$mbf\::accuracy"});
+ ok_undef (${"$mbf\::precision"});
+ ok_undef ($mbf->precision());
+ ok_undef ($mbf->precision());
+ ok (${"$mbf\::div_scale"},40);
+ ok (${"$mbf\::round_mode"},'even');
+ ok ($mbf->round_mode(),'even');
+}
# accessors
foreach my $class ($mbi,$mbf)
ok_undef ($class->precision(undef));
}
-# accuracy
-foreach (qw/5 42 -1 0/)
- {
- ok (${"$mbf\::accuracy"} = $_,$_);
- ok (${"$mbi\::accuracy"} = $_,$_);
- }
-ok_undef (${"$mbf\::accuracy"} = undef);
-ok_undef (${"$mbi\::accuracy"} = undef);
+{
+ no strict 'refs';
+ # accuracy
+ foreach (qw/5 42 -1 0/)
+ {
+ ok (${"$mbf\::accuracy"} = $_,$_);
+ ok (${"$mbi\::accuracy"} = $_,$_);
+ }
+ ok_undef (${"$mbf\::accuracy"} = undef);
+ ok_undef (${"$mbi\::accuracy"} = undef);
-# precision
-foreach (qw/5 42 -1 0/)
- {
- ok (${"$mbf\::precision"} = $_,$_);
- ok (${"$mbi\::precision"} = $_,$_);
- }
-ok_undef (${"$mbf\::precision"} = undef);
-ok_undef (${"$mbi\::precision"} = undef);
+ # precision
+ foreach (qw/5 42 -1 0/)
+ {
+ ok (${"$mbf\::precision"} = $_,$_);
+ ok (${"$mbi\::precision"} = $_,$_);
+ }
+ ok_undef (${"$mbf\::precision"} = undef);
+ ok_undef (${"$mbi\::precision"} = undef);
-# fallback
-foreach (qw/5 42 1/)
- {
- ok (${"$mbf\::div_scale"} = $_,$_);
- ok (${"$mbi\::div_scale"} = $_,$_);
- }
-# illegal values are possible for fallback due to no accessor
+ # fallback
+ foreach (qw/5 42 1/)
+ {
+ ok (${"$mbf\::div_scale"} = $_,$_);
+ ok (${"$mbi\::div_scale"} = $_,$_);
+ }
+ # illegal values are possible for fallback due to no accessor
-# round_mode
-foreach (qw/odd even zero trunc +inf -inf/)
- {
- ok (${"$mbf\::round_mode"} = $_,$_);
- ok (${"$mbi\::round_mode"} = $_,$_);
- }
-${"$mbf\::round_mode"} = 'zero';
-ok (${"$mbf\::round_mode"},'zero');
-ok (${"$mbi\::round_mode"},'-inf'); # from above
+ # round_mode
+ foreach (qw/odd even zero trunc +inf -inf/)
+ {
+ ok (${"$mbf\::round_mode"} = $_,$_);
+ ok (${"$mbi\::round_mode"} = $_,$_);
+ }
+ ${"$mbf\::round_mode"} = 'zero';
+ ok (${"$mbf\::round_mode"},'zero');
+ ok (${"$mbi\::round_mode"},'-inf'); # from above
+
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = undef;
+}
-${"$mbi\::accuracy"} = undef;
-${"$mbi\::precision"} = undef;
# local copies
$x = $mbf->new('123.456');
ok_undef ($x->accuracy());
ok ($x->precision(5),5);
ok_undef ($x->precision(undef),undef);
-# see if MBF changes MBIs values
-ok (${"$mbi\::accuracy"} = 42,42);
-ok (${"$mbf\::accuracy"} = 64,64);
-ok (${"$mbi\::accuracy"},42); # should be still 42
-ok (${"$mbf\::accuracy"},64); # should be now 64
+{
+ no strict 'refs';
+ # see if MBF changes MBIs values
+ ok (${"$mbi\::accuracy"} = 42,42);
+ ok (${"$mbf\::accuracy"} = 64,64);
+ ok (${"$mbi\::accuracy"},42); # should be still 42
+ ok (${"$mbf\::accuracy"},64); # should be now 64
+}
###############################################################################
# see if creating a number under set A or P will round it
-${"$mbi\::accuracy"} = 4;
-${"$mbi\::precision"} = undef;
+{
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = 4;
+ ${"$mbi\::precision"} = undef;
-ok ($mbi->new(123456),123500); # with A
-${"$mbi\::accuracy"} = undef;
-${"$mbi\::precision"} = 3;
-ok ($mbi->new(123456),123000); # with P
+ ok ($mbi->new(123456),123500); # with A
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = 3;
+ ok ($mbi->new(123456),123000); # with P
-${"$mbf\::accuracy"} = 4;
-${"$mbf\::precision"} = undef;
-${"$mbi\::precision"} = undef;
+ ${"$mbf\::accuracy"} = 4;
+ ${"$mbf\::precision"} = undef;
+ ${"$mbi\::precision"} = undef;
-ok ($mbf->new('123.456'),'123.5'); # with A
-${"$mbf\::accuracy"} = undef;
-${"$mbf\::precision"} = -1;
-ok ($mbf->new('123.456'),'123.5'); # with P from MBF, not MBI!
+ ok ($mbf->new('123.456'),'123.5'); # with A
+ ${"$mbf\::accuracy"} = undef;
+ ${"$mbf\::precision"} = -1;
+ ok ($mbf->new('123.456'),'123.5'); # with P from MBF, not MBI!
-${"$mbf\::precision"} = undef; # reset
+ ${"$mbf\::precision"} = undef; # reset
+}
###############################################################################
# see if MBI leaves MBF's private parts alone
-${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
-${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
-ok ($mbf->new('123.456'),'123.456');
-${"$mbi\::accuracy"} = undef; # reset
+{
+ no strict 'refs';
+ ${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
+ ${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
+ ok ($mbf->new('123.456'),'123.456');
+ ${"$mbi\::accuracy"} = undef; # reset
+}
###############################################################################
# see if setting accuracy/precision actually rounds the number
$x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2);
$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
+# does $x->bdiv($y,d) work when $d > div_scale?
+$x = $mbf->new('0.008'); $x->accuracy(8);
+
+for my $e ( 4, 8, 16, 32 )
+ {
+ print "# Tried: $x->bdiv(3,$e)\n"
+ unless ok (scalar $x->copy()->bdiv(3,$e), '0.002' . ('6' x ($e-2)) . '7');
+ }
+
# does accuracy()/precision work on zeros?
-foreach my $class ($mbi,$mbf)
+foreach my $c ($mbi,$mbf)
{
- $x = $class->bzero(); $x->accuracy(5); ok ($x->{_a},5);
- $x = $class->bzero(); $x->precision(5); ok ($x->{_p},5);
- $x = $class->new(0); $x->accuracy(5); ok ($x->{_a},5);
- $x = $class->new(0); $x->precision(5); ok ($x->{_p},5);
+ $x = $c->bzero(); $x->accuracy(5); ok ($x->{_a},5);
+ $x = $c->bzero(); $x->precision(5); ok ($x->{_p},5);
+ $x = $c->new(0); $x->accuracy(5); ok ($x->{_a},5);
+ $x = $c->new(0); $x->precision(5); ok ($x->{_p},5);
- $x = $class->bzero(); $x->round(5); ok ($x->{_a},5);
- $x = $class->bzero(); $x->round(undef,5); ok ($x->{_p},5);
- $x = $class->new(0); $x->round(5); ok ($x->{_a},5);
- $x = $class->new(0); $x->round(undef,5); ok ($x->{_p},5);
+ $x = $c->bzero(); $x->round(5); ok ($x->{_a},5);
+ $x = $c->bzero(); $x->round(undef,5); ok ($x->{_p},5);
+ $x = $c->new(0); $x->round(5); ok ($x->{_a},5);
+ $x = $c->new(0); $x->round(undef,5); ok ($x->{_p},5);
# see if trying to increasing A in bzero() doesn't do something
- $x = $class->bzero(); $x->{_a} = 3; $x->round(5); ok ($x->{_a},3);
+ $x = $c->bzero(); $x->{_a} = 3; $x->round(5); ok ($x->{_a},3);
+ }
+
+###############################################################################
+# 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())
+
+foreach my $c ($mbi,$mbf)
+ {
+# ${"$c\::precision"} = undef; # reset
+# ${"$c\::accuracy"} = undef; # reset
+
+ ok ($c->new(123)->badd(123),246);
+ ok ($c->badd(123,321),444);
+ ok ($c->badd(123,$c->new(321)),444);
+
+ ok ($c->new(123)->bsub(122),1);
+ ok ($c->bsub(321,123),198);
+ ok ($c->bsub(321,$c->new(123)),198);
+
+ ok ($c->new(123)->bmul(123),15129);
+ ok ($c->bmul(123,123),15129);
+ ok ($c->bmul(123,$c->new(123)),15129);
+
+# ok ($c->new(15129)->bdiv(123),123);
+# ok ($c->bdiv(15129,123),123);
+# ok ($c->bdiv(15129,$c->new(123)),123);
+
+ ok ($c->new(15131)->bmod(123),2);
+ ok ($c->bmod(15131,123),2);
+ ok ($c->bmod(15131,$c->new(123)),2);
+
+ ok ($c->new(2)->bpow(16),65536);
+ ok ($c->bpow(2,16),65536);
+ ok ($c->bpow(2,$c->new(16)),65536);
+
+# ok ($c->new(2**15)->brsft(1),2**14);
+# ok ($c->brsft(2**15,1),2**14);
+# ok ($c->brsft(2**15,$c->new(1)),2**14);
+
+ ok ($c->new(2**13)->blsft(1),2**14);
+ ok ($c->blsft(2**13,1),2**14);
+ ok ($c->blsft(2**13,$c->new(1)),2**14);
}
###############################################################################
$z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900);
$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
-# breakage:
+my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
+# these should warn, since '3.17' is a NaN in BigInt and thus >= returns undef
+$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1);
+print "# Got: '$warn'\n" unless
+ok ($warn =~ /^Use of uninitialized value in numeric le \(<=\) at/);
+$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1);
+print "# Got: '$warn'\n" unless
+ok ($warn =~ /^Use of uninitialized value in numeric ge \(>=\) at/);
+
+# XXX TODO breakage:
# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
# $z = $y * $u; ok ($z,5); ok (ref($z),$mbi);
# $z = $y + $x; ok ($z,12); ok (ref($z),$mbi);
###############################################################################
# rounding in bdiv with fallback and already set A or P
-${"$mbf\::accuracy"} = undef;
-${"$mbf\::precision"} = undef;
-${"$mbf\::div_scale"} = 40;
+{
+ no strict 'refs';
+ ${"$mbf\::accuracy"} = undef;
+ ${"$mbf\::precision"} = undef;
+ ${"$mbf\::div_scale"} = 40;
+}
-$x = $mbf->new(10); $x->{_a} = 4;
-ok ($x->bdiv(3),'3.333');
-ok ($x->{_a},4); # set's it since no fallback
+ $x = $mbf->new(10); $x->{_a} = 4;
+ ok ($x->bdiv(3),'3.333');
+ ok ($x->{_a},4); # set's it since no fallback
$x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
ok ($x->bdiv($y),'3.333');
ok ($x->bdiv(3,undef,-2),'3.33');
# round in div with requested P greater than fallback
-${"$mbf\::div_scale"} = 5;
-$x = $mbf->new(10);
-ok ($x->bdiv(3,undef,-8),'3.33333333');
-${"$mbf\::div_scale"} = 40;
+{
+ no strict 'refs';
+ ${"$mbf\::div_scale"} = 5;
+ $x = $mbf->new(10);
+ ok ($x->bdiv(3,undef,-8),'3.33333333');
+ ${"$mbf\::div_scale"} = 40;
+}
$x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4;
ok ($x->bdiv($y),'3.333');
###############################################################################
# find out whether _find_round_parameters is doing what's it's supposed to do
-
-${"$mbi\::accuracy"} = undef;
-${"$mbi\::precision"} = undef;
-${"$mbi\::div_scale"} = 40;
-${"$mbi\::round_mode"} = 'odd';
-
+
+{
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = undef;
+ ${"$mbi\::div_scale"} = 40;
+ ${"$mbi\::round_mode"} = 'odd';
+}
+
$x = $mbi->new(123);
my @params = $x->_find_round_parameters();
ok (scalar @params,1); # nothing to round
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
-${"$mbi\::accuracy"} = 1;
-@params = $x->_find_round_parameters(undef,-2);
-ok (scalar @params,1); # error, A and P defined
-ok ($params[0],$x); # self
-
-${"$mbi\::accuracy"} = undef;
-${"$mbi\::precision"} = 1;
-@params = $x->_find_round_parameters(1,undef);
-ok (scalar @params,1); # error, A and P defined
-ok ($params[0],$x); # self
-
-${"$mbi\::precision"} = undef; # reset
+{
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = 1;
+ @params = $x->_find_round_parameters(undef,-2);
+ ok (scalar @params,1); # error, A and P defined
+ ok ($params[0],$x); # self
+
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = 1;
+ @params = $x->_find_round_parameters(1,undef);
+ ok (scalar @params,1); # error, A and P defined
+ ok ($params[0],$x); # self
+
+ ${"$mbi\::precision"} = undef; # reset
+}
###############################################################################
# test whether bone/bzero take additional A & P, or reset it etc
# check whether mixing A and P creates a NaN
# new with set accuracy/precision and with parameters
-
-foreach my $c ($mbi,$mbf)
- {
- 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;
- }
+{
+ no strict 'refs';
+ foreach my $c ($mbi,$mbf)
+ {
+ 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
foreach my $class ($mbi,$mbf)
}
print "# INC = @INC\n";
- plan tests => 617
+ plan tests => 661
+ 16; # own tests
}
-use Math::BigInt 1.60;
-use Math::BigFloat 1.35;
+use Math::BigInt 1.62;
+use Math::BigFloat 1.37;
use vars qw/$mbi $mbf/;
}
print "# INC = @INC\n";
- plan tests => 1627
+ plan tests => 1643
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2552
+ plan tests => 2527
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 617;
+ plan tests => 661;
}
use Math::BigInt::Subclass;
} # endwhile data tests
close DATA;
+my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
+
+# these should not warn
+$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1); ok ($warn, '');
+$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1); ok ($warn, '');
+
# all tests done
1;
}
print "# INC = @INC\n";
- plan tests => 2068
+ plan tests => 2072
+ 2; # our own tests
}
}
print "# INC = @INC\n";
- plan tests => 1627
+ plan tests => 1643
+ 1;
}
use strict;
use Exporter;
-use Math::BigFloat(1.27);
+use Math::BigFloat(1.30);
use vars qw($VERSION @ISA $PACKAGE
$accuracy $precision $round_mode $div_scale);
projects / p5sagit/p5-mst-13.2.git / commitdiff