Upgrade to Math::BigInt pre-rel 1.66 as of

http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2003-09/msg00242.html
(the tar.gz link doesn't have 'v1.66', it has '1.66')
so that the smoke builds can start chewing it.

p4raw-id: //depot/perl@21025

12 files changed, 160 insertions, 49 deletions

diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index ad3e12ae30..6c1c36d4e3 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.65';
+$VERSION = '1.66';
 use Exporter;
 @ISA =       qw( Exporter );
 @EXPORT_OK = qw( objectify _swap bgcd blcm); 
@@ -1751,7 +1751,7 @@ sub bpow
   # (BINT or num_str, BINT or num_str) return BINT
   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
   # modifies first argument
-  
+
   # set up parameters
   my ($self,$x,$y,@r) = (ref($_[0]),@_);
   # objectify is costly, so avoid it
@@ -2742,7 +2742,7 @@ sub _split
 
   # some possible inputs: 
   # 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
+  # .2 	   # 1_2_3.4_5_6 # 1.4E1_2_3  # 1e3 # +.2     # 0e999	
 
   #return if $$x =~ /[Ee].*[Ee]/;	# more than one E => error
 
@@ -2768,6 +2768,8 @@ sub _split
       $mis = $1||'+'; $miv = $2;
       return unless ($mf =~ /^(\d*?)0*$/);	# strip trailing zeros
       $mfv = $1;
+      # handle the 0e999 case here
+      $ev = 0 if $miv eq '0' && $mfv eq '';
       return (\$mis,\$miv,\$mfv,\$es,\$ev);
       }
     }
@@ -3041,32 +3043,29 @@ exactly what you expect.
 
 =over 2
 
-=item Canonical notation
-
-Big integer values are strings of the form C</^[+-]\d+$/> with leading
-zeros suppressed.
+=item Input
 
-   '-0'                            canonical value '-0', normalized '0'
-   '   -123_123_123'               canonical value '-123123123'
-   '1_23_456_7890'                 canonical value '1234567890'
+Input values to these routines may be any string, that looks like a number
+and results in an integer, including hexadecimal and binary numbers.
 
-=item Input
+Scalars holding numbers may also be passed, but note that non-integer numbers
+may already have lost precision due to the conversation to float. Quote
+your input if you want BigInt to see all the digits.
 
-Input values to these routines may be either Math::BigInt objects or
-strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>, or
-hexadecimal C</^\s*[+-]?[0-9a-f]+$/i>, or binary C</^\s*[+-]?[01]+$/>.
+	$x = Math::BigInt->new(12345678890123456789);	# bad
+	$x = Math::BigInt->new('12345678901234567890');	# good
 
 You can include one underscore between any two digits.
 
 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
-Non integer values result in NaN.
+Non-integer values result in NaN.
 
-Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
-in 'NaN'.
+Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
+results in 'NaN'.
 
-bnorm() on a BigInt object is now effectively a no-op, since the numbers 
+C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers 
 are always stored in normalized form. On a string, it creates a BigInt 
-object.
+object from the input.
 
 =item Output
 
@@ -3228,10 +3227,12 @@ result).
 
   	$x = Math::BigInt->new($str,$A,$P,$R);
 
-Creates a new BigInt object from a string or another BigInt object. The
+Creates a new BigInt object from a scalar or another BigInt object. The
 input is accepted as decimal, hex (with leading '0x') or binary (with leading
 '0b').
 
+See L<Input> for more info on accepted input formats.
+
 =head2 bnan
 
   	$x = Math::BigInt->bnan();
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index a3091c75c8..c09e07a628 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.35';
+$VERSION = '0.36';
 
 # Package to store unsigned big integers in decimal and do math with them
 
@@ -513,8 +513,18 @@ sub _div_use_mul
   {
   # ref to array, ref to array, modify first array and return remainder if 
   # in list context
+
+  # see comments in _div_use_div() for more explanations
+
   my ($c,$x,$yorg) = @_;
+  
+  # the general div algorithmn here is about O(N*N) and thus quite slow, so
+  # we first check for some special cases and use shortcuts to handle them.
 
+  # This works, because we store the numbers in a chunked format where each
+  # element contains 5..7 digits (depending on system).
+
+  # if both numbers have only one element:
   if (@$x == 1 && @$yorg == 1)
     {
     # shortcut, $yorg and $x are two small numbers
@@ -530,6 +540,8 @@ sub _div_use_mul
       return $x; 
       }
     }
