Math::BigInt 1.80

Message-Id: <200703041557.02996@bloodgate.com>

p4raw-id: //depot/perl@30460

12 files changed, 154 insertions, 29 deletions

diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index f15781155f..f569036459 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -13,7 +13,7 @@ package Math::BigFloat;
 #   _p	: precision
 
 $VERSION = '1.53';
-require 5.005;
+require 5.006002;
 
 require Exporter;
 @ISA =       qw(Exporter Math::BigInt);
@@ -25,9 +25,20 @@ use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
 my $class = "Math::BigFloat";
 
 use overload
-'<=>'	=>	sub { $_[2] ?
+'<=>'	=>	sub { my $rc = $_[2] ?
                       ref($_[0])->bcmp($_[1],$_[0]) : 
-                      ref($_[0])->bcmp($_[0],$_[1])},
+                      ref($_[0])->bcmp($_[0],$_[1]); 
+		      $rc = 1 unless defined $rc;
+		      $rc <=> 0;
+		},
+# we need '>=' to get things like "1 >= NaN" right:
+'>='	=>	sub { my $rc = $_[2] ?
+                      ref($_[0])->bcmp($_[1],$_[0]) : 
+                      ref($_[0])->bcmp($_[0],$_[1]);
+		      # if there was a NaN involved, return false
+		      return '' unless defined $rc;
+		      $rc >= 0;
+		},
 'int'	=>	sub { $_[0]->as_number() },		# 'trunc' to bigint
 ;
 
@@ -101,6 +112,7 @@ BEGIN
         accuracy precision div_scale round_mode fabs fnot
         objectify upgrade downgrade
 	bone binf bnan bzero
+	bsub
       /;
 
   sub _method_alias { exists $methods{$_[0]||''}; } 
@@ -127,7 +139,7 @@ sub new
 
   my $self = {}; bless $self, $class;
   # shortcut for bigints and its subclasses
-  if ((ref($wanted)) && (ref($wanted) ne $class))
+  if ((ref($wanted)) && UNIVERSAL::can( $wanted, "as_number"))
     {
     $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
     $self->{_e} = $MBI->_zero();
@@ -135,7 +147,7 @@ sub new
     $self->{sign} = $wanted->sign();
     return $self->bnorm();
     }
-  # else: got a string
+  # else: got a string or something maskerading as number (with overload)
 
   # handle '+inf', '-inf' first
   if ($wanted =~ /^[+-]?inf\z/)
@@ -747,7 +759,6 @@ sub blog
   # also takes care of the "error in _find_round_parameters?" case
   return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
 
