From: Tels Date: Sun, 4 Mar 2007 15:57:01 +0000 (+0000) Subject: Math::BigInt 1.80 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0ac753de46adf91a344ab968b1f6fadab2f6dff;p=p5sagit%2Fp5-mst-13.2.git Math::BigInt 1.80 Message-Id: <200703041557.02996@bloodgate.com> p4raw-id: //depot/perl@30460 --- diff --git a/MANIFEST b/MANIFEST index ae6cedc..4961f5f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1955,6 +1955,8 @@ lib/Math/BigInt/t/mbi_ali.t Tests for BigInt lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fallback, round_mode tests lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precision and fallback, round_mode lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly +lib/Math/BigInt/t/nan_cmp.t overloaded comparision involving NaN +lib/Math/BigInt/t/new_ovld.t test overloaded numbers in BigFloat's new() lib/Math/BigInt/Trace.pm bignum tracing lib/Math/BigInt/t/req_mbf0.t test: require Math::BigFloat; ->bzero(); lib/Math/BigInt/t/req_mbf1.t test: require Math::BigFloat; ->bone(); diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index f157811..f569036 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 ac351db..600970f 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 77ce4de..6fb21b0 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 f56b51a..79efac6 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 2a45c82..45f48ac 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -110,7 +110,7 @@ while () $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 87c9527..65f791d 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 07efc28..c62d73e 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -94,7 +94,7 @@ while () $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 cba2643..0958ddc 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 51fea64..a5ea3f6 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 0000000..ffe7b14 --- /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 0000000..08708dc --- /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 a2ae38c..3aa42ef 100644 --- a/lib/Math/BigInt/t/upgrade.inc +++ b/lib/Math/BigInt/t/upgrade.inc @@ -114,7 +114,7 @@ while () } 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") {