package Math::BigFloat;
-$VERSION = '1.24';
+$VERSION = '1.25';
require 5.005;
use Exporter;
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
$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; }
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();
# 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();
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
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
# _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!
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
'-=' => 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] },
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(); }
;
##############################################################################
$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';
{
if ($k eq 'value')
{
- $self->{$k} = $CALC->_copy($x->{$k});
+ $self->{value} = $CALC->_copy($x->{value});
}
elsif (ref($x->{$k}) eq 'SCALAR')
{
# 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
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;
$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
$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}))
}
else
{
- $x = (&bdiv($self,$x,$y))[1];
+ $x = (&bdiv($self,$x,$y))[1]; # slow way
}
$x->bround($a,$p,$r);
}
$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)
# {
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);
$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;
$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;
# 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";
=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
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)
# 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)
return [ 1 ];
}
+sub _two
+ {
+ # create a two (for _pow)
+ return [ 2 ];
+ }
+
sub _copy
{
return [ @{$_[1]} ];
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);
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
$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);
$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);
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)
{
# 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;
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++;
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--;
}
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
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
=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
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
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
$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") {
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);
-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
+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
1:1
-1:0
-2:0
-&bfloor
+&ffloor
0:0
abc:NaN
+inf:inf
-51:-51
-51.2:-52
12.2:12
-&bceil
+&fceil
0:0
abc:NaN
+inf:inf
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;
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;
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);
$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") {
$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"){
$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")
# 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" );
$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
# 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 = '';
{
$y .= $i; $d = $i.$d;
}
-#print "$y $d\n";
$y .= $bl x (3*$bl-1) . $d . '0' x $bl;
ok ($x,$y);
# 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
+inf:inf
-inf:-inf
0inf:NaN
-# normal input
+# abnormal input
:NaN
abc:NaN
1 a: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
-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
1:+:inf
2:-:-inf
3:abc:inf
+&is_nan
+123:0
+abc:1
+NaN:1
+-123:0
&is_inf
+inf::1
-inf::1
4:-3:-2
1:-3:-2
4095:4095:0
+100041000510123:3:0
+152403346:12345:4321
&bgcd
abc:abc:NaN
abc:+0:NaN
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;
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
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/)
{
$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()
}
print "# INC = @INC\n";
- plan tests => 1299 + 4; # + 4 own tests
+ plan tests => 1325 + 4; # + 4 own tests
}
use Math::BigFloat::Subclass;
BEGIN
{
$| = 1;
- $| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_mbi.t//i;
if ($ENV{PERL_CORE})
# testing with the core distribution
@INC = qw(../lib);
}
+ unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
}
print "# INC = @INC\n";
- plan tests => 1608 + 4; # +4 own tests
+ plan tests => 1669 + 4; # +4 own tests
}
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
projects / p5sagit/p5-mst-13.2.git / commitdiff