+
+  # if x has more than one, but y has only one element:
   if (@$yorg == 1)
     {
     my $rem;
@@ -549,6 +561,69 @@ sub _div_use_mul
     return $x;
     }
 
+  # now x and y have more than one element
+
+  # check whether y has more elements than x, if yet, the result will be 0
+  if (@$yorg > @$x)
+    {
+    my $rem;
+    $rem = [@$x] if wantarray;                  # make copy
+    splice (@$x,1);                             # keep ref to original array
+    $x->[0] = 0;                                # set to 0
+    return ($x,$rem) if wantarray;              # including remainder?
+    return $x;					# only x, which is [0] now
+    }
+  # check whether the numbers have the same number of elements, in that case
+  # the result will fit into one element and can be computed efficiently
+  if (@$yorg == @$x)
+    {
+    my $rem;
+    # if $yorg has more digits than $x (it's leading element is longer than
+    # the one from $x), the result will also be 0:
+    if (length(int($yorg->[-1])) > length(int($x->[-1])))
+      {
+      $rem = [@$x] if wantarray;		# make copy
+      splice (@$x,1);				# keep ref to org array
+      $x->[0] = 0;				# set to 0
+      return ($x,$rem) if wantarray;		# including remainder?
+      return $x;
+      }
+    # now calculate $x / $yorg
+    if (length(int($yorg->[-1])) == length(int($x->[-1])))
+      {
+      # same length, so make full compare, and if equal, return 1
+      # hm, same lengths, but same contents? So we need to check all parts:
+      my $a = 0; my $j = scalar @$x - 1;
+      # manual way (abort if unequal, good for early ne)
+      while ($j >= 0)
+        {
+        last if ($a = $x->[$j] - $yorg->[$j]); $j--;
+        }
+      # $a contains the result of the compare between X and Y
+      # a < 0: x < y, a == 0 => x == y, a > 0: x > y
+      if ($a <= 0)
+        {
+        if (wantarray)
+	  {
+          $rem = [ 0 ];			# a = 0 => x == y => rem 1
+          $rem = [@$x] if $a != 0;	# a < 0 => x < y => rem = x
+	  }
+        splice(@$x,1);			# keep single element
+        $x->[0] = 0;			# if $a < 0
+        if ($a == 0)
+          {
+          # $x == $y
+          $x->[0] = 1;
+          }
+        return ($x,$rem) if wantarray;
+        return $x;
+        }
+      # $x >= $y, proceed normally
+      }
+    }
+
+  # all other cases:
+
   my $y = [ @$yorg ];				# always make copy to preserve
 
   my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
@@ -580,7 +655,7 @@ sub _div_use_mul
     $u2 = 0 unless $u2;
     #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
     # if $v1 == 0;
-     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
+    $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
     --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2);
     if ($q)
       {
@@ -597,11 +672,12 @@ sub _div_use_mul
 	for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) 
           {
 	  $x->[$xi] -= $MBASE
-	   if ($car = (($x->[$xi] += $y->[$yi] + $car) > $MBASE));
+	   if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE));
 	  }
 	}   
       }
-      pop(@$x); unshift(@q, $q);
+    pop(@$x);
+    unshift(@q, $q);
     }
   if (wantarray) 
     {
@@ -688,7 +764,7 @@ sub _div_use_div
     splice (@$x,1);				# keep ref to original array
     $x->[0] = 0;				# set to 0
     return ($x,$rem) if wantarray;		# including remainder?
-    return $x;
+    return $x;					# only x, which is [0] now
     }
   # check whether the numbers have the same number of elements, in that case
   # the result will fit into one element and can be computed efficiently
