# _a : accuracy
# _p : precision
-$VERSION = '1.44';
+$VERSION = '1.45';
require 5.005;
require Exporter;
@ISA = qw(Exporter Math::BigInt);
use strict;
-# $_trap_inf and $_trap_nan are internal and should never be accessed from the outside
+# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
$upgrade $downgrade $_trap_nan $_trap_inf/;
my $class = "Math::BigFloat";
$x->bnorm()->round($a,$p,$r,$y);
}
-sub bsub
- {
- # (BigFloat or num_str, BigFloat or num_str) return BigFloat
- # subtract second arg from first, modify first
-
- # set up parameters
- my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
- {
- ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- }
-
- if ($y->is_zero()) # still round for not adding zero
- {
- return $x->round($a,$p,$r);
- }
-
- # $x - $y = -$x + $y
- $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 bsub is inherited from Math::BigInt!
sub binc
{
# enough...
$scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
+
+ my $rem; $rem = $self->bzero() if wantarray;
+
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m});
$scale = $lx if $lx > $scale;
$scale = $ly if $ly > $scale;
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
-
- # make copy of $x in case of list context for later reminder calculation
- my $rem;
- if (wantarray && !$y->is_one())
+
+ # cases like $x /= $x (but not $x /= $y!) were wrong due to modifying $x
+ # twice below)
+ if (overload::StrVal($x) eq overload::StrVal($y))
{
- $rem = $x->copy();
+ $x->bone(); # x/x => 1, rem 0
}
-
- $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
-
- # check for / +-1 ( +/- 1E0)
- if (!$y->is_one())
+ else
{
- # promote BigInts and it's subclasses (except when already a BigFloat)
- $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # make copy of $x in case of list context for later reminder calculation
+ if (wantarray && !$y->is_one())
+ {
+ $rem = $x->copy();
+ }
- # calculate the result to $scale digits and then round it
- # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
- $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
- $MBI->_div ($x->{_m},$y->{_m} ); # a/c
+ $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
- ($x->{_e},$x->{_es}) =
- _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
- # correct for 10**scale
- ($x->{_e},$x->{_es}) =
- _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
- $x->bnorm(); # remove trailing 0's
- }
+ # check for / +-1 ( +/- 1E0)
+ if (!$y->is_one())
+ {
+ # promote BigInts and it's subclasses (except when already a BigFloat)
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # calculate the result to $scale digits and then round it
+ # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+ $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
+ $MBI->_div ($x->{_m},$y->{_m}); # a/c
+
+ # correct exponent of $x
+ ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+ # correct for 10**scale
+ ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
+ $x->bnorm(); # remove trailing 0's
+ }
+ } # ende else $x != $y
# shortcut to not run through _find_round_parameters again
if (defined $params[0])
# clear a/p after round, since user did not request it
delete $x->{_a}; delete $x->{_p};
}
-
+
if (wantarray)
{
if (!$y->is_one())
{
$rem->bmod($y,@params); # copy already done
}
- else
- {
- $rem = $self->bzero();
- }
if ($fallback)
{
# clear a/p after round, since user did not request it
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.70_01';
+$VERSION = '1.71';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify bgcd blcm);
return $x;
}
+ if (overload::StrVal($x) eq overload::StrVal($y))
+ {
+ # if we get the same variable twice, the result must be zero (the code
+ # below fails in that case)
+ return $x->bzero(@r) if $x->{sign} =~ /^[+-]$/;
+ return $x->bnan(); # NaN, -inf, +inf
+ }
$y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
$x->badd($y,@r); # badd does not leave internal zeros
$y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
use vars qw/$VERSION/;
-$VERSION = '0.40';
+$VERSION = '0.41';
# Package to store unsigned big integers in decimal and do math with them
return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL);
}
+sub _new
+ {
+ # (ref to string) return ref to num_array
+ # Convert a number from string format (without sign) to internal base
+ # 1ex format. Assumes normalized value as input.
+ my $il = length($_[1])-1;
+
+ # < BASE_LEN due len-1 above
+ return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers
+
+ # this leaves '00000' instead of int 0 and will be corrected after any op
+ [ reverse(unpack("a" . ($il % $BASE_LEN+1)
+ . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
+ }
+
BEGIN
{
# from Daniel Pfeiffer: determine largest group of digits that is precisely
use integer;
- ############################################################################
- # the next block is no longer important
-
- ## this below detects 15 on a 64 bit system, because after that it becomes
- ## 1e16 and not 1000000 :/ I can make it detect 18, but then I get a lot of
- ## test failures. Ugh! (Tomake detect 18: uncomment lines marked with *)
-
- #my $bi = 5; # approx. 16 bit
- #$num = int('9' x $bi);
- ## $num = 99999; # *
- ## while ( ($num+$num+1) eq '1' . '9' x $bi) # *
- #while ( int($num+$num+1) eq '1' . '9' x $bi)
- # {
- # $bi++; $num = int('9' x $bi);
- # # $bi++; $num *= 10; $num += 9; # *
- # }
- #$bi--; # back off one step
- # by setting them equal, we ignore the findings and use the default
- # one-size-fits-all approach from former versions
- my $bi = $e; # XXX, this should work always
-
- __PACKAGE__->_base_len($e,$bi); # set and store
+ __PACKAGE__->_base_len($e); # set and store
# find out how many bits _and, _or and _xor can take (old default = 16)
# I don't think anybody has yet 128 bit scalars, so let's play safe.
} while ($OR_BITS < $max && $x == $z && $y == $x);
$OR_BITS --; # retreat one step
- }
-
-###############################################################################
-
-sub _new
- {
- # (ref to string) return ref to num_array
- # Convert a number from string format (without sign) to internal base
- # 1ex format. Assumes normalized value as input.
- my $il = length($_[1])-1;
-
- # < BASE_LEN due len-1 above
- return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers
-
- # this leaves '00000' instead of int 0 and will be corrected after any op
- [ reverse(unpack("a" . ($il % $BASE_LEN+1)
- . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
- }
-
-BEGIN
- {
$AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS ));
$XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS ));
$OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS ));
}
+###############################################################################
+
sub _zero
{
# create a zero
my $elem = int($n / $BASE_LEN); # which array element
my $digit = $n % $BASE_LEN; # which digit in this element
- $elem = '0000'.@$x[$elem]; # get element padded with 0's
+ $elem = '0000000'.@$x[$elem]; # get element padded with 0's
substr($elem,-$digit-1,1);
}
my ($c,$x) = @_;
# fit's into one element (handle also 0x0 case)
- if (@$x == 1)
- {
- my $t = sprintf("0x%x",$x->[0]);
- return $t;
- }
+ return sprintf("0x%x",$x->[0]) if @$x == 1;
my $x1 = _copy($c,$x);
{
$x10000 = [ 0x1000 ]; $h = 'h3';
}
- # while (! _is_zero($c,$x1))
while (@$x1 != 1 || $x1->[0] != 0) # _is_zero()
{
($x1, $xr) = _div($c,$x1,$x10000);
}
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
- $es = '0x' . $es;
- $es;
+ '0x' . $es; # return result prepended with 0x
}
sub _as_bin
{
$x10000 = [ 0x1000 ]; $b = 'b12';
}
- # while (! _is_zero($c,$x1))
while (!(@$x1 == 1 && $x1->[0] == 0)) # _is_zero()
{
($x1, $xr) = _div($c,$x1,$x10000);
}
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
- $es = '0b' . $es;
- $es;
+ '0b' . $es; # return result prepended with 0b
}
sub _from_hex
# convert a hex number to decimal (ref to string, return ref to array)
my ($c,$hs) = @_;
+ my $m = [ 0x10000000 ]; # 28 bit at a time (<32 bit!)
+ my $d = 7; # 7 digits at a time
+ if ($] <= 5.006)
+ {
+ # for older Perls, play safe
+ $m = [ 0x10000 ]; # 16 bit at a time (<32 bit!)
+ $d = 4; # 4 digits at a time
+ }
+
my $mul = _one();
- my $m = [ 0x10000 ]; # 16 bit at a time
my $x = _zero();
- my $len = length($hs)-2;
- $len = int($len/4); # 4-digit parts, w/o '0x'
- my $val; my $i = -4;
+ my $len = int( (length($hs)-2)/$d ); # $d digit parts, w/o the '0x'
+ my $val; my $i = -$d;
while ($len >= 0)
{
- $val = substr($hs,$i,4);
+ $val = substr($hs,$i,$d); # get hex digits
$val =~ s/^[+-]?0x// if $len == 0; # for last part only because
$val = hex($val); # hex does not like wrong chars
- $i -= 4; $len --;
+ $i -= $d; $len --;
_add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0;
_mul ($c, $mul, $m ) if $len >= 0; # skip last mul
}
$hs =~ s/^[+-]?0b//; # remove sign and 0b
my $l = length($hs); # bits
$hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0
- my $h = unpack('H*', pack ('B*', $hs)); # repack as hex
+ my $h = '0x' . unpack('H*', pack ('B*', $hs)); # repack as hex
- $c->_from_hex('0x'.$h);
+ $c->_from_hex($h);
}
##############################################################################
# if the gcd is not 1, then return NaN
return (undef,undef) unless _is_one($c,$a);
- $sign = $sign == 1 ? '+' : '-';
- ($u1,$sign);
+ ($u1, $sign == 1 ? '+' : '-');
}
sub _modpow
}
print "# INC = @INC\n";
- plan tests => 1815;
+ plan tests => 1835;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2832;
+ plan tests => 2848;
}
use Math::BigInt lib => 'BareCalc';
ok ($class->new(1)->fdiv('0.5')->bsstr(),'2e+0');
+###############################################################################
+# [perl #30609] bug with $x -= $x not beeing 0, but 2*$x
+
+$x = $class->new(3); $x -= $x; ok ($x, 0);
+$x = $class->new(-3); $x -= $x; ok ($x, 0);
+$x = $class->new(3); $x += $x; ok ($x, 6);
+$x = $class->new(-3); $x += $x; ok ($x, -6);
+
+$x = $class->new('NaN'); $x -= $x; ok ($x->is_nan(), 1);
+$x = $class->new('inf'); $x -= $x; ok ($x->is_nan(), 1);
+$x = $class->new('-inf'); $x -= $x; ok ($x->is_nan(), 1);
+
+$x = $class->new('NaN'); $x += $x; ok ($x->is_nan(), 1);
+$x = $class->new('inf'); $x += $x; ok ($x->is_inf(), 1);
+$x = $class->new('-inf'); $x += $x; ok ($x->is_inf('-'), 1);
+
+$x = $class->new('3.14'); $x -= $x; ok ($x, 0);
+$x = $class->new('-3.14'); $x -= $x; ok ($x, 0);
+$x = $class->new('3.14'); $x += $x; ok ($x, '6.28');
+$x = $class->new('-3.14'); $x += $x; ok ($x, '-6.28');
+
+$x = $class->new('3.14'); $x *= $x; ok ($x, '9.8596');
+$x = $class->new('-3.14'); $x *= $x; ok ($x, '9.8596');
+$x = $class->new('3.14'); $x /= $x; ok ($x, '1');
+$x = $class->new('-3.14'); $x /= $x; ok ($x, '1');
+$x = $class->new('3.14'); $x %= $x; ok ($x, '0');
+$x = $class->new('-3.14'); $x %= $x; ok ($x, '0');
+
1; # all done
###############################################################################
}
print "# INC = @INC\n";
- plan tests => 1815
+ plan tests => 1835
+ 2; # own tests
}
ok ($class->new(-1)->is_one(),0);
###############################################################################
+# [perl #30609] bug with $x -= $x not beeing 0, but 2*$x
+
+$x = $class->new(3); $x -= $x; ok ($x, 0);
+$x = $class->new(-3); $x -= $x; ok ($x, 0);
+$x = $class->new('NaN'); $x -= $x; ok ($x->is_nan(), 1);
+$x = $class->new('inf'); $x -= $x; ok ($x->is_nan(), 1);
+$x = $class->new('-inf'); $x -= $x; ok ($x->is_nan(), 1);
+
+$x = $class->new('NaN'); $x += $x; ok ($x->is_nan(), 1);
+$x = $class->new('inf'); $x += $x; ok ($x->is_inf(), 1);
+$x = $class->new('-inf'); $x += $x; ok ($x->is_inf('-'), 1);
+$x = $class->new(3); $x += $x; ok ($x, 6);
+$x = $class->new(-3); $x += $x; ok ($x, -6);
+
+$x = $class->new(3); $x *= $x; ok ($x, 9);
+$x = $class->new(-3); $x *= $x; ok ($x, 9);
+$x = $class->new(3); $x /= $x; ok ($x, 1);
+$x = $class->new(-3); $x /= $x; ok ($x, 1);
+$x = $class->new(3); $x %= $x; ok ($x, 0);
+$x = $class->new(-3); $x %= $x; ok ($x, 0);
+
+###############################################################################
# all tests done
1;
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2832;
+ plan tests => 2848;
}
use Math::BigInt;
}
print "# INC = @INC\n";
- plan tests => 1815
+ plan tests => 1835
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2832
+ plan tests => 2848
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 1815
+ plan tests => 1835
+ 1;
}
projects / platform / upstream / perl.git / commitdiff