Patch: BigInt v1.73 (pre-release)

Message-Id: <200410102236.03637@bloodgate.com>

p4raw-id: //depot/perl@23359

14 files changed, 223 insertions, 31 deletions

diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 42eb77c91d..7fceee8834 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -12,7 +12,7 @@ package Math::BigFloat;
 #   _a	: accuracy
 #   _p	: precision
 
-$VERSION = '1.46';
+$VERSION = '1.47';
 require 5.005;
 
 require Exporter;
@@ -132,7 +132,8 @@ sub new
     $self->{sign} = $wanted->sign();
     return $self->bnorm();
     }
-  # got string
+  # else: got a string
+
   # handle '+inf', '-inf' first
   if ($wanted =~ /^[+-]?inf$/)
     {
@@ -146,6 +147,17 @@ sub new
     return $self->bnorm();
     }
 
+  # shortcut for simple forms like '12' that neither have trailing nor leading
+  # zeros
+  if ($wanted =~ /^([+-]?)([1-9][0-9]*[1-9])$/)
+    {
+    $self->{_e} = $MBI->_zero();
+    $self->{_es} = '+';
+    $self->{sign} = $1 || '+';
+    $self->{_m} = $MBI->_new($2);
+    return $self->round(@r) if !$downgrade;
+    }
+
   my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
   if (!ref $mis)
     {
@@ -178,22 +190,28 @@ sub new
       ($self->{_e}, $self->{_es}) =
 	_e_sub ($self->{_e}, $len, $self->{_es}, '+');
       }
-    $self->{sign} = $$mis;
-    
-    # we can only have trailing zeros on the mantissa of $$mfv eq ''
-    if (CORE::length($$mfv) == 0)
+    # we can only have trailing zeros on the mantissa if $$mfv eq ''
+    else
       {
-      my $zeros = $MBI->_zeros($self->{_m});	# correct for trailing zeros 
+      # Use a regexp to count the trailing zeros in $$miv instead of _zeros()
+      # because that is faster, especially when _m is not stored in base 10.
+      my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; 
       if ($zeros != 0)
         {
         my $z = $MBI->_new($zeros);
+        # turn '120e2' into '12e3'
         $MBI->_rsft ( $self->{_m}, $z, 10);
 	_e_add ( $self->{_e}, $z, $self->{_es}, '+');
         }
       }
+    $self->{sign} = $$mis;
+
     # for something like 0Ey, set y to 1, and -0 => +0
+    # Check $$miv for beeing '0' and $$mfv eq '', because otherwise _m could not
+    # have become 0. That's faster than to call $MBI->_is_zero().
     $self->{sign} = '+', $self->{_e} = $MBI->_one()
-     if $MBI->_is_zero($self->{_m});
+     if $$miv eq '0' and $$mfv eq '';
+
     return $self->round(@r) if !$downgrade;
     }
   # if downgrade, inf, NaN or integers go down
@@ -1887,8 +1905,11 @@ sub bpow
     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
     }
 
-  return $x if $x->{sign} =~ /^[+-]inf$/;
   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
+  return $x if $x->{sign} =~ /^[+-]inf$/;
+  
+  # -2 ** -2 => NaN
+  return $x->bnan() if $x->{sign} eq '-' && $y->{sign} eq '-';
 
   # cache the result of is_zero
   my $y_is_zero = $y->is_zero();
@@ -1896,7 +1917,7 @@ sub bpow
   return $x         if $x->is_one() || $y->is_one();
 
   my $x_is_zero = $x->is_zero();
-  return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int();	# non-integer power
+  return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int();		# non-integer power
 
   my $y1 = $y->as_number()->{value};			# make MBI part
 
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index b84ad36436..a6083e1eae 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -18,7 +18,7 @@ package Math::BigInt;
 my $class = "Math::BigInt";
 require 5.005;
 
-$VERSION = '1.72';
+$VERSION = '1.73';
 use Exporter;
 @ISA =       qw( Exporter );
 @EXPORT_OK = qw( objectify bgcd blcm); 
@@ -55,6 +55,9 @@ use overload
 '|='	=>	sub { $_[0]->bior($_[1]); },
 '**='	=>	sub { $_[0]->bpow($_[1]); },
 