@@ -709,18 +785,23 @@ sub _div_use_div
     if (length(int($yorg->[-1])) == length(int($x->[-1])))
       {
       # same length, so make full compare, and if equal, return 1
-      # hm, same lengths,  but same contents? So we need to check all parts:
+      # hm, same lengths, but same contents? So we need to check all parts:
       my $a = 0; my $j = scalar @$x - 1;
       # manual way (abort if unequal, good for early ne)
       while ($j >= 0)
         {
         last if ($a = $x->[$j] - $yorg->[$j]); $j--;
         }
+      # $a contains the result of the compare between X and Y
       # a < 0: x < y, a == 0 => x == y, a > 0: x > y
       if ($a <= 0)
         {
-        $rem = [@$x] if wantarray;
-        splice(@$x,1);
+        if (wantarray)
+	  {
+          $rem = [ 0 ];			# a = 0 => x == y => rem 1
+          $rem = [@$x] if $a != 0;	# a < 0 => x < y => rem = x
+	  }
+        splice(@$x,1);			# keep single element
         $x->[0] = 0;			# if $a < 0
         if ($a == 0)
           {
@@ -730,9 +811,8 @@ sub _div_use_div
         return ($x,$rem) if wantarray;
         return $x;
         }
-      # $x >= $y, proceed normally
+      # $x >= $y, so proceed normally
       }
-
     }
 
   # all other cases:
@@ -760,6 +840,10 @@ sub _div_use_div
     {
     push(@$x, 0);
     }
+
+  # @q will accumulate the final result, $q contains the current computed
+  # part of the final result
+
   @q = (); ($v2,$v1) = @$y[-2,-1];
   $v2 = 0 unless $v2;
   while ($#$x > $#$y) 
@@ -768,7 +852,7 @@ sub _div_use_div
     $u2 = 0 unless $u2;
     #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
     # if $v1 == 0;
-     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
+    $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
     --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2);
     if ($q)
       {
@@ -785,7 +869,7 @@ sub _div_use_div
 	for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) 
           {
 	  $x->[$xi] -= $MBASE
-	   if ($car = (($x->[$xi] += $y->[$yi] + $car) > $MBASE));
+	   if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE));
 	  }
 	}   
       }
@@ -1013,6 +1097,7 @@ sub _mod
     my ($xo,$rem) = _div($c,$x,$yo);
     return $rem;
     }
+
   my $y = $yo->[0];
   # both are single element arrays
   if (scalar @$x == 1)
@@ -1021,7 +1106,7 @@ sub _mod
     return $x;
     }
 
-  # @y is single element, but @x has more than one
+  # @y is a single element, but @x has more than one element
   my $b = $BASE % $y;
   if ($b == 0)
     {
diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t
index d11daf7e8e..1c4a97add8 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 => 1760;
+  plan tests => 1768;
   }
 
 use Math::BigFloat lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t
index 61064668e7..0c27c3e02f 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 => 2648;
+  plan tests => 2668;
   }
 
 use Math::BigInt lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
index 2cb55437a2..712caa60ec 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -431,6 +431,10 @@ abc:NaN
 11111b:NaN
 +1z:NaN
 -1z:NaN
+0e999:0
+0e-999:0
+-0e999:0
+-0e-999:0
 0:0
 +0:0
 +00:0
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index 000856bd17..0d73a7d99e 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 => 1760
+  plan tests => 1768
 	+ 2;		# own tests
   }
 
diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc
index 3852c1c3dc..caf722c287 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -769,6 +769,10 @@ NaN:inf:
 -inf:NaN:
 NaN:-inf:
 &bnorm
+0e999:0
+0e-999:0
+-0e999:0
+-0e-999:0
 123:123
 # binary input
 0babc:NaN
@@ -1473,6 +1477,11 @@ inf:0:inf
 1234567890999999999:9876543210:124999998
 1234567890000000000:9876543210:124999998
 96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199
+# bug up to v0.35 in Calc (--$q one too many)
+84696969696969696956565656566184292929292929292847474747436308080808080808086765396464646464646465:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999999
+84696969696969696943434343434871161616161616161452525252486813131313131313143230042929292929292930:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999998
+84696969696969696969696969697497424242424242424242424242385803030303030303030300750000000000000000:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6450000000000000000
+84696969696969696930303030303558030303030303030057575757537318181818181818199694689393939393939395:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999997
 &bmodinv
 # format: number:modulus:result
 # bmodinv Data errors
@@ -1618,6 +1627,10 @@ abc:1:abc:NaN
 123456789123456789:113:39
 # bug in bmod() not modifying the variable in place
 -629:5033:4404
+# bug in bmod() in Calc in the _div_use_div() shortcut code path,
+# when X == X and X was big 
+111111111111111111111111111111:111111111111111111111111111111:0
+12345678901234567890:12345678901234567890:0
 &bgcd
 abc:abc:NaN
 abc:+0:NaN
diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
index 2522f8319b..0bc4ac4c8a 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 => 2648;
+  plan tests => 2668;
   }
 
 use Math::BigInt;
diff --git a/lib/Math/BigInt/t/mbi_rand.t b/lib/Math/BigInt/t/mbi_rand.t
index fa8e966b0a..a7bd929835 100644
--- a/lib/Math/BigInt/t/mbi_rand.t
+++ b/lib/Math/BigInt/t/mbi_rand.t
@@ -23,9 +23,9 @@ my $c = 'Math::BigInt';
 my $length = 128;
 
 # If you get a failure here, please re-run the test with the printed seed
-# value as input: perl t/mbi_rand.t seed
+# value as input "perl t/mbi_rand.t seed" and send me the output
 
-my $seed = ($#ARGV == 0) ? $ARGV[0] : int(rand(65537));
+my $seed = ($#ARGV == 0) ? $ARGV[0] : int(rand(1165537));
 print "# seed: $seed\n"; srand($seed);
 
 my ($A,$B,$As,$Bs,$ADB,$AMB,$la,$lb);
@@ -35,12 +35,14 @@ for (my $i = 0; $i < $count; $i++)
   # length of A and B
   $la = int(rand($length)+1); $lb = int(rand($length)+1);
   $As = ''; $Bs = '';
+
   # we create the numbers from "patterns", e.g. get a random number and a
   # random count and string them together. This means things like
   # "100000999999999999911122222222" are much more likely. If we just strung
   # together digits, we would end up with "1272398823211223" etc.
   while (length($As) < $la) { $As .= int(rand(100)) x int(rand(16)); }
   while (length($Bs) < $lb) { $Bs .= int(rand(100)) x int(rand(16)); }
+
   $As =~ s/^0+//; $Bs =~ s/^0+//; 
   $As = $As || '0'; $Bs = $Bs || '0';
   # print "# As $As\n# Bs $Bs\n";
@@ -50,23 +52,29 @@ for (my $i = 0; $i < $count; $i++)
     {
     for (1..4) { ok (1,1); } next;
     }
+
   # check that int(A/B)*B + A % B == A holds for all inputs
+
   # $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B);
+
   ($ADB,$AMB) = $A->copy()->bdiv($B);
-  print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
+#  print "# ($A / $B, $A % $B ) = $ADB $AMB\n";
+
+  print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
         "# tried $ADB * $B + $two*$AMB - $AMB\n"
    unless ok ($ADB*$B+$two*$AMB-$AMB,$As);
-  ok ($ADB*$B/$B,$ADB);
+  print "\$ADB * \$B / \$B = ", $ADB * $B / $B, " != $ADB (\$B=$B)\n"
+   unless ok ($ADB*$B/$B,$ADB);
   # swap 'em and try this, too
   # $X = ($B/$A)*$A + $B % $A;
   ($ADB,$AMB) = $B->copy()->bdiv($A);
   #print "check: $ADB $AMB";
-  print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
+  print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
         "# tried $ADB * $A + $two*$AMB - $AMB\n"
    unless ok ($ADB*$A+$two*$AMB-$AMB,$Bs);
-  #print "$ADB * $A = ",$ADB * $A,"\n";
-  #print " +$two * $AMB = ",$ADB * $A + $two * $AMB,"\n";
-  #print " -$AMB = ",$ADB * $A + $two * $AMB - $AMB,"\n";
-  ok ($ADB*$A/$A,$ADB);
+#  print " +$two * $AMB = ",$ADB * $A + $two * $AMB,"\n";
+#  print " -$AMB = ",$ADB * $A + $two * $AMB - $AMB,"\n";
+  print "\$ADB * \$A / \$A = ", $ADB * $A / $A, " != $ADB (\$A=$A)\n"
+   unless ok ($ADB*$A/$A,$ADB);
   }
 
diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t
index c812191678..d2c19c267d 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 => 1760
+  plan tests => 1768
     + 6;	# + our own tests
   }
 
diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t
index 39e47d5a2a..1979173b24 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 => 2648
+  plan tests => 2668
     + 5;	# +5 own tests
   }
 
diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t
index 2b6d8716ed..c4319aa570 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 => 1760
+  plan tests => 1768
 	+ 1;
   }