-
   # no rounding at all, so must use fallback
   if (scalar @params == 0)
     {
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index ac351dbae5..600970fde3 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -16,9 +16,9 @@ package Math::BigInt;
 # underlying lib might change the reference!
 
 my $class = "Math::BigInt";
-use 5.005;
+use 5.006002;
 
-$VERSION = '1.79';
+$VERSION = '1.80';
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(objectify bgcd blcm); 
@@ -62,10 +62,20 @@ use overload
 # not supported by Perl yet
 '..'	=>	\&_pointpoint,
 
-# we might need '==' and '!=' to get things like "NaN == NaN" right
-'<=>'	=>	sub { $_[2] ?
+'<=>'	=>	sub { my $rc = $_[2] ?
                       ref($_[0])->bcmp($_[1],$_[0]) : 
-                      $_[0]->bcmp($_[1]); },
+                      $_[0]->bcmp($_[1]); 
+		      $rc = 1 unless defined $rc;
+		      $rc <=> 0;
+		},
+# we need '>=' to get things like "1 >= NaN" right:
+'>='	=>	sub { my $rc = $_[2] ?
+                      ref($_[0])->bcmp($_[1],$_[0]) : 
+                      $_[0]->bcmp($_[1]);
+		      # if there was a NaN involved, return false
+		      return '' unless defined $rc;
+		      $rc >= 0;
+		},
 'cmp'	=>	sub {
          $_[2] ? 
                "$_[1]" cmp $_[0]->bstr() :
@@ -83,7 +93,8 @@ use overload
 #'hex'	=>	sub { print "hex"; $_[0]; }, 
 #'oct'	=>	sub { print "oct"; $_[0]; }, 
 
-'log'	=>	sub { $_[0]->copy()->blog($_[1]); }, 
+# log(N) is log(N, e), where e is Euler's number
+'log'	=>	sub { $_[0]->copy()->blog($_[1], undef); }, 
 'int'	=>	sub { $_[0]->copy(); }, 
 'neg'	=>	sub { $_[0]->copy()->bneg(); }, 
 'abs'	=>	sub { $_[0]->copy()->babs(); },
@@ -1225,7 +1236,7 @@ sub blog
     {
     ($self,$x,$base,@r) = objectify(1,ref($x),@_);
     }
-  
+
   return $x if $x->modify('blog');
 
   # inf, -inf, NaN, <0 => NaN
@@ -1235,6 +1246,18 @@ sub blog
   return $upgrade->blog($upgrade->new($x),$base,@r) if 
     defined $upgrade;
 
+  # fix for bug #24969:
+  # the default base is e (Euler's number) which is not an integer
+  if (!defined $base)
+    {
+    require Math::BigFloat;
+    my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
+    # modify $x in place
+    $x->{value} = $u->{value};
+    $x->{sign} = $u->{sign};
+    return $x;
+    }
+  
   my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
   return $x->bnan() unless defined $rc;		# not possible to take log?
   $x->{value} = $rc;
@@ -1404,7 +1427,7 @@ sub bmul
     {
     ($self,$x,$y,@r) = objectify(2,@_);
     }
-  
+
   return $x if $x->modify('bmul');
 
   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
@@ -1802,7 +1825,7 @@ sub brsft
       $bin =~ s/^-0b//;			# strip '-0b' prefix
       $bin =~ tr/10/01/;		# flip bits
       # now shift
-      if (CORE::length($bin) <= $y)
+      if ($y >= CORE::length($bin))
         {
 	$bin = '0'; 			# shifting to far right creates -1
 					# 0, because later increment makes 
@@ -2351,7 +2374,7 @@ sub objectify
       elsif (!defined $up && ref($k) ne $a[0])
 	{
 	# foreign object, try to convert to integer
-        $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
+        $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
 	}
       push @a,$k;
       }
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index 77ce4de70f..6fb21b00d2 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -1,6 +1,6 @@
 package Math::BigInt::Calc;
 
-use 5.005;
+use 5.006002;
 use strict;
 # use warnings;	# dont use warnings for older Perls
 
diff --git a/lib/Math/BigInt/CalcEmu.pm b/lib/Math/BigInt/CalcEmu.pm
index f56b51a3b9..79efac6753 100644
--- a/lib/Math/BigInt/CalcEmu.pm
+++ b/lib/Math/BigInt/CalcEmu.pm
@@ -1,6 +1,6 @@
 package Math::BigInt::CalcEmu;
 
-use 5.005;
+use 5.006002;
 use strict;
 # use warnings;	# dont use warnings for older Perls
 use vars qw/$VERSION/;
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
index 2a45c8278e..45f48acc5b 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -110,7 +110,7 @@ while (<DATA>)
         $try .= ", \$z" if (defined $args[2]);
         $try .= " );";
       } elsif ($f eq "fcmp") {
-        $try .= '$x <=> $y;';
+        $try .= '$x->fcmp($y);';
       } elsif ($f eq "facmp") {
         $try .= '$x->facmp($y);';
       } elsif ($f eq "fpow") {
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index 87c9527ec6..65f791d9fa 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -27,7 +27,7 @@ BEGIN
   print "# INC = @INC\n";
 
   plan tests => 2042
-	+ 2;		# own tests
+	+ 3;		# own tests
   }
 
 use Math::BigInt lib => 'Calc';
@@ -39,5 +39,9 @@ $CL = "Math::BigInt::Calc";
 
 ok ($class->config()->{class},$class);
 ok ($class->config()->{with}, $CL);
+
+# bug #17447: Can't call method Math::BigFloat->bsub, not a valid method
+my $c = new Math::BigFloat( '123.3' );
+ok ($c->fsub(123) eq '0.3', 1); # calling fsub on a BigFloat works
  
 require 'bigfltpm.inc';	# all tests here for sharing
diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc
index 07efc283f0..c62d73e53d 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -94,7 +94,7 @@ while (<DATA>)
     $try .= "\$y = $class->new('$args[1]');";
     if ($f eq "bcmp")
       {
-      $try .= '$x <=> $y;';
+      $try .= '$x->bcmp($y);';
       } elsif ($f eq "bround") {
       $try .= "$round_mode; \$x->bround(\$y);";
       } elsif ($f eq "bacmp"){
diff --git a/lib/Math/BigInt/t/biglog.t b/lib/Math/BigInt/t/biglog.t
index cba26435d3..0958ddcc81 100644
--- a/lib/Math/BigInt/t/biglog.t
+++ b/lib/Math/BigInt/t/biglog.t
@@ -37,13 +37,23 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 53;
+  plan tests => 56;
   }
 
 use Math::BigFloat;
 use Math::BigInt;
 
-my $cl = "Math::BigFloat";
+my $cl = "Math::BigInt";
+
+# test log($n) in BigInt (broken until 1.80)
+
+ok ($cl->new(2)->blog(), '0');
+ok ($cl->new(288)->blog(), '5');
+ok ($cl->new(2000)->blog(), '7');
+
+#############################################################################
+
+$cl = "Math::BigFloat";
 
 # These tests are now really fast, since they collapse to blog(10), basically
 # Don't attempt to run them with older versions. You are warned.
diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc
index 51fea643d2..a5ea3f623c 100644
--- a/lib/Math/BigInt/t/mbimbf.inc
+++ b/lib/Math/BigInt/t/mbimbf.inc
@@ -395,13 +395,14 @@ $z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900);
 $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
 
 my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
