From: Jarkko Hietaniemi Date: Wed, 21 Nov 2001 15:17:13 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.47. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=027dc3881cf72be7400bcb34bc5555fc060cbbc5;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.47. p4raw-id: //depot/perl@13172 --- diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 0670d50..a490e62 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -11,7 +11,7 @@ package Math::BigFloat; -$VERSION = '1.24'; +$VERSION = '1.25'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -29,7 +29,7 @@ use Math::BigInt qw/objectify/; #@EXPORT = qw( ); use strict; -use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode/; +use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/; my $class = "Math::BigFloat"; use overload @@ -55,6 +55,18 @@ $accuracy = undef; $precision = undef; $div_scale = 40; +############################################################################## +# the old code had $rnd_mode, so we need to support it, too + +$rnd_mode = 'even'; +sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } +sub FETCH { return $round_mode; } +sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } + +BEGIN { tie $rnd_mode, 'Math::BigFloat'; } + +############################################################################## + # in case we call SUPER::->foo() and this wants to call modify() # sub modify () { 0; } @@ -97,7 +109,7 @@ sub new if ((ref($wanted)) && (ref($wanted) ne $class)) { $self->{_m} = $wanted->as_number(); # get us a bigint copy - $self->{_e} = Math::BigInt->new(0); + $self->{_e} = Math::BigInt->bzero(); $self->{_m}->babs(); $self->{sign} = $wanted->sign(); return $self->bnorm(); @@ -106,8 +118,8 @@ sub new # handle '+inf', '-inf' first if ($wanted =~ /^[+-]?inf$/) { - $self->{_e} = Math::BigInt->new(0); - $self->{_m} = Math::BigInt->new(0); + $self->{_e} = Math::BigInt->bzero(); + $self->{_m} = Math::BigInt->bzero(); $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self->bnorm(); @@ -117,18 +129,18 @@ sub new if (!ref $mis) { die "$wanted is not a number initialized to $class" if !$NaNOK; - $self->{_e} = Math::BigInt->new(0); - $self->{_m} = Math::BigInt->new(0); + $self->{_e} = Math::BigInt->bzero(); + $self->{_m} = Math::BigInt->bzero(); $self->{sign} = $nan; } else { # make integer from mantissa by adjusting exp, then convert to bigint $self->{_e} = Math::BigInt->new("$$es$$ev"); # exponent - $self->{_m} = Math::BigInt->new("$$mis$$miv$$mfv"); # create mantissa + $self->{_m} = Math::BigInt->new("$$miv$$mfv"); # create mantissa # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 - $self->{_e} -= CORE::length($$mfv); - $self->{sign} = $self->{_m}->sign(); $self->{_m}->babs(); + $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0; + $self->{sign} = $$mis; } #print "$wanted => $self->{sign} $self->{value}\n"; $self->bnorm(); # first normalize @@ -1455,11 +1467,9 @@ This might change in the future, so do not depend on it. See also: L. -Math::BigFloat supports both precision and accuracy. (here should follow -a short description of both). - -Precision: digits after the '.', laber, schwad -Accuracy: Significant digits blah blah +Math::BigFloat supports both precision and accuracy. For a full documentation, +examples and tips on these topics please see the large section in +L. Since things like sqrt(2) or 1/3 must presented with a limited precision lest a operation consumes all resources, each operation produces no more than diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 663b927..a1b7b8f 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -10,7 +10,6 @@ # _a : accuracy # _p : precision # _f : flags, used by MBF to flag parts of a float as untouchable -# _cow : copy on write: number of objects that share the data (NRY) # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since # underlying lib might change the reference! @@ -19,21 +18,19 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.46'; +$VERSION = '1.47'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub - bgcd blcm - bround + bgcd blcm bround blsft brsft band bior bxor bnot bpow bnan bzero bacmp bstr bsstr binc bdec binf bfloor bceil is_odd is_even is_zero is_one is_nan is_inf sign is_positive is_negative - length as_number - objectify _swap + length as_number objectify _swap ); #@EXPORT = qw( ); -use vars qw/$round_mode $accuracy $precision $div_scale/; +use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/; use strict; # Inside overload, the first arg is always an object. If the original code had @@ -66,12 +63,18 @@ use overload '-=' => sub { $_[0]->bsub($_[1]); }, '*=' => sub { $_[0]->bmul($_[1]); }, '/=' => sub { scalar $_[0]->bdiv($_[1]); }, +'%=' => sub { $_[0]->bmod($_[1]); }, +'^=' => sub { $_[0]->bxor($_[1]); }, +'&=' => sub { $_[0]->band($_[1]); }, +'|=' => sub { $_[0]->bior($_[1]); }, '**=' => sub { $_[0]->bpow($_[1]); }, +'..' => \&_pointpoint, + '<=>' => sub { $_[2] ? ref($_[0])->bcmp($_[1],$_[0]) : ref($_[0])->bcmp($_[0],$_[1])}, -'cmp' => sub { +'cmp' => sub { $_[2] ? $_[1] cmp $_[0]->bstr() : $_[0]->bstr() cmp $_[1] }, @@ -106,9 +109,10 @@ use overload return $t; }, -qw( -"" bstr -0+ numify), # Order of arguments unsignificant +# the original qw() does not work with the TIESCALAR below, why? +# Order of arguments unsignificant +'""' => sub { $_[0]->bstr(); }, +'0+' => sub { $_[0]->numify(); } ; ############################################################################## @@ -127,6 +131,18 @@ $accuracy = undef; $precision = undef; $div_scale = 40; +############################################################################## +# the old code had $rnd_mode, so we need to support it, too + +$rnd_mode = 'even'; +sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } +sub FETCH { return $round_mode; } +sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } + +BEGIN { tie $rnd_mode, 'Math::BigInt'; } + +############################################################################## + sub round_mode { no strict 'refs'; @@ -279,7 +295,7 @@ sub copy { if ($k eq 'value') { - $self->{$k} = $CALC->_copy($x->{$k}); + $self->{value} = $CALC->_copy($x->{value}); } elsif (ref($x->{$k}) eq 'SCALAR') { @@ -491,7 +507,7 @@ sub bstr # make a string from bigint object my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - + if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN @@ -608,7 +624,7 @@ sub round sub bnorm { - # (numstr or or BINT) return BINT + # (numstr or BINT) return BINT # Normalize number -- no-op here my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x; @@ -1010,24 +1026,6 @@ sub bmul $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math return $x->round($a,$p,$r,$y); - - # from http://groups.google.com/groups?selm=3BBF69A6.72E1%40pointecom.net - # - # my $yc = $y->copy(); # make copy of second argument - # my $carry = $self->bzero(); - # - # # XXX - # while ($yc > 1) - # { - # #print "$x\t$yc\t$carry\n"; - # $carry += $x if $yc->is_odd(); - # $yc->brsft(1,2); - # $x->blsft(1,2); - # } - # $x += $carry; - # #print "result $x\n"; - # - # return $x->round($a,$p,$r,$y); } sub _div_inf @@ -1128,7 +1126,6 @@ sub bdiv $x->{sign} = '+' if $CALC->_is_zero($x->{value}); $x->round($a,$p,$r,$y); -# print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n"; if (wantarray) { if (! $CALC->_is_zero($rem->{value})) @@ -1176,7 +1173,7 @@ sub bmod } else { - $x = (&bdiv($self,$x,$y))[1]; + $x = (&bdiv($self,$x,$y))[1]; # slow way } $x->bround($a,$p,$r); } @@ -1211,13 +1208,14 @@ sub bpow $x->{value} = $CALC->_pow($x->{value},$y->{value}); return $x->round($a,$p,$r); } - # based on the assumption that shifting in base 10 is fast, and that mul - # works faster if numbers are small: we count trailing zeros (this step is - # O(1)..O(N), but in case of O(N) we save much more time due to this), - # stripping them out of the multiplication, and add $count * $y zeros - # afterwards like this: - # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6 - # creates deep recursion? + +# based on the assumption that shifting in base 10 is fast, and that mul +# works faster if numbers are small: we count trailing zeros (this step is +# O(1)..O(N), but in case of O(N) we save much more time due to this), +# stripping them out of the multiplication, and add $count * $y zeros +# afterwards like this: +# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6 +# creates deep recursion? # my $zeros = $x->_trailing_zeros(); # if ($zeros > 0) # { @@ -1230,19 +1228,12 @@ sub bpow my $pow2 = $self->__one(); my $y1 = $class->new($y); - my ($res); my $two = $self->new(2); while (!$y1->is_one()) { - # thats a tad (between 8 and 17%) faster for small results - # 7777 ** 7777 is not faster, but 2 ** 150, 3 ** 16, 3 ** 256 etc are $pow2->bmul($x) if $y1->is_odd(); $y1->bdiv($two); - $x->bmul($x) unless $y1->is_zero(); - - # ($y1,$res)=&bdiv($y1,2); - # if (!$res->is_zero()) { &bmul($pow2,$x); } - # if (!$y1->is_zero()) { &bmul($x,$x); } + $x->bmul($x); } $x->bmul($pow2) unless $pow2->is_one(); return $x->round($a,$p,$r); @@ -1259,7 +1250,7 @@ sub blsft $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); + my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); if (defined $t) { $x->{value} = $t; return $x; @@ -1279,7 +1270,7 @@ sub brsft $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); + my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); if (defined $t) { $x->{value} = $t; return $x; @@ -2013,7 +2004,8 @@ 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 - #print "input: '$$x' "; + return if $$x =~ /[Ee].*[Ee]/; # more than one E => error + my ($m,$e) = split /[Ee]/,$$x; $e = '0' if !defined $e || $e eq ""; # print "m '$m' e '$e'\n"; @@ -3146,9 +3138,13 @@ the same terms as Perl itself. =head1 SEE ALSO -L and L. +L and L as well as L, +L and L. -L and L. +The package at +L contains +more documentation including a full version history, testcases, empty +subclass files and benchmarks. =head1 AUTHORS diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 24a6640..ba7483f 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -8,12 +8,13 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.14'; +$VERSION = '0.16'; # Package to store unsigned big integers in decimal and do math with them # Internally the numbers are stored in an array with at least 1 element, no -# leading zero parts (except the first) and in base 100000 +# leading zero parts (except the first) and in base 1eX where X is determined +# automatically at loading time to be the maximum possible value # todo: # - fully remove funky $# stuff (maybe) @@ -86,7 +87,6 @@ sub _new # Convert a number from string format to internal base 100000 format. # Assumes normalized value as input. my $d = $_[1]; - # print "_new $d $$d\n"; my $il = CORE::length($$d)-1; # these leaves '00000' instead of int 0 and will be corrected after any op return [ reverse(unpack("a" . ($il % $BASE_LEN+1) @@ -105,6 +105,12 @@ sub _one return [ 1 ]; } +sub _two + { + # create a two (for _pow) + return [ 2 ]; + } + sub _copy { return [ @{$_[1]} ]; @@ -232,9 +238,7 @@ sub _sub for $i (@$sx) { last unless defined $sy->[$j] || $car; - #print "x: $i y: $sy->[$j] c: $car\n"; $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++; - #print "x: $i y: $sy->[$j-1] c: $car\n"; } # might leave leading zeros, so fix that __strip_zeros($sx); @@ -246,10 +250,8 @@ sub _sub for $i (@$sx) { last unless defined $sy->[$j] || $car; - #print "$sy->[$j] $i $car => $sx->[$j]\n"; $sy->[$j] += $BASE if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0); - #print "$sy->[$j] $i $car => $sy->[$j]\n"; $j++; } # might leave leading zeros, so fix that @@ -294,7 +296,7 @@ sub _mul_use_mul $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL } $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod; + $xi = shift @prod || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; __strip_zeros($xv); @@ -324,7 +326,7 @@ sub _mul_use_div $prod - ($car = int($prod / $BASE)) * $BASE; } $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod; + $xi = shift @prod || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; __strip_zeros($xv); @@ -524,13 +526,14 @@ sub _mod return $rem; } my $y = $yo->[0]; - # both are single element + # both are single element arrays if (scalar @$x == 1) { $x->[0] %= $y; return $x; } + # @y is single element, but @x has more than one my $b = $BASE % $y; if ($b == 0) { @@ -539,26 +542,31 @@ sub _mod # so need to consider only last element: O(1) $x->[0] %= $y; } + elsif ($b == 1) + { + # else need to go trough all elements: O(N), but loop is a bit simplified + my $r = 0; + foreach (@$x) + { + $r += $_ % $y; + $r %= $y; + } + $r = 0 if $r == $y; + $x->[0] = $r; + } else { - # else need to go trough all elemens: O(N) - # XXX not ready yet - my ($xo,$rem) = _div($c,$x,$yo); - return $rem; - -# my $i = 0; my $r = 1; -# print "Multi: "; -# foreach (@$x) -# { -# print "$_ $r $b $y\n"; -# print "\$_ % \$y = ",$_ % $y,"\n"; -# print "\$_ % \$y * \$b = ",($_ % $y) * $b,"\n"; -# $r += ($_ % $y) * $b; -# print "$r $b $y =>"; -# $r %= $y if $r > $y; -# print " $r\n"; -# } -# $x->[0] = $r; + # else need to go trough all elements: O(N) + my $r = 0; my $bm = 1; + foreach (@$x) + { + $r += ($_ % $y) * $bm; + $bm *= $b; + $bm %= $y; + $r %= $y; + } + $r = 0 if $r == $y; + $x->[0] = $r; } splice (@$x,1); return $x; @@ -595,13 +603,9 @@ sub _rsft while ($dst < $len) { $vd = $z.$x->[$src]; - #print "$dst $src '$vd' "; $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem); - #print "'$vd' "; $src++; $vd = substr($z.$x->[$src],-$rem,$rem) . $vd; - #print "'$vd1' "; - #print "'$vd'\n"; $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN; $x->[$dst] = int($vd); $dst++; @@ -630,19 +634,14 @@ sub _lsft my $rem = $len % $BASE_LEN; # remainder to shift my $dst = $src + int($len/$BASE_LEN); # destination my $vd; # further speedup - #print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n"; $x->[$src] = 0; # avoid first ||0 for speed my $z = '0' x $BASE_LEN; while ($src >= 0) { $vd = $x->[$src]; $vd = $z.$vd; - #print "s $src d $dst '$vd' "; $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem); - #print "'$vd' "; $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem; - #print "'$vd' "; $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN; - #print "'$vd'\n"; $x->[$dst] = int($vd); $dst--; $src--; } @@ -650,12 +649,29 @@ sub _lsft while ($dst >= 0) { $x->[$dst--] = 0; } # fix spurios last zero element splice @$x,-1 if $x->[-1] == 0; - #print "elems: "; my $i = 0; - #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n"; } $x; } +sub _pow + { + # power of $x to $y + # ref to array, ref to array, return ref to array + my ($c,$cx,$cy) = @_; + + my $pow2 = _one(); + my $two = _two(); + my $y1 = _copy($c,$cy); + while (!_is_one($c,$y1)) + { + _mul($c,$pow2,$cx) if _is_odd($c,$y1); + _div($c,$y1,$two); + _mul($c,$cx,$cx); + } + _mul($c,$cx,$pow2) unless _is_one($c,$pow2); + return $cx; + } + ############################################################################## # testing @@ -667,15 +683,12 @@ sub _acmp my ($c,$cx, $cy) = @_; - #print "$cx $cy\n"; my ($i,$a,$x,$y,$k); # calculate length based on digits, not parts $x = _len('',$cx); $y = _len('',$cy); - # print "length: ",($x-$y),"\n"; my $lxy = $x - $y; # if different in length return -1 if $lxy < 0; return 1 if $lxy > 0; - #print "full compare\n"; $i = 0; $a = 0; # 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 @@ -847,17 +860,19 @@ functions can also be used to support Math::Bigint, like Math::BigInt::Pari. =head1 DESCRIPTION -In order to allow for multiple big integer libraries, Math::BigInt -was rewritten to use library modules for core math routines. Any -module which follows the same API as this can be used instead by -using the following call: +In order to allow for multiple big integer libraries, Math::BigInt was +rewritten to use library modules for core math routines. Any module which +follows the same API as this can be used instead by using the following: use Math::BigInt lib => 'libname'; +'libname' is either the long name ('Math::BigInt::Pari'), or only the short +version like 'Pari'. + =head1 EXPORT -The following functions MUST be defined in order to support -the use by Math::BigInt: +The following functions MUST be defined in order to support the use by +Math::BigInt: _new(string) return ref to new object from ref to decimal string _zero() return a new object with value 0 @@ -900,8 +915,8 @@ the use by Math::BigInt: return 0 for ok, otherwise error message as string The following functions are optional, and can be defined if the underlying lib -has a fast way to do them. If undefined, Math::BigInt will use a pure, but -slow, Perl way as fallback to emulate these: +has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence +slow) fallback routines to emulate these: _from_hex(str) return ref to new object from ref to hexadecimal string _from_bin(str) return ref to new object from ref to binary string @@ -944,8 +959,9 @@ returning a different reference. Return values are always references to objects or strings. Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not shift the -argument. This is used to delegate shifting of bases different than 10 back -to Math::BigInt, which will use some generic code to calculate the result. +argument. This is used to delegate shifting of bases different than the one +you can support back to Math::BigInt, which will use some generic code to +calculate the result. =head1 WRAP YOUR OWN diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index c4e2182..7844e72 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -31,53 +31,35 @@ while () $try .= "\$x;"; } elsif ($f eq "finf") { $try .= "\$x->finf('$args[1]');"; - } elsif ($f eq "fnan") { - $try .= "\$x->fnan();"; - } elsif ($f eq "numify") { - $try .= "\$x->numify();"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; } elsif ($f eq "fone") { $try .= "\$x->bone('$args[1]');"; } elsif ($f eq "fstr") { $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; $try .= '$x->fstr();'; - } elsif ($f eq "fsstr") { - $try .= '$x->fsstr();'; } elsif ($f eq "parts") { # ->bstr() to see if an object is returned $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; $try .= '"$a $b";'; - } elsif ($f eq "length") { - $try .= '$x->length();'; } elsif ($f eq "exponent") { # ->bstr() to see if an object is returned $try .= '$x->exponent()->bstr();'; } elsif ($f eq "mantissa") { # ->bstr() to see if an object is returned $try .= '$x->mantissa()->bstr();'; - } elsif ($f eq "fneg") { - $try .= '$x->bneg();'; - } elsif ($f eq "fnorm") { - $try .= '$x->fnorm();'; - } elsif ($f eq "bfloor") { - $try .= '$x->ffloor();'; - } elsif ($f eq "bceil") { - $try .= '$x->fceil();'; - } elsif ($f eq "is_zero") { - $try .= '$x->is_zero();'; - } elsif ($f eq "is_one") { - $try .= '$x->is_one();'; - } elsif ($f eq "is_positive") { - $try .= '$x->is_positive();'; - } elsif ($f eq "is_negative") { - $try .= '$x->is_negative();'; - } elsif ($f eq "is_odd") { - $try .= '$x->is_odd();'; - } elsif ($f eq "is_even") { - $try .= '$x->is_even();'; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "length") { + $try .= "\$x->length();"; + # some unary ops (test the bxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan)$/) { + $try .= "\$x->$f();"; } elsif ($f eq "as_number") { $try .= '$x->as_number();'; - } elsif ($f eq "fabs") { - $try .= '$x->fabs();'; } elsif ($f eq "finc") { $try .= '++$x;'; } elsif ($f eq "fdec") { @@ -135,6 +117,8 @@ while () print "# Tried: '$try'\n" if !ok ($ans1, $ans); if (ref($ans1) eq "$class") { + # float numbers are normalized (for now), so mantissa shouldn't have + # trailing zeros #print $ans1->_trailing_zeros(),"\n"; print "# Has trailing zeros after '$try'\n" if !ok ($ans1->{_m}->_trailing_zeros(), 0); @@ -179,6 +163,14 @@ fnormNaN:NaN -inf:-inf 123:123 -123.4567:-123.4567 +# invalid inputs +1__2:NaN +1E1__2:NaN +11__2E2:NaN +#1.E3:NaN +.2E-3.:NaN +#1e3e4:NaN +.2E2:20 &as_number 0:0 1:1 @@ -929,6 +921,25 @@ nanfsqrt:NaN +123.456:11.11107555549866648462149404118219234119 +15241.38393:123.4559999756998444766131352122991626468 +1.44:1.2 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 &is_odd abc:0 0:0 @@ -1022,7 +1033,7 @@ NaNone:0 1:1 -1:0 -2:0 -&bfloor +&ffloor 0:0 abc:NaN +inf:inf @@ -1031,7 +1042,7 @@ abc:NaN -51:-51 -51.2:-52 12.2:12 -&bceil +&fceil 0:0 abc:NaN +inf:inf diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 8d08d43..5fe1917 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -6,11 +6,32 @@ use strict; BEGIN { $| = 1; - unshift @INC, '../lib'; # for running manually - my $location = $0; $location =~ s/bigfltpm.t//; - unshift @INC, $location; # to locate the testing files - # chdir 't' if -d 't'; - plan tests => 1299; + # to locate the testing files + my $location = $0; $location =~ s/bigfltpm.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + +# unshift @INC, '../lib'; # for running manually +# my $location = $0; $location =~ s/bigfltpm.t//; +# unshift @INC, $location; # to locate the testing files +# # chdir 't' if -d 't'; + + plan tests => 1325; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index adac2d3..87006b0 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -6,12 +6,12 @@ use Test; BEGIN { $| = 1; - # chdir 't' if -d 't'; + chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually plan tests => 56; } -# testing of Math::BigInt::BitVect, primarily for interface/api and not for the +# testing of Math::BigInt::Calc, primarily for interface/api and not for the # math functionality use Math::BigInt::Calc; @@ -23,7 +23,6 @@ my $x = $C->_new(\"123"); my $y = $C->_new(\"321"); ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321); # _add, _sub, _mul, _div - ok (${$C->_str($C->_add($x,$y))},444); ok (${$C->_str($C->_sub($x,$y))},123); ok (${$C->_str($C->_mul($x,$y))},39483); diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 0b4147c..e85c5c3 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -60,18 +60,9 @@ while () $try = "\$x = $class->new(\"$args[0]\");"; if ($f eq "bnorm"){ $try = "\$x = $class->bnorm(\"$args[0]\");"; - } elsif ($f eq "is_zero") { - $try .= '$x->is_zero();'; - } elsif ($f eq "is_one") { - $try .= '$x->is_one();'; - } elsif ($f eq "is_odd") { - $try .= '$x->is_odd();'; - } elsif ($f eq "is_even") { - $try .= '$x->is_even();'; - } elsif ($f eq "is_negative") { - $try .= '$x->is_negative();'; - } elsif ($f eq "is_positive") { - $try .= '$x->is_positive();'; + # some is_xxx tests + } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) { + $try .= "\$x->$f();"; } elsif ($f eq "as_hex") { $try .= '$x->as_hex();'; } elsif ($f eq "as_bin") { @@ -82,26 +73,9 @@ while () $try .= "\$x->binf('$args[1]');"; } elsif ($f eq "bone") { $try .= "\$x->bone('$args[1]');"; - } elsif ($f eq "bnan") { - $try .= "\$x->bnan();"; - } elsif ($f eq "bfloor") { - $try .= '$x->bfloor();'; - } elsif ($f eq "bceil") { - $try .= '$x->bceil();'; - } elsif ($f eq "bsstr") { - $try .= '$x->bsstr();'; - } elsif ($f eq "bneg") { - $try .= '$x->bneg();'; - } elsif ($f eq "babs") { - $try .= '$x->babs();'; - } elsif ($f eq "binc") { - $try .= '++$x;'; - } elsif ($f eq "bdec") { - $try .= '--$x;'; - }elsif ($f eq "bnot") { - $try .= '~$x;'; - }elsif ($f eq "bsqrt") { - $try .= '$x->bsqrt();'; + # some unary ops + } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) { + $try .= "\$x->$f();"; }elsif ($f eq "length") { $try .= '$x->length();'; }elsif ($f eq "exponent"){ @@ -134,6 +108,12 @@ while () $try .= '$x / $y;'; }elsif ($f eq "bdiv-list"){ $try .= 'join (",",$x->bdiv($y));'; + # overload via x= + }elsif ($f =~ /^.=$/){ + $try .= "\$x $f \$y;"; + # overload via x + }elsif ($f =~ /^.$/){ + $try .= "\$x $f \$y;"; }elsif ($f eq "bmod"){ $try .= '$x % $y;'; }elsif ($f eq "bgcd") @@ -265,29 +245,8 @@ print "# For '$try'\n" if (!ok "$ans" , "false" ); # object with stringify overload for this. see Math::String tests as example ############################################################################### -# check shortcuts -$try = "\$x = $class->new(1); \$x += 9;"; -$try .= "'ok' if \$x == 10;"; -$ans = eval $try; -print "# For '$try'\n" if (!ok "$ans" , "ok" ); - -$try = "\$x = $class->new(1); \$x -= 9;"; -$try .= "'ok' if \$x == -8;"; -$ans = eval $try; -print "# For '$try'\n" if (!ok "$ans" , "ok" ); - -$try = "\$x = $class->new(1); \$x *= 9;"; -$try .= "'ok' if \$x == 9;"; -$ans = eval $try; -print "# For '$try'\n" if (!ok "$ans" , "ok" ); - -$try = "\$x = $class->new(10); \$x /= 2;"; -$try .= "'ok' if \$x == 5;"; -$ans = eval $try; -print "# For '$try'\n" if (!ok "$ans" , "ok" ); - -############################################################################### # check reversed order of arguments + $try = "\$x = $class->new(10); \$x = 2 ** \$x;"; $try .= "'ok' if \$x == 1024;"; $ans = eval $try; print "# For '$try'\n" if (!ok "$ans" , "ok" ); @@ -308,6 +267,22 @@ $try = "\$x = $class\->new(10); \$x = 20 / \$x;"; $try .= "'ok' if \$x == 2;"; $ans = eval $try; print "# For '$try'\n" if (!ok "$ans" , "ok" ); +$try = "\$x = $class\->new(3); \$x = 20 % \$x;"; +$try .= "'ok' if \$x == 2;"; $ans = eval $try; +print "# For '$try'\n" if (!ok "$ans" , "ok" ); + +$try = "\$x = $class\->new(7); \$x = 20 & \$x;"; +$try .= "'ok' if \$x == 4;"; $ans = eval $try; +print "# For '$try'\n" if (!ok "$ans" , "ok" ); + +$try = "\$x = $class\->new(7); \$x = 0x20 | \$x;"; +$try .= "'ok' if \$x == 0x27;"; $ans = eval $try; +print "# For '$try'\n" if (!ok "$ans" , "ok" ); + +$try = "\$x = $class\->new(7); \$x = 0x20 ^ \$x;"; +$try .= "'ok' if \$x == 0x27;"; $ans = eval $try; +print "# For '$try'\n" if (!ok "$ans" , "ok" ); + ############################################################################### # check badd(4,5) form @@ -474,7 +449,6 @@ ok ($x, 23456); # construct a number with a zero-hole of BASE_LEN $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl; $y = '1' x (2*$bl); -#print "$x * $y\n"; $x = Math::BigInt->new($x)->bmul($y); # result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl $y = ''; my $d = ''; @@ -482,7 +456,6 @@ for (my $i = 1; $i <= $bl; $i++) { $y .= $i; $d = $i.$d; } -#print "$y $d\n"; $y .= $bl x (3*$bl-1) . $d . '0' x $bl; ok ($x,$y); @@ -531,10 +504,33 @@ sub is_valid # test done, see if error did crop up ok (1,1), return if ($e eq '0'); - ok (1,$e." op '$f'"); + ok (1,$e." after op '$f'"); } __DATA__ +&.= +1234:-345:1234-345 +&+= +1:2:3 +-1:-2:-3 +&-= +1:2:-1 +-1:-2:1 +&*= +2:3:6 +-1:5:-5 +&%= +100:3:1 +8:9:8 +&/= +100:3:33 +-8:2:-4 +&|= +2:1:3 +&&= +5:7:5 +&^= +5:7:2 &is_negative 0:0 -1:1 @@ -629,7 +625,7 @@ inf:inf +inf:inf -inf:-inf 0inf:NaN -# normal input +# abnormal input :NaN abc:NaN 1 a:NaN @@ -637,6 +633,29 @@ abc:NaN 11111b:NaN +1z:NaN -1z:NaN +# only one underscore between two digits +_123:NaN +_123_:NaN +123_:NaN +1__23:NaN +1E1__2:NaN +1_E12:NaN +1E_12:NaN +1_E_12:NaN ++_1E12:NaN ++0_1E2:100 ++0_0_1E2:100 +-0_0_1E2:-100 +-0_0_1E+0_0_2:-100 +E1:NaN +E23:NaN +1.23E1:NaN +1.23E-1:NaN +# bug with two E's in number beeing valid +1e2e3:NaN +1e2r:NaN +1e2.0:NaN +# normal input 0:0 +0:0 +00:0 @@ -655,29 +674,24 @@ abc:NaN -123456789:-123456789 -00000100000:-100000 1_2_3:123 -_123:NaN -_123_:NaN -_123_:NaN -1__23:NaN 10000000000E-1_0:1 1E2:100 1E1:10 1E0:1 -E1:NaN -E23:NaN 1.23E2:123 -1.23E1:NaN -1.23E-1:NaN 100E-1:10 # floating point input +# .2e2:20 +1.E3:1000 1.01E2:101 1010E-1:101 -1010E0:-1010 -1010E1:-10100 +1234.00:1234 +# non-integer numbers -1010E-2:NaN -1.01E+1:NaN -1.01E-1:NaN -1234.00:1234 &bnan 1:NaN 2:NaN @@ -693,6 +707,11 @@ boneNaN:+:+1 1:+:inf 2:-:-inf 3:abc:inf +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 &is_inf +inf::1 -inf::1 @@ -1156,6 +1175,8 @@ abc:+1:abc:NaN 4:-3:-2 1:-3:-2 4095:4095:0 +100041000510123:3:0 +152403346:12345:4321 &bgcd abc:abc:NaN abc:+0:NaN diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index f4db9c3..70dc726 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -9,8 +9,8 @@ BEGIN unshift @INC, '../lib'; # for running manually my $location = $0; $location =~ s/bigintpm.t//; unshift @INC, $location; # to locate the testing files - # chdir 't' if -d 't'; - plan tests => 1608; + chdir 't' if -d 't'; + plan tests => 1669; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index ec20e65..976bb9b 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -12,9 +12,9 @@ use Test; BEGIN { $| = 1; - # chdir 't' if -d 't'; + chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 254; + plan tests => 260; } # for finding out whether round finds correct class @@ -99,12 +99,30 @@ ok ($Math::BigFloat::round_mode,'even'); ok (Math::BigFloat::round_mode(),'even'); ok (Math::BigFloat->round_mode(),'even'); +# old way +ok ($Math::BigInt::rnd_mode,'even'); +ok ($Math::BigFloat::rnd_mode,'even'); + $x = eval 'Math::BigInt->round_mode("huhmbi");'; ok ($@ =~ /^Unknown round mode huhmbi at/); $x = eval 'Math::BigFloat->round_mode("huhmbf");'; ok ($@ =~ /^Unknown round mode huhmbf at/); +# old way (now with test for validity) +$x = eval '$Math::BigInt::rnd_mode = "huhmbi";'; +ok ($@ =~ /^Unknown round mode huhmbi at/); +$x = eval '$Math::BigFloat::rnd_mode = "huhmbi";'; +ok ($@ =~ /^Unknown round mode huhmbi at/); +# see if accessor also changes old variable +Math::BigInt->round_mode('odd'); +ok ($Math::BigInt::rnd_mode,'odd'); +Math::BigFloat->round_mode('odd'); +ok ($Math::BigFloat::rnd_mode,'odd'); + +Math::BigInt->round_mode('even'); +Math::BigFloat->round_mode('even'); + # accessors foreach my $class (qw/Math::BigInt Math::BigFloat/) { @@ -208,8 +226,8 @@ $Math::BigFloat::precision = undef; $x = Math::BigFloat->new('123.456'); $x->accuracy(4); ok ($x,'123.5'); $x = Math::BigFloat->new('123.456'); $x->precision(-2); ok ($x,'123.46'); -$x = Math::BigInt->new('123456'); $x->accuracy(4); ok ($x,123500); -$x = Math::BigInt->new('123456'); $x->precision(2); ok ($x,123500); +$x = Math::BigInt->new(123456); $x->accuracy(4); ok ($x,123500); +$x = Math::BigInt->new(123456); $x->precision(2); ok ($x,123500); ############################################################################### # test actual rounding via round() diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 42d541a..bde47fc 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 => 1299 + 4; # + 4 own tests + plan tests => 1325 + 4; # + 4 own tests } use Math::BigFloat::Subclass; diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index ddbedc8..3f14535 100755 --- a/lib/Math/BigInt/t/sub_mbi.t +++ b/lib/Math/BigInt/t/sub_mbi.t @@ -6,7 +6,6 @@ use strict; BEGIN { $| = 1; - $| = 1; # to locate the testing files my $location = $0; $location =~ s/sub_mbi.t//i; if ($ENV{PERL_CORE}) @@ -14,6 +13,7 @@ BEGIN # testing with the core distribution @INC = qw(../lib); } + unshift @INC, qw(../lib); if (-d 't') { chdir 't'; @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1608 + 4; # +4 own tests + plan tests => 1669 + 4; # +4 own tests } use Math::BigInt::Subclass; @@ -34,7 +34,7 @@ use Math::BigInt::Subclass; use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); $class = "Math::BigInt::Subclass"; -#my $version = '0.01'; # for $VERSION tests, match current release (by hand!) +my $version = '0.01'; # for $VERSION tests, match current release (by hand!) require 'bigintpm.inc'; # perform same tests as bigfltpm