From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 11 Nov 2001 21:07:18 +0000 (+0000)
Subject: Upgrade to Math::BigInt 1.46.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e745a66c2cdc9fa9305c81afdec93bddfb34aefd;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Math::BigInt 1.46.

p4raw-id: //depot/perl@12945
---

diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index bceefe0..0670d50 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -11,7 +11,7 @@
 
 package Math::BigFloat;
 
-$VERSION = '1.23';
+$VERSION = '1.24';
 require 5.005;
 use Exporter;
 use Math::BigInt qw/objectify/;
@@ -525,25 +525,81 @@ sub bsub
   {
   # (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 
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index f854ec0..663b927 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -19,7 +19,7 @@ package Math::BigInt;
 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
@@ -774,9 +774,14 @@ sub 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
@@ -784,7 +789,20 @@ 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
@@ -792,7 +810,24 @@ 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 
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index e7754bd..24a6640 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -8,7 +8,7 @@ require Exporter;
 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
 
@@ -173,15 +173,49 @@ sub _add
   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
@@ -846,6 +880,9 @@ the use by Math::BigInt:
 			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)
 
@@ -893,9 +930,6 @@ slow, Perl way as fallback to emulate these:
 	
 	_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').
 
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
index c11a8d9..c4e2182 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -110,6 +110,7 @@ while (<DATA>)
         $try .= '$x % $y;';
       } else { warn "Unknown op '$f'"; }
     }
+    # print "# Trying: '$try'\n";
     $ans1 = eval $try;
     if ($ans =~ m|^/(.*)$|)
       {
@@ -664,6 +665,12 @@ fdecNaN:NaN
 -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
@@ -673,6 +680,11 @@ fincNaN:NaN
 -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
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index 6aa7181..8d08d43 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -1,34 +1,16 @@
 #!/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;
diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t
index 1f36cf7..adac2d3 100644
--- a/lib/Math/BigInt/t/bigintc.t
+++ b/lib/Math/BigInt/t/bigintc.t
@@ -8,7 +8,7 @@ BEGIN
   $| = 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
@@ -114,6 +114,18 @@ $x = $C->_new(\"123"); $y = $C->_new(\"1111");
 # _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);
 
diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t
index be1dc46..800b879 100644
--- a/lib/Math/BigInt/t/calling.t
+++ b/lib/Math/BigInt/t/calling.t
@@ -8,8 +8,28 @@ use Test;
 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;
   }
 
@@ -33,7 +53,7 @@ use Math::BigInt;
 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
diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
index c92eaa4..ec20e65 100644
--- a/lib/Math/BigInt/t/mbimbf.t
+++ b/lib/Math/BigInt/t/mbimbf.t
@@ -440,8 +440,8 @@ $x = Math::BigInt->new(12345); $x->{_a} = 5;
 $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
diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t
index 0695ef2..42d541a 100755
--- a/lib/Math/BigInt/t/sub_mbf.t
+++ b/lib/Math/BigInt/t/sub_mbf.t
@@ -1,34 +1,32 @@
 #!/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;
diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t
index 20b8b8d..ddbedc8 100755
--- a/lib/Math/BigInt/t/sub_mbi.t
+++ b/lib/Math/BigInt/t/sub_mbi.t
@@ -1,33 +1,31 @@
 #!/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
   }