summaryrefslogtreecommitdiff
path: root/lib/Math
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-11-21 15:17:13 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-11-21 15:17:13 +0000
commit027dc3881cf72be7400bcb34bc5555fc060cbbc5 (patch)
tree6641a7e9e781bc0b92b2539bdf5a7e92cf0884cf /lib/Math
parent8489188508bafece71d2019cb0dac6720f8529f0 (diff)
downloadperl-027dc3881cf72be7400bcb34bc5555fc060cbbc5.tar.gz
Upgrade to Math::BigInt 1.47.
p4raw-id: //depot/perl@13172
Diffstat (limited to 'lib/Math')
-rw-r--r--lib/Math/BigFloat.pm40
-rw-r--r--lib/Math/BigInt.pm104
-rw-r--r--lib/Math/BigInt/Calc.pm120
-rw-r--r--lib/Math/BigInt/t/bigfltpm.inc75
-rwxr-xr-xlib/Math/BigInt/t/bigfltpm.t31
-rw-r--r--lib/Math/BigInt/t/bigintc.t5
-rw-r--r--lib/Math/BigInt/t/bigintpm.inc155
-rwxr-xr-xlib/Math/BigInt/t/bigintpm.t4
-rw-r--r--lib/Math/BigInt/t/mbimbf.t26
-rwxr-xr-xlib/Math/BigInt/t/sub_mbf.t2
-rwxr-xr-xlib/Math/BigInt/t/sub_mbi.t6
11 files changed, 330 insertions, 238 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 0670d504c7..a490e6256e 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<Rounding|Rounding>.
-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<Math::BigInt>.
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 663b9275ee..a1b7b8f18f 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<Math::BigFloat> and L<Math::Big>.
+L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
+L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
-L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
+The package at
+L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> 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 24a664049b..ba7483fcee 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 c4e21820e0..7844e729ea 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -31,53 +31,35 @@ while (<DATA>)
$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 (<DATA>)
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 8d08d43d00..5fe1917625 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 adac2d35c9..87006b044a 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 0b4147c98c..e85c5c3f3a 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -60,18 +60,9 @@ while (<DATA>)
$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 (<DATA>)
$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 (<DATA>)
$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 f4db9c38a3..70dc726eb6 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 ec20e65e11..976bb9bebf 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 42d541add9..bde47fcf5b 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 ddbedc8907..3f14535164 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