package Math::BigFloat;
-$VERSION = '1.23';
+$VERSION = '1.24';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
{
# (BigFloat or num_str, BigFloat or num_str) return BigFloat
# subtract second arg from first, modify first
- my ($self,$x,$y) = objectify(2,@_);
+ my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- $x->badd($y->bneg()); # badd does not leave internal zeros
- $y->bneg(); # refix y, assumes no one reads $y in between
- return $x; # badd() already normalized and rounded
+ if (!$y->is_zero()) # don't need to do anything if $y is 0
+ {
+ $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $x->badd($y,$a,$p,$r); # badd does not leave internal zeros
+ $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
+ }
+ $x; # already rounded by badd()
}
sub binc
{
# increment arg by one
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- $x->badd($self->bone())->round($a,$p,$r);
+
+ if ($x->{_e}->sign() eq '-')
+ {
+ return $x->badd($self->bone(),$a,$p,$r); # digits after dot
+ }
+
+ if (!$x->{_e}->is_zero())
+ {
+ $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
+ $x->{_e}->bzero();
+ }
+ # now $x->{_e} == 0
+ if ($x->{sign} eq '+')
+ {
+ $x->{_m}->binc();
+ return $x->bnorm()->bround($a,$p,$r);
+ }
+ elsif ($x->{sign} eq '-')
+ {
+ $x->{_m}->bdec();
+ $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
+ return $x->bnorm()->bround($a,$p,$r);
+ }
+ # inf, nan handling etc
+ $x->badd($self->__one(),$a,$p,$r); # does round
}
sub bdec
{
# decrement arg by one
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- $x->badd($self->bone('-'))->round($a,$p,$r);
+
+ if ($x->{_e}->sign() eq '-')
+ {
+ return $x->badd($self->bone('-'),$a,$p,$r); # digits after dot
+ }
+
+ if (!$x->{_e}->is_zero())
+ {
+ $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
+ $x->{_e}->bzero();
+ }
+ # now $x->{_e} == 0
+ my $zero = $x->is_zero();
+ # <= 0
+ if (($x->{sign} eq '-') || $zero)
+ {
+ $x->{_m}->binc();
+ $x->{sign} = '-' if $zero; # 0 => 1 => -1
+ $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
+ return $x->bnorm()->round($a,$p,$r);
+ }
+ # > 0
+ elsif ($x->{sign} eq '+')
+ {
+ $x->{_m}->bdec();
+ return $x->bnorm()->round($a,$p,$r);
+ }
+ # inf, nan handling etc
+ $x->badd($self->bone('-'),$a,$p,$r); # does round
}
sub blcm
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.45';
+$VERSION = '1.46';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('bsub');
- $x->badd($y->bneg()); # badd does not leave internal zeros
- $y->bneg(); # refix y, assumes no one reads $y in between
- return $x->round($a,$p,$r,$y);
+
+ if (!$y->is_zero()) # don't need to do anything if $y is 0
+ {
+ $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $x->badd($y,$a,$p,$r); # badd does not leave internal zeros
+ $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
+ }
+ $x; # already rounded by badd()
}
sub binc
# increment arg by one
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('binc');
- $x->badd($self->__one())->round($a,$p,$r);
+
+ if ($x->{sign} eq '+')
+ {
+ $x->{value} = $CALC->_inc($x->{value});
+ return $x->round($a,$p,$r);
+ }
+ elsif ($x->{sign} eq '-')
+ {
+ $x->{value} = $CALC->_dec($x->{value});
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
+ return $x->round($a,$p,$r);
+ }
+ # inf, nan handling etc
+ $x->badd($self->__one(),$a,$p,$r); # does round
}
sub bdec
# decrement arg by one
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bdec');
- $x->badd($self->__one('-'))->round($a,$p,$r);
+
+ my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
+ # <= 0
+ if (($x->{sign} eq '-') || $zero)
+ {
+ $x->{value} = $CALC->_inc($x->{value});
+ $x->{sign} = '-' if $zero; # 0 => 1 => -1
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
+ return $x->round($a,$p,$r);
+ }
+ # > 0
+ elsif ($x->{sign} eq '+')
+ {
+ $x->{value} = $CALC->_dec($x->{value});
+ return $x->round($a,$p,$r);
+ }
+ # inf, nan handling etc
+ $x->badd($self->__one('-'),$a,$p,$r); # does round
}
sub blcm
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.13';
+$VERSION = '0.14';
# Package to store unsigned big integers in decimal and do math with them
my $i; my $car = 0; my $j = 0;
for $i (@$y)
{
- $x->[$j] -= $BASE
- if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
+ $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
$j++;
}
while ($car != 0)
{
$x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
}
- return $x;
+ return $x;
+ }
+
+sub _inc
+ {
+ # (ref to int_num_array, ref to int_num_array)
+ # routine to add 1 to a base 1eX numbers
+ # This routine clobbers up array x, but not y.
+ my ($c,$x) = @_;
+
+ for my $i (@$x)
+ {
+ return $x if (($i += 1) < $BASE); # early out
+ $i -= $BASE;
+ }
+ if ($x->[-1] == 0) # last overflowed
+ {
+ push @$x,1; # extend
+ }
+ return $x;
+ }
+
+sub _dec
+ {
+ # (ref to int_num_array, ref to int_num_array)
+ # routine to add 1 to a base 1eX numbers
+ # This routine clobbers up array x, but not y.
+ my ($c,$x) = @_;
+
+ for my $i (@$x)
+ {
+ last if (($i -= 1) >= 0); # early out
+ $i = $MAX_VAL;
+ }
+ pop @$x if $x->[-1] == 0 && @$x > 1; # last overflowed (but leave 0)
+ return $x;
}
sub _sub
are swapped. In this case, the first param needs to
be preserved, while you can destroy the second.
sub (x,y,1) => return x - y and keep x intact!
+ _dec(obj) decrement object by one (input is garant. to be > 0)
+ _inc(obj) increment object by one
+
_acmp(obj,obj) <=> operator for objects (return -1, 0 or 1)
_zeros(obj) return number of trailing decimal zeros
- _dec(obj) decrement object by one (input is >= 1)
- _inc(obj) increment object by one
-
Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
or '0b1101').
$try .= '$x % $y;';
} else { warn "Unknown op '$f'"; }
}
+ # print "# Trying: '$try'\n";
$ans1 = eval $try;
if ($ans =~ m|^/(.*)$|)
{
-1:-2
1.23:0.23
-1.23:-2.23
+100:99
+101:100
+-100:-101
+-99:-100
+-98:-99
+99:98
&finc
fincNaN:NaN
+inf:inf
-1:0
1.23:2.23
-1.23:-0.23
+100:101
+-100:-99
+-99:-98
+-101:-100
+99:100
&fadd
abc:abc:NaN
abc:+0:NaN
#!/usr/bin/perl -w
-BEGIN {
- $| = 1;
- my $location = $0;
- # to locate the testing files
- $location =~ s/bigfltpm.t//i;
- if ($ENV{PERL_CORE}) {
- # testing with the core distribution
- @INC = qw(../lib);
- if (-d 't') {
- chdir 't';
- require File::Spec;
- unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
- } else {
- unshift @INC, $location;
- }
- } else {
- # for running manually with the CPAN distribution
- unshift @INC, '../lib';
- $location =~ s/bigfltpm.t//;
- }
- print "# INC = @INC\n";
-}
-
use Test;
use strict;
BEGIN
{
- plan tests => 1277;
+ $| = 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;
}
use Math::BigInt;
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 52;
+ plan tests => 56;
}
# testing of Math::BigInt::BitVect, primarily for interface/api and not for the
# _num
$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
+# _inc
+$x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001');
+$C->_dec($x); ok (${$C->_str($x)},'1000');
+
+my $BL = Math::BigInt::Calc::_base_len();
+$x = '1' . '0' x $BL;
+$z = '1' . '0' x ($BL-1); $z .= '1';
+$x = $C->_new(\$x); $C->_inc($x); ok (${$C->_str($x)},$z);
+
+$x = '1' . '0' x $BL; $z = '9' x $BL;
+$x = $C->_new(\$x); $C->_dec($x); ok (${$C->_str($x)},$z);
+
# should not happen:
# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
BEGIN
{
$| = 1;
- # chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
+ # to locate the testing files
+ my $location = $0; $location =~ s/calling.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../lib);
+ }
+ else
+ {
+ 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";
plan tests => 141;
}
use Math::BigFloat;
my ($x,$y,$z,$u);
-my $version = '1.45'; # adjust manually to match latest release
+my $version = '1.46'; # adjust manually to match latest release
###############################################################################
# check whether op's accept normal strings, even when inherited by subclasses
$x->bround(6); # must be no-op
ok ($x,'12345');
-$x = Math::BigFloat->new(0.0061); $x->bfround(-2);
-ok ($x,0.01);
+$x = Math::BigFloat->new('0.0061'); $x->bfround(-2);
+ok ($x,'0.01');
###############################################################################
# rounding with already set precision/accuracy
#!/usr/bin/perl -w
-BEGIN {
- $| = 1;
- my $location = $0;
- # to locate the testing files
- $location =~ s/sub_mbf.t//i;
- if ($ENV{PERL_CORE}) {
- # testing with the core distribution
- @INC = qw(../lib);
- if (-d 't') {
- chdir 't';
- require File::Spec;
- unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
- } else {
- unshift @INC, $location;
- }
- } else {
- # for running manually with the CPAN distribution
- unshift @INC, '../lib';
- $location =~ s/bigfltpm.t//;
- }
- print "# INC = @INC\n";
-}
-
use Test;
use strict;
BEGIN
{
- plan tests => 1277 + 4; # + 4 own tests
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/sub_mbf.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";
+
+ plan tests => 1299 + 4; # + 4 own tests
}
use Math::BigFloat::Subclass;
#!/usr/bin/perl -w
-BEGIN {
- $| = 1;
- my $location = $0;
- # to locate the testing files
- $location =~ s/sub_mbi.t//i;
- if ($ENV{PERL_CORE}) {
- # testing with the core distribution
- @INC = qw(../lib);
- if (-d 't') {
- chdir 't';
- require File::Spec;
- unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
- } else {
- unshift @INC, $location;
- }
- } else {
- # for running manually with the CPAN distribution
- unshift @INC, '../lib';
- $location =~ s/bigfltpm.t//;
- }
- print "# INC = @INC\n";
-}
-
use Test;
use strict;
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);
+ }
+ 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";
+
plan tests => 1608 + 4; # +4 own tests
}
projects / p5sagit/p5-mst-13.2.git / commitdiff