+'<<='	=>	sub { $_[0]->blsft($_[1]); },
+'>>='	=>	sub { $_[0]->brsft($_[1]); },
+
 # not supported by Perl yet
 '..'	=>	\&_pointpoint,
 
@@ -79,7 +82,7 @@ use overload
 'sqrt'  =>	sub { $_[0]->copy()->bsqrt(); },
 '~'	=>	sub { $_[0]->copy()->bnot(); },
 
-# for sub it is a bit tricky to keep b: b-a => -a+b
+# for subtract it is a bit tricky to keep b: b-a => -a+b
 '-'	=>	sub { my $c = $_[0]->copy; $_[2] ?
                    $c->bneg()->badd($_[1]) :
                    $c->bsub( $_[1]) },
@@ -1670,12 +1673,61 @@ sub bpow
 
   return $x if $x->modify('bpow');
 
+  return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
+
+  # inf handling
+  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
+    {
+    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+      {
+      # +-inf ** +-inf
+      return $x->bnan();
+      }
+    # +-inf ** Y
+    if ($x->{sign} =~ /^[+-]inf/)
+      {
+      # +inf ** 0 => NaN
+      return $x->bnan() if $y->is_zero();
+      # -inf ** -1 => 1/inf => 0
+      return $x->bzero() if $y->is_one('-') && $x->is_negative();
+
+      # +inf ** Y => inf
+      return $x if $x->{sign} eq '+inf';
+
+      # -inf ** Y => -inf if Y is odd
+      return $x if $y->is_odd();
+      return $x->babs();
+      }
+    # X ** +-inf
+
+    # 1 ** +inf => 1
+    return $x if $x->is_one();
+    
+    # 0 ** inf => 0
+    return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;
+
+    # 0 ** -inf => inf
+    return $x->binf() if $x->is_zero();
+
+    # -1 ** -inf => NaN
+    return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;
+
+    # -X ** -inf => 0
+    return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;
+
+    # -1 ** inf => NaN
+    return $x->bnan() if $x->{sign} eq '-';
+
+    # X ** inf => inf
+    return $x->binf() if $y->{sign} =~ /^[+]/;
+    # X ** -inf => 0
+    return $x->bzero();
+    }
+
   return $upgrade->bpow($upgrade->new($x),$y,@r)
    if defined $upgrade && !$y->isa($self);
 
   $r[3] = $y;					# no push!
-  return $x if $x->{sign} =~ /^[+-]inf$/;	# -inf/+inf ** x
-  return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
 
   # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
 
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index a4a1002d4f..3d53b0c414 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -6,7 +6,7 @@ use strict;
 
 use vars qw/$VERSION/;
 
-$VERSION = '0.42';
+$VERSION = '0.43';
 
 # Package to store unsigned big integers in decimal and do math with them
 
@@ -37,7 +37,7 @@ sub api_version () { 1; }
  
 # constants for easier life
 my $nan = 'NaN';
-my ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2,$BASE_LEN_SMALL);
+my ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN_SMALL);
 my ($AND_BITS,$XOR_BITS,$OR_BITS);
 my ($AND_MASK,$XOR_MASK,$OR_MASK);
 
@@ -68,7 +68,6 @@ sub _base_len
     $BASE_LEN = shift if (defined $_[0]);		# one more arg?
     $BASE = int("1e".$BASE_LEN);
 
-    $BASE_LEN2 = int($BASE_LEN_SMALL / 2);		# for mul shortcut
     $MBASE = int("1e".$BASE_LEN_SMALL);
     $RBASE = abs('1e-'.$BASE_LEN_SMALL);		# see USE_MUL
     $MAX_VAL = $MBASE-1;
@@ -1804,7 +1803,7 @@ 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 $m = _new($c, 0x10000000);			# 28 bit at a time (<32 bit!)
   my $d = 7;					# 7 digits at a time
   if ($] <= 5.006)
     {
@@ -1824,7 +1823,14 @@ sub _from_hex
     $val =~ s/^[+-]?0x// if $len == 0;		# for last part only because
     $val = hex($val);				# hex does not like wrong chars
     $i -= $d; $len --;
-    _add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0;
+    my $adder = [ $val ];
+    # if the resulting number was to big to fit into one element, create a
+    # two-element version (bug found by Mark Lakata - Thanx!)
+    if (CORE::length($val) > $BASE_LEN)
+      {
+      $adder = _new($c,$val);
+      }
+    _add ($c, $x, _mul ($c, $adder, $mul ) ) if $val != 0;
     _mul ($c, $mul, $m ) if $len >= 0; 		# skip last mul
     }
   $x;
diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t
index cdf0f8ff5b..a79dff1bb3 100644
--- a/lib/Math/BigInt/t/bare_mbf.t
+++ b/lib/Math/BigInt/t/bare_mbf.t
@@ -27,7 +27,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1861;
+  plan tests => 1924;
   }
 
 use Math::BigFloat lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t
index 4f8b0ae126..6695492521 100644
--- a/lib/Math/BigInt/t/bare_mbi.t
+++ b/lib/Math/BigInt/t/bare_mbi.t
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 2848;
+  plan tests => 2952;
   }
 
 use Math::BigInt lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
index c978644d9d..131e4531b9 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -300,6 +300,29 @@ ok ($x ** $y, 0, 'no warnings and zero result');
 $x = $class->new(".222222222222222222222222222222222222222222"); 
 ok ($x->bceil(), 1, 'no warnings and one as result');
 
+###############################################################################
+# test **=, <<=, >>=
+
+# ((2^148)-1)/17
+$x = $class->new(2); $x **= 148; $x++; $x->bdiv(17, 60)->bfloor(); $x->accuracy(undef);
+ok ($x,"20988936657440586486151264256610222593863921");
+ok ($x->length(),length "20988936657440586486151264256610222593863921");
+
+$x = $class->new('2');
+my $y = $class->new('18');
+ok ($x <<= $y, 2 << 18);
+ok ($x, 2 << 18);
+ok ($x >>= $y, 2);
+ok ($x, 2);
+
+$x = $class->new('2');
+$y = $class->new('18.2');
+$x <<= $y;		# 2 * (2 ** 18.2);
+
+ok ($x->copy()->bfround(-9), '602248.763144685');
+ok ($x >>= $y, 2);	# 2 * (2 ** 18.2) / (2 ** 18.2) => 2
+ok ($x, 2);
+
 1; # all done
 
 ###############################################################################
@@ -373,10 +396,37 @@ fnormNaN:NaN
 1__2:NaN
 1E1__2:NaN
 11__2E2:NaN
-#1.E3:NaN
 .2E-3.:NaN
-#1e3e4:NaN
+1e3e4:NaN
+# strange, but valid
 .2E2:20
+1.E3:1000
+# some inputs that result in zero
+0e0:0
++0e0:0
++0e+0:0
+-0e+0:0
+0e-0:0
+-0e-0:0
++0e-0:0
+000:0
+00e2:0
+00e02:0
+000e002:0
+000e1230:0
+00e-3:0
+00e+3:0
+00e-03:0
+00e+03:0
+-000:0
+-00e2:0
+-00e02:0
+-000e002:0
+-000e1230:0
+-00e-3:0
+-00e+3:0
+-00e-03:0
+-00e+03:0
 &as_number
 0:0
 1:1
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index 331621c088..238a23fced 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1861
+  plan tests => 1924
 	+ 2;		# own tests
   }
 
diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc
index 77b55b9b98..6453879048 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -476,6 +476,14 @@ $x = $class->new('1_000_000_000_000');
 ($x,$y) = $x->length();
 ok ($x,13); ok ($y,0);
 
+# test <<=, >>=
+$x = $class->new('2');
+my $y = $class->new('18');
+ok ($x <<= $y, 2 << 18);
+ok ($x, 2 << 18);
+ok ($x >>= $y, 2);
+ok ($x, 2);
+
 # I am afraid the following is not yet possible due to slowness
 # Also, testing for 2 meg output is a bit hard ;)
 #$x = $class->new(2); $x **= 6972593; $x--;
@@ -936,6 +944,8 @@ NaN:-inf:
 0x200000001:8589934593
 0x400000001:17179869185
 0x800000001:34359738369
