diff options
author | Tels <nospam-abuse@bloodgate.com> | 2002-08-21 21:12:59 +0200 |
---|---|---|
committer | hv <hv@crypt.org> | 2002-08-22 19:42:58 +0000 |
commit | 56d9de6816913bcb7b0068c30f7fa91039be4429 (patch) | |
tree | 31e0a05a2c61ad2046db94890888c91f2ef40ab5 /lib/Math | |
parent | 11f72409a81d362ab963d688ed5b84835e953fd8 (diff) | |
download | perl-56d9de6816913bcb7b0068c30f7fa91039be4429.tar.gz |
ANNOUNCE: Math-BigInt v1.62
Message-Id: <200208211513.g7LFDUs02512@crypt.org>
p4raw-id: //depot/perl@17754
Diffstat (limited to 'lib/Math')
-rw-r--r-- | lib/Math/BigFloat.pm | 64 | ||||
-rw-r--r-- | lib/Math/BigInt.pm | 434 | ||||
-rw-r--r-- | lib/Math/BigInt/Calc.pm | 176 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bare_mbf.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bare_mbi.t | 4 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bare_mif.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bigfltpm.inc | 130 | ||||
-rwxr-xr-x | lib/Math/BigInt/t/bigfltpm.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bigintc.t | 169 | ||||
-rw-r--r-- | lib/Math/BigInt/t/bigintpm.inc | 139 | ||||
-rwxr-xr-x | lib/Math/BigInt/t/bigintpm.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/calling.t | 12 | ||||
-rw-r--r-- | lib/Math/BigInt/t/constant.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/mbimbf.inc | 333 | ||||
-rw-r--r-- | lib/Math/BigInt/t/mbimbf.t | 6 | ||||
-rwxr-xr-x | lib/Math/BigInt/t/sub_mbf.t | 2 | ||||
-rwxr-xr-x | lib/Math/BigInt/t/sub_mbi.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/sub_mif.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/upgrade.inc | 6 | ||||
-rw-r--r-- | lib/Math/BigInt/t/upgrade.t | 2 | ||||
-rw-r--r-- | lib/Math/BigInt/t/with_sub.t | 2 |
21 files changed, 900 insertions, 593 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index a12cf28a84..f58aaa7fe5 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -12,7 +12,7 @@ package Math::BigFloat; # _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; @@ -307,9 +307,10 @@ sub bsstr 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 @@ -344,6 +345,9 @@ sub bcmp ($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 @@ -407,6 +411,9 @@ sub bacmp ($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} !~ /^[+-]$/) { @@ -656,7 +663,7 @@ sub blog 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; @@ -915,7 +922,6 @@ sub bdiv # 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 @@ -931,10 +937,12 @@ sub bdiv # 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) @@ -1210,7 +1218,7 @@ sub _pow2 } # 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; @@ -1320,7 +1328,7 @@ sub _pow } # 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; @@ -1752,7 +1760,6 @@ sub import 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 @@ -1852,7 +1859,44 @@ sub bnorm } ############################################################################## -# 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 { diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 5a1385d519..eef5b3cb67 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,8 +18,7 @@ package Math::BigInt; 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); @@ -413,7 +412,7 @@ sub new 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); @@ -663,9 +662,7 @@ sub bsstr 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(); } @@ -688,7 +685,8 @@ sub numify { # 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; @@ -871,6 +869,9 @@ sub bcmp ($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 @@ -913,6 +914,9 @@ sub bacmp ($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 @@ -1481,25 +1485,25 @@ sub bmod 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 @@ -1507,11 +1511,14 @@ sub bmodinv 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()); @@ -1521,21 +1528,37 @@ sub bmodinv # 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; } @@ -2133,6 +2156,11 @@ sub bround # we have fewer digits than we want to scale to my $len = $x->length(); + # convert $scale to a scalar in case it is an object (put's a limit on the + # number length, but this would already limited by memory constraints), makes + # it faster + $scale = $scale->numify() if ref ($scale); + # scale < 0, but > -len (not >=!) if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) { @@ -2149,7 +2177,7 @@ sub bround 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; @@ -2187,7 +2215,7 @@ sub bround 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) @@ -2544,10 +2572,12 @@ sub _split # 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? @@ -2556,8 +2586,8 @@ sub _split $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 ''; @@ -2713,104 +2743,109 @@ Math::BigInt - Arbitrary size integer math package $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 @@ -2836,12 +2871,9 @@ zeros suppressed. =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. @@ -2865,27 +2897,60 @@ return either undef, <0, 0 or >0 and are suited for sort. =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: @@ -2906,6 +2971,45 @@ represents the accuracy that will be in effect for $x: 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); @@ -3055,44 +3159,44 @@ numbers. =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 @@ -3100,74 +3204,78 @@ C<bgcd($num, $mod)==1>. =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 @@ -3185,11 +3293,11 @@ does change $x in BigFloat. =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 @@ -3214,31 +3322,31 @@ Return the signed mantissa of $x as BigInt. =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 diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index eb20e69b9f..44e4c9b89b 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -8,7 +8,7 @@ require Exporter; 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 @@ -368,7 +368,7 @@ sub _inc { # (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) @@ -384,7 +384,7 @@ sub _dec { # (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 @@ -430,43 +430,6 @@ sub _sub __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) @@ -494,10 +457,6 @@ sub _mul_use_mul # 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) { @@ -576,9 +535,6 @@ sub _mul_use_div # 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) { @@ -908,48 +864,35 @@ sub _acmp 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 @@ -967,7 +910,7 @@ 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 @@ -1166,6 +1109,14 @@ sub _rsft # 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) @@ -1276,7 +1227,6 @@ sub _fac my $n = _copy($c,$cx); $cx = [$last]; - #$cx = _one(); while (!(@$n == 1 && $n->[0] == $step)) { _mul($c,$cx,$n); _dec($c,$n); @@ -1284,21 +1234,21 @@ sub _fac $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; } @@ -1307,17 +1257,17 @@ sub _sqrt # 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; } @@ -1325,15 +1275,14 @@ sub _sqrt 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 @@ -1343,11 +1292,11 @@ sub _sqrt $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(); @@ -1360,7 +1309,7 @@ sub _sqrt $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? @@ -1600,38 +1549,35 @@ sub _from_bin ############################################################################## # 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 diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index fbf8f055b9..9548fe80c6 100644 --- a/lib/Math/BigInt/t/bare_mbf.t +++ b/lib/Math/BigInt/t/bare_mbf.t @@ -27,7 +27,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1627; + plan tests => 1643; } use Math::BigFloat lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index c725e5af55..b2d5446ba8 100644 --- a/lib/Math/BigInt/t/bare_mbi.t +++ b/lib/Math/BigInt/t/bare_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2552; + plan tests => 2527; } use Math::BigInt lib => 'BareCalc'; @@ -37,7 +37,7 @@ use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $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 diff --git a/lib/Math/BigInt/t/bare_mif.t b/lib/Math/BigInt/t/bare_mif.t index faaef9db33..b38532a797 100644 --- a/lib/Math/BigInt/t/bare_mif.t +++ b/lib/Math/BigInt/t/bare_mif.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 617 + plan tests => 661 + 1; # our onw tests } diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index 67bd54e164..774e26e208 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -2,6 +2,8 @@ ok ($class->config()->{lib},$CL); +use strict; + while (<DATA>) { chomp; @@ -51,18 +53,14 @@ while (<DATA>) } 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") { @@ -158,8 +156,8 @@ ok ($y,1200); ok ($x,1200); 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); @@ -189,11 +187,19 @@ ok ($class->finf('+'),'inf'); ok ($class->finf('-'),'-inf'); ok ($class->finf('-inf'),'-inf'); +$class->accuracy(undef); $class->precision(undef); # reset + +############################################################################### +# bug in bsstr()/numify() showed up in after-rounding in bdiv() + +$x = $class->new('0.008'); $y = $class->new(2); +$x->bdiv(3,$y); +ok ($x,'0.0027'); + ############################################################################### # fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() # correctly modifies $x -$class->accuracy(undef); $class->precision(undef); # reset $x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); @@ -202,55 +208,26 @@ $x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); $class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); -# 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 @@ -329,17 +306,56 @@ fnormNaN:NaN -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 @@ -358,7 +374,11 @@ abc::1 +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 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 33614039bd..bab134f25f 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1627 + plan tests => 1643 + 2; # own tests } diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 26530ca6e1..22e64c5f2c 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -7,22 +7,19 @@ BEGIN { $| = 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"); @@ -61,15 +58,54 @@ my ($re,$rr) = $C->_div($x,$y); 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"); @@ -81,8 +117,12 @@ ok ($C->_digit($x,-2),2); 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); @@ -105,6 +145,10 @@ ok (${$C->_str($C->_rsft($x,$y,10))},20); $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"); @@ -113,6 +157,27 @@ ok ($C->_acmp($y,$x),1); 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); @@ -122,7 +187,12 @@ $x = $C->_new(\"123"); $y = $C->_new(\"1111"); ($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'); @@ -136,12 +206,41 @@ $x = $C->_new(\"4"); ok (${$C->_str($C->_fac($x))},'24'); $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); @@ -152,6 +251,7 @@ $x = $C->_new(\$x); $C->_dec($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); @@ -180,9 +280,38 @@ ok ($C->_check($x),0); 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); diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index fa5b6f0de1..9f3a1abc5c 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -2,6 +2,8 @@ my $version = ${"$class\::VERSION"}; +use strict; + ############################################################################## # for testing inheritance of _swap @@ -63,22 +65,18 @@ while (<DATA>) $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();'; @@ -92,6 +90,7 @@ while (<DATA>) $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") { @@ -430,6 +429,29 @@ $z = 1e+129; # definitely a float (may fail on UTS) $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 @@ -481,9 +503,10 @@ $x = $class->new('+inf'); ok ($x,'inf'); ############################################################################### ############################################################################### -# 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 @@ -736,86 +759,6 @@ NaN:inf: -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 @@ -1102,10 +1045,22 @@ abc:abc: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 @@ -1499,6 +1454,8 @@ abc:5:NaN 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 diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index b4c4f111dd..be3e3596c9 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -10,7 +10,7 @@ BEGIN 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; diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t index b905385344..3b0ff41dd4 100644 --- a/lib/Math/BigInt/t/calling.t +++ b/lib/Math/BigInt/t/calling.t @@ -30,10 +30,11 @@ BEGIN 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; } } @@ -58,7 +59,7 @@ use Math::BigInt; 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 @@ -164,6 +165,7 @@ inf:1 &bstr 5:5 10:10 +-10:-10 abc:NaN '+inf':inf '-inf':-inf @@ -172,6 +174,10 @@ abc:NaN 0:0e+1 2:2e+0 200:2e+2 +-5:-5e+0 +-100:-1e+2 +abc:NaN +'+inf':inf &babs -1:1 1:1 diff --git a/lib/Math/BigInt/t/constant.t b/lib/Math/BigInt/t/constant.t index 2f14de2a81..3304d16680 100644 --- a/lib/Math/BigInt/t/constant.t +++ b/lib/Math/BigInt/t/constant.t @@ -21,7 +21,7 @@ use Math::BigInt ':constant'; ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968'); { - no warnings 'portable'; + local $^W = 0; # protect against "non-portable" warnings # hexadecimal constants ok (0x123456789012345678901234567890, Math::BigInt->new('0x123456789012345678901234567890')); diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc index d33d6b5447..77f63803c1 100644 --- a/lib/Math/BigInt/t/mbimbf.inc +++ b/lib/Math/BigInt/t/mbimbf.inc @@ -4,26 +4,30 @@ # 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) @@ -49,44 +53,48 @@ 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()); @@ -96,41 +104,50 @@ ok_undef ($x->precision()); 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 @@ -186,21 +203,72 @@ ok_undef ($x->precision()); $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); } ############################################################################### @@ -293,7 +361,16 @@ $z = $u->copy()->bmul($y,undef,2,'odd'); ok ($z,30860); $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); @@ -302,13 +379,16 @@ $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5); ############################################################################### # 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'); @@ -323,10 +403,13 @@ $x = $mbf->new(10); 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'); @@ -488,12 +571,15 @@ ok ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46 ############################################################################### # 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 @@ -526,18 +612,21 @@ ok ($params[3],'+inf'); # round_mode 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 @@ -592,16 +681,18 @@ for my $c ($mbi,$mbf) # 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) diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index 4a63296023..fcc9554b79 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -31,12 +31,12 @@ BEGIN } 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/; diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 93c2dbf1d8..dbd68f10d4 100755 --- a/lib/Math/BigInt/t/sub_mbf.t +++ b/lib/Math/BigInt/t/sub_mbf.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1627 + plan tests => 1643 + 6; # + our own tests } diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index a68113d4f4..9953f4b802 100755 --- a/lib/Math/BigInt/t/sub_mbi.t +++ b/lib/Math/BigInt/t/sub_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2552 + plan tests => 2527 + 5; # +5 own tests } diff --git a/lib/Math/BigInt/t/sub_mif.t b/lib/Math/BigInt/t/sub_mif.t index 3db96ff97a..8e5656bbf0 100644 --- a/lib/Math/BigInt/t/sub_mif.t +++ b/lib/Math/BigInt/t/sub_mif.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 617; + plan tests => 661; } use Math::BigInt::Subclass; diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc index fc70873e0c..4bb5d35fd3 100644 --- a/lib/Math/BigInt/t/upgrade.inc +++ b/lib/Math/BigInt/t/upgrade.inc @@ -212,6 +212,12 @@ while (<DATA>) } # 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; diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t index 28d2ce1dac..6c087a5348 100644 --- a/lib/Math/BigInt/t/upgrade.t +++ b/lib/Math/BigInt/t/upgrade.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2068 + plan tests => 2072 + 2; # our own tests } diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t index f70b9baced..226533252e 100644 --- a/lib/Math/BigInt/t/with_sub.t +++ b/lib/Math/BigInt/t/with_sub.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1627 + plan tests => 1643 + 1; } |