-# these should warn, since '3.17' is a NaN in BigInt and thus >= returns undef
-$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1);
+# these should no longer warn, even tho '3.17' is a NaN in BigInt (>= returns
+# now false, bug until v1.80)
+$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, '');
 print "# Got: '$warn'\n" unless
-ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);	
-$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1);
+ok ($warn !~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);	
+$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, '');
 print "# Got: '$warn'\n" unless
-ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);	
+ok ($warn !~ /^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);	
 
 # XXX TODO breakage:
 # $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
diff --git a/lib/Math/BigInt/t/nan_cmp.t b/lib/Math/BigInt/t/nan_cmp.t
new file mode 100644
index 0000000000..ffe7b14b23
--- /dev/null
+++ b/lib/Math/BigInt/t/nan_cmp.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+
+# test that overloaded compare works when NaN are involved
+
+use strict;
+use Test::More;
+
+BEGIN
+  {
+  $| = 1;
+  chdir 't' if -d 't';
+  unshift @INC, '../lib';	# for running manually
+  plan tests => 26;
+  }
+
+use Math::BigInt;
+use Math::BigFloat;
+
+compare (Math::BigInt->bnan(),   Math::BigInt->bone() );
+compare (Math::BigFloat->bnan(), Math::BigFloat->bone() );
+
+sub compare
+  {
+  my ($nan, $one) = @_;
+
+  is ($one, $one, '1 == 1');
+
+  is ($one != $nan, 1, "1 != NaN");
+  is ($nan != $one, 1, "NaN != 1");
+  is ($nan != $nan, 1, "NaN != NaN");
+
+  is ($nan == $one, '', "NaN == 1");
+  is ($one == $nan, '', "1 == NaN");
+  is ($nan == $nan, '', "NaN == NaN");
+
+  is ($nan <= $one, '', "NaN <= 1");
+  is ($one <= $nan, '', "1 <= NaN");
+  is ($nan <= $nan, '', "NaN <= NaN");
+
+  is ($nan >= $one, '', "NaN >= 1");
+  is ($one >= $nan, '', "1 >= NaN");
+  is ($nan >= $nan, '', "NaN >= NaN");
+  }
+
diff --git a/lib/Math/BigInt/t/new_ovld.t b/lib/Math/BigInt/t/new_ovld.t
new file mode 100644
index 0000000000..08708dc557
--- /dev/null
+++ b/lib/Math/BigInt/t/new_ovld.t
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -w
+
+# Math::BigFloat->new had a bug where it would assume any object is a
+# BigInt which broke overloaded non-BigInts.
+
+use Test::More tests => 4;
+
+
+package Overloaded::Num;
+
+use overload '0+' => sub { ${$_[0]} },
+             fallback => 1;
+sub new {
+    my($class, $num) = @_;
+    return bless \$num, $class;
+}
+
+
+package main;
+
+use Math::BigFloat;
+
+my $overloaded_num = Overloaded::Num->new(2.23);
+is $overloaded_num, 2.23;
+
+my $bigfloat = Math::BigFloat->new($overloaded_num);
+is $bigfloat, 2.23, 'BigFloat->new accepts overloaded numbers';
+
+my $bigint = Math::BigInt->new(Overloaded::Num->new(3));
+is $bigint, 3, 'BigInt->new accepts overloaded numbers';
+
+is( Math::BigFloat->new($bigint), 3, 'BigFloat from BigInt' );
diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc
index a2ae38cf75..3aa42efff9 100644
--- a/lib/Math/BigInt/t/upgrade.inc
+++ b/lib/Math/BigInt/t/upgrade.inc
@@ -114,7 +114,7 @@ while (<DATA>)
       }
     if ($f eq "bcmp")
       {
-      $try .= '$x <=> $y;';
+      $try .= '$x->bcmp($y);';
       } elsif ($f eq "bround") {
       $try .= "$round_mode; \$x->bround(\$y);";
       } elsif ($f eq "broot") {