+# bug found by Mark Lakata in Calc.pm creating too big one-element numbers in _from_hex()
+0x2dd59e18a125dbed30a6ab1d93e9c855569f44f75806f0645dc9a2e98b808c3:1295719234436071846486578237372801883390756472611551858964079371952886122691
 # inf input
 inf:inf
 +inf:inf
@@ -999,6 +1009,32 @@ E23:NaN
 012345678912:12345678912
 0123456789123:123456789123
 01234567891234:1234567891234
+# some inputs that result in zero
+0e0:0
++0e0:0
++0e+0:0
+-0e+0:0
+0e-0:0
+-0e-0:0
++0e-0:0
+000:0
+00e2:0
+00e02:0
+000e002:0
+000e1230:0
+00e-3:0
+00e+3:0
+00e-03:0
+00e+03:0
+-000:0
+-00e2:0
+-00e02:0
+-000e002:0
+-000e1230:0
+-00e-3:0
+-00e+3:0
+-00e-03:0
+-00e+03:0
 # normal input
 0:0
 +0:0
@@ -1976,14 +2012,40 @@ abc:12:NaN
 2:2:4
 2:3:8
 3:3:27
+-2:2:4
+-2:3:-8
+-2:4:16
+-2:5:-32
 2:-1:NaN
 -2:-1:NaN
 2:-2:NaN
 -2:-2:NaN
+# inf tests
 +inf:1234500012:inf
--inf:1234500012:-inf
+-inf:1234500012:inf
+-inf:1234500013:-inf
 +inf:-12345000123:inf
 -inf:-12345000123:-inf
+#  -inf * -inf = inf
+-inf:2:inf
+-inf:0:NaN
+-inf:-1:0
+-inf:inf:NaN
+2:inf:inf
+2:-inf:0
+0:inf:0
+0:-inf:inf
+-1:-inf:NaN
+-1:inf:NaN
+-2:inf:NaN
+-2:-inf:0
+NaN:inf:NaN
+NaN:-inf:NaN
+-inf:NaN:NaN
+inf:NaN:NaN
+inf:-inf:NaN
+1:inf:1
+1:-inf:1
 # 1 ** -x => 1 / (1 ** x)
 -1:0:1
 -2:0:1
diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
index ba0b31495b..6cd19f9b6f 100755
--- a/lib/Math/BigInt/t/bigintpm.t
+++ b/lib/Math/BigInt/t/bigintpm.t
@@ -10,7 +10,7 @@ BEGIN
   my $location = $0; $location =~ s/bigintpm.t//;
   unshift @INC, $location; # to locate the testing files
   chdir 't' if -d 't';
-  plan tests => 2848;
+  plan tests => 2952;
   }
 
 use Math::BigInt;
diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t
index 0dae63ea4d..e9209b70c4 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 => 1861
+  plan tests => 1924
     + 6;	# + our own tests
   }
 
diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t
index 69abaae17d..ee48b81234 100755
--- a/lib/Math/BigInt/t/sub_mbi.t
+++ b/lib/Math/BigInt/t/sub_mbi.t
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 2848
+  plan tests => 2952
     + 5;	# +5 own tests
   }
 
diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc
index 4799420fd8..aac4a055eb 100644
--- a/lib/Math/BigInt/t/upgrade.inc
+++ b/lib/Math/BigInt/t/upgrade.inc
@@ -1282,7 +1282,8 @@ abc:12:NaN
 2:-2:NaN
 -2:-2:NaN
 +inf:1234500012:inf
--inf:1234500012:-inf
+-inf:1234500012:inf
+-inf:1234500013:-inf
 +inf:-12345000123:inf
 -inf:-12345000123:-inf
 # 1 ** -x => 1 / (1 ** x)
diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t
index a06aec352e..ac137c1af1 100644
--- a/lib/Math/BigInt/t/upgrade.t
+++ b/lib/Math/BigInt/t/upgrade.t
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 2098
+  plan tests => 2100
    + 2;			# our own tests
   }
 
diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t
index f34b88758b..8611e45b12 100644
--- a/lib/Math/BigInt/t/with_sub.t
+++ b/lib/Math/BigInt/t/with_sub.t
@@ -28,7 +28,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1861
+  plan tests => 1924
 	+ 1;
   }