Upgrage to bignum-0.21 and Math-BigRat-0.19

p4raw-id: //depot/perl@31169

2 files changed, 256 insertions, 46 deletions

diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm
index 4668197172..7732c36555 100644
--- a/lib/Math/BigRat.pm
+++ b/lib/Math/BigRat.pm
@@ -23,7 +23,7 @@ use vars qw($VERSION @ISA $upgrade $downgrade
 
 @ISA = qw(Math::BigFloat);
 
-$VERSION = '0.18';
+$VERSION = '0.19';
 
 use overload;			# inherit overload from Math::BigFloat
 
@@ -209,8 +209,7 @@ sub new
       $self->{_d} = $MBI->_copy( $f->{_m} );
 
       # calculate the difference between nE and dE
-      # XXX TODO: check that exponent() makes a copy to avoid copy()
-      my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
+      my $diff_e = $nf->exponent()->bsub( $f->exponent);
       if ($diff_e->is_negative())
 	{
         # < 0: mul d with it
@@ -385,14 +384,13 @@ sub bnorm
   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 
   # Both parts must be objects of whatever we are using today.
-  # Second check because Calc.pm has ARRAY res as unblessed objects.
-  if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
+  if ( my $c = $MBI->_check($x->{_n}) )
     {
-    require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
+    require Carp; Carp::croak ("n did not pass the self-check ($c) in bnorm()");
     }
-  if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
+  if ( my $c = $MBI->_check($x->{_d}) )
     {
-    require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
+    require Carp; Carp::croak ("d did not pass the self-check ($c) in bnorm()");
     }
 
   # no normalize for NaN, inf etc.
diff --git a/lib/Math/BigRat/t/bigfltpm.inc b/lib/Math/BigRat/t/bigfltpm.inc
index a0a74532e2..45f48acc5b 100644
--- a/lib/Math/BigRat/t/bigfltpm.inc
+++ b/lib/Math/BigRat/t/bigfltpm.inc
@@ -4,6 +4,8 @@ ok ($class->config()->{lib},$CL);
 
 use strict;
 
+my $z;
+
 while (<DATA>)
   {
   chomp;
@@ -30,7 +32,7 @@ while (<DATA>)
       {
       @args = split(/:/,$_,99); $ans = pop(@args);
       }
-    $try = "\$x = $class->new('$args[0]');";
+    $try = "\$x = $class->new(\"$args[0]\");";
     if ($f eq "fnorm")
       {
         $try .= "\$x;";
@@ -74,7 +76,7 @@ while (<DATA>)
       } elsif ($f eq "ffac") {
         $try .= "$setup; \$x->ffac();";
       } elsif ($f eq "flog") {
-        if ($args[1] ne '')
+        if (defined $args[1] && $args[1] ne '')
           {
           $try .= "\$y = $class->new($args[1]);";
           $try .= "$setup; \$x->flog(\$y);";
@@ -87,8 +89,28 @@ while (<DATA>)
     else
       {
       $try .= "\$y = $class->new(\"$args[1]\");";
-      if ($f eq "fcmp") {
-        $try .= '$x <=> $y;';
+      
+      if ($f eq "bgcd")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = $class->new(\"$args[2]\"); ";
+          }
+        $try .= "$class\::bgcd(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+        }
+      elsif ($f eq "blcm")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = $class->new(\"$args[2]\"); ";
+          }
+        $try .= "$class\::blcm(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+      } elsif ($f eq "fcmp") {
+        $try .= '$x->fcmp($y);';
       } elsif ($f eq "facmp") {
         $try .= '$x->facmp($y);';
       } elsif ($f eq "fpow") {
@@ -113,8 +135,9 @@ while (<DATA>)
         $try .= '$x % $y;';
       } else { warn "Unknown op '$f'"; }
     }
-     print "# Trying: '$try'\n";
+    # print "# Trying: '$try'\n";
     $ans1 = eval $try;
+    print "# Error: $@\n" if $@;
     if ($ans =~ m|^/(.*)$|)
       {
       my $pat = $1;
@@ -142,7 +165,7 @@ while (<DATA>)
 	  # trailing zeros
 	  #print $ans1->_trailing_zeros(),"\n";
           print "# Has trailing zeros after '$try'\n"
-	   if ref($ans) eq 'HASH' && exists $ans->{_m} && !ok ($ans1->{_m}->_trailing_zeros(), 0);
+	   if !ok ($CL->_zeros( $ans1->{_m}), 0);
 	  }
         }
       } # end pattern or string
@@ -163,19 +186,25 @@ ok ($y,1200); ok ($x,1200);
 # anyway. We don't test everything here, but let's make sure it just basically
 # works.
 
-#
-#my $monster = '1e1234567890123456789012345678901234567890';
-#
-## new
-#ok ($class->new($monster)->bsstr(), 
-#		'1e+1234567890123456789012345678901234567890');
-## cmp
-#ok ($class->new($monster) > 0,1);
-#
-## sub/mul 
-#ok ($class->new($monster)->bsub( $monster),0);
-#ok ($class->new($monster)->bmul(2)->bsstr(),
-#                '2e+1234567890123456789012345678901234567890');
+my $monster = '1e1234567890123456789012345678901234567890';
+
+# new and exponent
+ok ($class->new($monster)->bsstr(), 
+		'1e+1234567890123456789012345678901234567890');
+ok ($class->new($monster)->exponent(), 
+		'1234567890123456789012345678901234567890');
+# cmp
+ok ($class->new($monster) > 0,1);
+
+# sub/mul 
+ok ($class->new($monster)->bsub( $monster),0);
+ok ($class->new($monster)->bmul(2)->bsstr(),
+                '2e+1234567890123456789012345678901234567890');
+
+# mantissa
+$monster = '1234567890123456789012345678901234567890e2';
+ok ($class->new($monster)->mantissa(), 
+		'123456789012345678901234567890123456789');
 
 ###############################################################################
 # zero,inf,one,nan
@@ -246,6 +275,77 @@ $class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464');
 ok ($class->new(-1)->is_one(),0);
 ok ($class->new(-1)->is_one('-'),1);
 
+#############################################################################
+# bug 1/0.5 leaving 2e-0 instead of 2e0
+
+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');
+
+###############################################################################
+# the following two were reported by "kenny" via hotmail.com:
+
+#perl -MMath::BigFloat -wle 'print Math::BigFloat->new(0)->bpow(".1")'
+#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851.
+
+$x = $class->new(0); $y = $class->new('0.1');
+ok ($x ** $y, 0, 'no warnings and zero result');
+
+#perl -MMath::BigFloat -lwe 'print Math::BigFloat->new(".222222222222222222222222222222222222222222")->bceil()'
+#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851.
+
+$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
 
 ###############################################################################
@@ -260,6 +360,42 @@ sub ok_undef
   }
 
 __DATA__
+&bgcd
+inf:12:NaN
+-inf:12:NaN
+12:inf:NaN
+12:-inf:NaN
+inf:inf:NaN
+inf:-inf:NaN
+-inf:-inf:NaN
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++0:+1:1
++1:+0:1
++1:+1:1
++2:+3:1
++3:+2:1
+-3:+2:1
+-3:-2:1
+-144:-60:12
+144:-60:12
+144:60:12
+100:625:25
+4096:81:1
+1034:804:2
+27:90:56:1
+27:90:54:9
+&blcm
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:NaN
++1:+0:0
++0:+1:0
++27:+90:270
++1034:+804:415668
 $div_scale = 40;
 &flog
 0::NaN
@@ -273,22 +409,22 @@ $div_scale = 40;
 1::0
 1:1:0
 1:2:0
-# this is too slow for the testsuite
-#2:0.6931471805599453094172321214581765680755
-#2.718281828:0.9999999998311266953289851340574956564911
-#$div_scale = 20;
-#2.718281828:0.99999999983112669533
-# too slow, too 
-#123:4.8112184355
-$div_scale = 14;
-#10:0:2.302585092994
-#1000:0:6.90775527898214
-#100:0:4.60517018598809
-2::0.69314718055995
-#3.1415:0:1.14470039286086
-# too slow
-#12345:0:9.42100640177928
-#0.001:0:-6.90775527898214
+2::0.6931471805599453094172321214581765680755
+2.718281828::0.9999999998311266953289851340574956564911
+$div_scale = 20;
+2.718281828::0.99999999983112669533
+$div_scale = 15;
+123::4.81218435537242
+10::2.30258509299405
+1000::6.90775527898214
+100::4.60517018598809
+2::0.693147180559945
+3.1415::1.14470039286086
+12345::9.42100640177928
+0.001::-6.90775527898214
+# bug until v1.71:
+10:10:1
+100:100:1
 # reset for further tests
 $div_scale = 40;
 1::0
@@ -319,10 +455,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
@@ -477,6 +640,18 @@ abc:NaN
 -3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
 -4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
 &fpow
+NaN:1:NaN
+1:NaN:NaN
+NaN:-1:NaN
+-1:NaN:NaN
+NaN:-21:NaN
+-21:NaN:NaN
+NaN:21:NaN
+21:NaN:NaN
+0:0:1
+0:1:0
+0:9:0
+0:-2:inf
 2:2:4
 1:2:1
 1:3:1
@@ -492,6 +667,14 @@ abc:123.456:NaN
 -inf:123.45:-inf
 +inf:-123.45:inf
 -inf:-123.45:-inf
+-2:2:4
+-2:3:-8
+-2:4:16
+-2:5:-32
+-3:2:9
+-3:3:-27
+-3:4:81
+-3:5:-243
 # 2 ** 0.5 == sqrt(2)
 #     1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0)
 2:0.5:1.41421356237309504880168872420969807857
@@ -581,6 +764,22 @@ $round_mode = "even"
 -601234500:6:-601234000
 +60123456789.0123:5:60123000000
 -60123456789.0123:5:-60123000000
+$round_mode = "common"
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:6:60123500000
+-60123456789:6:-60123500000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601235000
+-601234500:6:-601235000
++601234400:6:601234000
+-601234400:6:-601234000
++601234600:6:601235000
+-601234600:6:-601235000
++601234300:6:601234000
++60123456789.0123:5:60123000000
+-60123456789.0123:5:-60123000000
 &ffround
 $round_mode = "trunc"
 +inf:5:inf
@@ -1038,6 +1237,11 @@ NaNmul:-inf:NaN
 0:1:0,0
 9:4:2.25,1
 9:5:1.8,4
+# bug in v1.74 with bdiv in list context, when $y is 1 or -1
+2.1:-1:-2.1,0
+2.1:1:2.1,0
+-2.1:-1:2.1,0
+-2.1:1:-2.1,0
 &fdiv
 $div_scale = 40; $round_mode = 'even'
 abc:abc:NaN
@@ -1199,6 +1403,14 @@ abc:1:abc:NaN
 1230:2.5:0
 123.4:2.5:0.9
 123e1:25:5
+-2.1:1:0.9
+2.1:1:0.1
+-2.1:-1:-0.1
+2.1:-1:-0.9
+-3:1:0
+3:1:0
+-3:-1:0
+3:-1:0
 &ffac
 Nanfac:NaN
 -1:NaN
@@ -1355,7 +1567,7 @@ abc:0
 1200:1
 -1200:1
 &is_positive
-0:1
+0:0
 1:1
 -1:0
 -123:0