From: Jarkko Hietaniemi Date: Thu, 21 Feb 2002 20:02:27 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.51. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b3abae2aec672e5343915a64fe25c941cfd52764;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.51. p4raw-id: //depot/perl@14817 --- diff --git a/MANIFEST b/MANIFEST index e5ff86f..7341699 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1134,19 +1134,25 @@ lib/look.pl A "look" equivalent lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt -lib/Math/BigInt/t/bare_mbi.t Test Math::BigInt::CareCalc +lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc +lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works lib/Math/BigInt/t/bigintpm.inc Shared tests for bigintpm.t and sub_mbi.t lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works lib/Math/BigInt/t/calling.t Test calling conventions +lib/Math/BigInt/t/config.t Test Math::BigInt->config() +lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant +lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precicion and fallback, round_mode tests lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode lib/Math/BigInt/t/require.t Test if require Math::BigInt works lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc +lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t +lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works lib/Math/Complex.pm A Complex package lib/Math/Complex.t See if Math::Complex works diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 92e53b3..2b7faae 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -1,5 +1,3 @@ -#!/usr/bin/perl -w - # The following hash values are internally used: # _e: exponent (BigInt) # _m: mantissa (absolute BigInt) @@ -10,7 +8,7 @@ package Math::BigFloat; -$VERSION = '1.27'; +$VERSION = '1.28'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -18,6 +16,7 @@ use Math::BigInt qw/objectify/; use strict; use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/; +use vars qw/$upgrade $downgrade/; my $class = "Math::BigFloat"; use overload @@ -25,6 +24,7 @@ use overload ref($_[0])->bcmp($_[1],$_[0]) : ref($_[0])->bcmp($_[0],$_[1])}, 'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint +'log' => sub { $_[0]->blog() }, ; ############################################################################## @@ -43,6 +43,9 @@ $accuracy = undef; $precision = undef; $div_scale = 40; +$upgrade = undef; +$downgrade = undef; + ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -62,7 +65,7 @@ BEGIN { tie $rnd_mode, 'Math::BigFloat'; } # valid method aliases for AUTOLOAD my %methods = map { $_ => 1 } qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm - fint facmp fcmp fzero fnan finf finc fdec flog + fint facmp fcmp fzero fnan finf finc fdec flog ffac fceil ffloor frsft flsft fone flog /; # valid method's that can be hand-ed up (for AUTOLOAD) @@ -86,7 +89,7 @@ sub new # sign => sign (+/-), or "NaN" my ($class,$wanted,@r) = @_; - + # avoid numify-calls by not using || on $wanted! return $class->bzero() if !defined $wanted; # default to 0 return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat'); @@ -130,7 +133,7 @@ sub new $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0; $self->{sign} = $$mis; } - # print "mbf new ",join(' ',@r),"\n"; + # print "mbf new $self->{sign} $self->{_m} e $self->{_e}\n"; $self->bnorm()->round(@r); # first normalize, then round } @@ -337,7 +340,7 @@ sub bcmp return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; - return +1 if $y->{sign} eq '-inf'; + return +1; } # check sign for speed first @@ -356,9 +359,7 @@ sub bcmp my $lym = $y->{_m}->length(); my $lx = $lxm + $x->{_e}; my $ly = $lym + $y->{_e}; - # print "x $x y $y lx $lx ly $ly\n"; - my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-'; - # print "$l $x->{sign}\n"; + my $l = $lx - $ly; $l->bneg() if $x->{sign} eq '-'; return $l <=> 0 if $l != 0; # lengths (corrected by exponent) are equal @@ -376,7 +377,7 @@ sub bcmp } my $rc = $xm->bcmp($ym); $rc = -$rc if $x->{sign} eq '-'; # -124 < -123 - return $rc <=> 0; + $rc <=> 0; } sub bacmp @@ -392,7 +393,7 @@ sub bacmp return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if ($x->is_inf() && $y->is_inf()); return 1 if ($x->is_inf() && !$y->is_inf()); - return -1 if (!$x->is_inf() && $y->is_inf()); + return -1; } # shortcut @@ -407,9 +408,7 @@ sub bacmp my $lym = $y->{_m}->length(); my $lx = $lxm + $x->{_e}; my $ly = $lym + $y->{_e}; - # print "x $x y $y lx $lx ly $ly\n"; my $l = $lx - $ly; - # print "$l $x->{sign}\n"; return $l <=> 0 if $l != 0; # lengths (corrected by exponent) are equal @@ -425,8 +424,7 @@ sub bacmp { $xm = $x->{_m}->copy()->blsft(-$diff,10); } - my $rc = $xm->bcmp($ym); - return $rc <=> 0; + $xm->bcmp($ym) <=> 0; } sub badd @@ -435,6 +433,7 @@ sub badd # return result as BFLOAT my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + #print "mbf badd $x $y\n"; # inf and NaN handling if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { @@ -571,7 +570,7 @@ sub bdec sub blog { - my ($self,$x,$base,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_); + my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_); # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log @@ -579,38 +578,88 @@ sub blog # _ _ # taylor: | u 1 u^3 1 u^5 | # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0 - # |_ v 3 v 5 v _| + # |_ v 3 v^3 5 v^5 _| - return $x->bzero(@r) if $x->is_one(); - return $x->bone(@r) if $x->bcmp($base) == 0; + # we need to limit the accuracy to protect against overflow + my $fallback = 0; + my $scale = 0; + my @params = $x->_find_round_parameters($a,$p,$r); - my $d = $r[0] || $self->accuracy() || 40; - $d += 2; # 2 more for rounding - - my $u = $x->copy(); $u->bdec(); - my $v = $x->copy(); $v->binc(); + # no rounding at all, so must use fallback + if (scalar @params == 1) + { + # simulate old behaviour + $params[1] = $self->div_scale(); # and round to it as accuracy + $scale = $params[1]+4; # at least four more for proper round + $params[3] = $r; # round mode by caller or undef + $fallback = 1; # to clear a/p afterwards + } + else + { + # the 4 below is empirical, and there might be cases where it is not + # enough... + $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined + } - $x->bdec()->bdiv($v,$d); # first term: u/v + return $x->bzero(@params) if $x->is_one(); + return $x->bnan() if $x->{sign} ne '+' || $x->is_zero(); + #return $x->bone('+',@params) if $x->bcmp($base) == 0; - $u *= $u; $v *= $v; - my $below = $v->copy()->bmul($v); - my $over = $u->copy()->bmul($u); + # when user set globals, they would interfere with our calculation, so + # disable then and later re-enable them + no strict 'refs'; + my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; + my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; + # we also need to disable any set A or P on $x (_find_round_parameters took + # them already into account), since these would interfere, too + delete $x->{_a}; delete $x->{_p}; + # need to disable $upgrade in BigInt, to aoid deep recursion + local $Math::BigInt::upgrade = undef; + + my $v = $x->copy(); $v->binc(); # v = x+1 + $x->bdec(); my $u = $x->copy(); # u = x-1; x = x-1 + + $x->bdiv($v,$scale); # first term: u/v + + my $below = $v->copy(); + my $over = $u->copy(); + $u *= $u; $v *= $v; # u^2, v^2 + $below->bmul($v); # u^3, v^3 + $over->bmul($u); my $factor = $self->new(3); my $two = $self->new(2); my $diff = $self->bone(); - my $limit = $self->new("1E-". ($d-1)); my $last; + my $limit = $self->new("1E-". ($scale-1)); my $last; # print "diff $diff limit $limit\n"; - while ($diff > $limit) + while ($diff->bcmp($limit) > 0) { - print "$x $over $below $factor\n"; + #print "$x $over $below $factor\n"; $diff = $x->copy()->bsub($last)->babs(); - print "diff $diff $limit\n"; + #print "diff $diff $limit\n"; $last = $x->copy(); - $x += $over->copy()->bdiv($below->copy()->bmul($factor),$d); + $x += $over->copy()->bdiv($below->copy()->bmul($factor),$scale); $over *= $u; $below *= $v; $factor->badd($two); } $x->bmul($two); - return $x->round(@r); + + # shortcut to not run trough _find_round_parameters again + if (defined $params[1]) + { + $x->bround($params[1],$params[3]); # then round accordingly + } + else + { + $x->bfround($params[2],$params[3]); # then round accordingly + } + if ($fallback) + { + # clear a/p after round, since user did not request it + $x->{_a} = undef; $x->{_p} = undef; + } + # restore globals + $$abr = $ab; $$pbr = $pb; + + $x; } sub blcm @@ -637,25 +686,37 @@ sub bgcd $x; } +############################################################################### +# is_foo methods (is_negative, is_positive are inherited from BigInt) + +sub is_int + { + # return true if arg (BFLOAT or num_str) is an integer + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't + $x->{_e}->{sign} eq '+'; # 1e-1 => no integer + 0; + } + sub is_zero { - # return true if arg (BFLOAT or num_str) is zero (array '+', '0') + # return true if arg (BFLOAT or num_str) is zero my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero(); - return 0; + 0; } sub is_one { - # return true if arg (BFLOAT or num_str) is +1 (array '+', '1') - # or -1 if signis given + # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); my $sign = shift || ''; $sign = '+' if $sign ne '-'; return 1 if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one()); - return 0; + 0; } sub is_odd @@ -663,9 +724,9 @@ sub is_odd # return true if arg (BFLOAT or num_str) is odd or false if even my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_odd()); - return 0; + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't + ($x->{_e}->is_zero() && $x->{_m}->is_odd()); + 0; } sub is_even @@ -674,9 +735,10 @@ sub is_even my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - return 1 if $x->{_m}->is_zero(); # 0e1 is even - return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never - return 0; +# return 1 if $x->{_m}->is_zero(); # 0e1 is even + return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never + && $x->{_m}->is_even()); # but 1200 is + 0; } sub bmul @@ -757,6 +819,13 @@ sub bdiv $scale = $ly if $ly > $scale; my $diff = $ly - $lx; $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx! + + # make copy of $x in case of list context for later reminder calculation + my $rem; + if (wantarray && !$y->is_one()) + { + $rem = $x->copy(); + } $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; @@ -792,11 +861,9 @@ sub bdiv if (wantarray) { - my $rem; if (!$y->is_one()) { - $rem = $x->copy(); - $rem->bmod($y,$params[1],$params[2],$params[3]); + $rem->bmod($y,$params[1],$params[2],$params[3]); # copy already done } else { @@ -852,7 +919,7 @@ sub bmod $x->blsft($shifty,10); # 123 => 1230, $y->{_m} is already 25 } # $ym is now mantissa of $y based on exponent 0 - + my $shiftx = 0; # correct _e of $x by this if ($x->{_e}->{sign} eq '-') # has digits after dot { @@ -871,6 +938,8 @@ sub bmod $x->{_e}->bsub($shifty) if $shifty != 0; # now mantissas are equalized, exponent of $x is adjusted, so calc result +# $ym->{sign} = '-' if $neg; # bmod() will make the correction for us + $x->{_m}->bmod($ym); $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0 @@ -923,16 +992,19 @@ sub bsqrt # disable then and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; - $abr = "$self\::precision"; my $pb = $$abr; $$abr = undef; + my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; + # need to disable $upgrade in BigInt, to aoid deep recursion + local $Math::BigInt::upgrade = undef; my $xas = $x->as_number(); my $gs = $xas->copy()->bsqrt(); # some guess + if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are # digits after the dot - && ($xas->bcmp($gs * $gs) == 0)) # guess hit the nail on the head? + && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head? { # exact result $x->{_m} = $gs; $x->{_e} = Math::BigInt->bzero(); $x->bnorm(); @@ -950,6 +1022,7 @@ sub bsqrt # clear a/p after round, since user did not request it $x->{_a} = undef; $x->{_p} = undef; } + ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb; return $x; } $gs = $self->new( $gs ); # BigInt to BigFloat @@ -957,7 +1030,7 @@ sub bsqrt my $lx = $x->{_m}->length(); $scale = $lx if $scale < $lx; my $e = $self->new("1E-$scale"); # make test variable - return $x->bnan() if $e->sign() eq 'NaN'; +# return $x->bnan() if $e->sign() eq 'NaN'; my $y = $x->copy(); my $two = $self->new(2); @@ -966,17 +1039,12 @@ sub bsqrt $y = $self->new($y) unless $y->isa('Math::BigFloat'); my $rem; -# my $steps = 0; while ($diff >= $e) { -# return $x->bnan() if $gs->is_zero(); - $rem = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale); $diff = $rem->copy()->bsub($gs)->babs(); $gs = $rem->copy(); -# $steps++; } -# print "steps $steps\n"; # copy over to modify $x $x->{_m} = $rem->{_m}; $x->{_e} = $rem->{_e}; @@ -995,10 +1063,39 @@ sub bsqrt $x->{_a} = undef; $x->{_p} = undef; } # restore globals - ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb; + $$abr = $ab; $$pbr = $pb; $x; } +sub bfac + { + # (BINT or num_str, BINT or num_str) return BINT + # compute factorial numbers + # modifies first argument + my ($self,$x,@r) = objectify(1,@_); + + return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN + return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 + + return $x->bnan() if $x->{_e}->{sign} ne '+'; # digits after dot? + + # use BigInt's bfac() for faster calc + $x->{_m}->blsft($x->{_e},10); # un-norm m + $x->{_e}->bzero(); # norm $x again + $x->{_m}->bfac(); # factorial + $x->bnorm(); + + #my $n = $x->copy(); + #$x->bone(); + #my $f = $self->new(2); + #while ($f->bacmp($n) < 0) + # { + # $x->bmul($f); $f->binc(); + # } + #$x->bmul($f); # last step + $x->round(@r); # round + } + sub bpow { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT @@ -1093,7 +1190,7 @@ sub bfround return $x->bzero() if $scale < $zad; if ($scale == $zad) # for 0.006, scale -3 and trunc { - $scale = -$len-1; + $scale = -$len; } else { @@ -1114,29 +1211,31 @@ sub bfround { # 123 => 100 means length(123) = 3 - $scale (2) => 1 - # calculate digits before dot - my $dbt = $x->{_m}->length(); $dbt += $x->{_e} if $x->{_e}->sign() eq '-'; - # if not enough digits before dot, round to zero - return $x->bzero() if ($scale > $dbt) && ($dbt < 0); - # scale always >= 0 here - if ($dbt == 0) - { - # 0.49->bfround(1): scale == 1, dbt == 0: => 0.0 - # 0.51->bfround(0): scale == 0, dbt == 0: => 1.0 - # 0.5->bfround(0): scale == 0, dbt == 0: => 0 - # 0.05->bfround(0): scale == 0, dbt == 0: => 0 - # print "$scale $dbt $x->{_m}\n"; - $scale = -$x->{_m}->length(); - } - elsif ($dbt > 0) - { - # correct by subtracting scale - $scale = $dbt - $scale; - } + my $dbt = $x->{_m}->length(); + # digits before dot + my $dbd = $dbt + $x->{_e}; + # should be the same, so treat it as this + $scale = 1 if $scale == 0; + # shortcut if already integer + return $x if $scale == 1 && $dbt <= $dbd; + # maximum digits before dot + ++$dbd; + + if ($scale > $dbd) + { + # not enough digits before dot, so round to zero + return $x->bzero; + } + elsif ( $scale == $dbd ) + { + # maximum + $scale = -$dbt; + } else - { - $scale = $x->{_m}->length() - $scale; - } + { + $scale = $dbd - $scale; + } + } # print "using $scale for $x->{_m} with '$mode'\n"; # pass sign to bround for rounding modes '+inf' and '-inf' @@ -1257,12 +1356,11 @@ sub DESTROY sub AUTOLOAD { - # make fxxx and bxxx work - # my $self = $_[0]; + # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx() + # or falling back to MBI::bxxx() my $name = $AUTOLOAD; $name =~ s/.*:://; # split package - #print "$name\n"; no strict 'refs'; if (!method_alias($name)) { @@ -1283,7 +1381,7 @@ sub AUTOLOAD return &{'Math::BigInt'."::$name"}(@_); } my $bname = $name; $bname =~ s/^f/b/; - *{$class."\:\:$name"} = \&$bname; + *{$class."::$name"} = \&$bname; &$bname; # uses @_ } @@ -1337,20 +1435,28 @@ sub parts sub import { my $self = shift; - for ( my $i = 0; $i < @_ ; $i++ ) + my $l = scalar @_; my $j = 0; my @a = @_; + for ( my $i = 0; $i < $l ; $i++, $j++) { if ( $_[$i] eq ':constant' ) { # this rest causes overlord er load to step in # print "overload @_\n"; overload::constant float => sub { $self->new(shift); }; - splice @_, $i, 1; last; + splice @a, $j, 1; $j--; + } + elsif ($_[$i] eq 'upgrade') + { + # this causes upgrading + $upgrade = $_[$i+1]; # or undef to disable + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; } } # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance - $self->SUPER::import(@_); # for subclasses - $self->export_to_level(1,$self,@_); # need this, too + $self->SUPER::import(@a); # for subclasses + $self->export_to_level(1,$self,@a); # need this, too } sub bnorm @@ -1434,30 +1540,41 @@ Math::BigFloat - Arbitrary size floating point math package use Math::BigFloat; - # Number creation - $x = Math::BigInt->new($str); # defaults to 0 - $nan = Math::BigInt->bnan(); # create a NotANumber - $zero = Math::BigInt->bzero();# create a "+0" + # Number creation + $x = Math::BigFloat->new($str); # defaults to 0 + $nan = Math::BigFloat->bnan(); # create a NotANumber + $zero = Math::BigFloat->bzero(); # create a +0 + $inf = Math::BigFloat->binf(); # create a +inf + $inf = Math::BigFloat->binf('-'); # create a -inf + $one = Math::BigFloat->bone(); # create a +1 + $one = Math::BigFloat->bone('-'); # create a -1 # Testing - $x->is_zero(); # return whether arg is zero or not - $x->is_nan(); # return whether arg is NaN or not + $x->is_zero(); # true if arg is +0 + $x->is_nan(); # true if arg is NaN $x->is_one(); # true if arg is +1 $x->is_one('-'); # true if arg is -1 $x->is_odd(); # true if odd, false for even $x->is_even(); # true if even, false for odd $x->is_positive(); # true if >= 0 $x->is_negative(); # true if < 0 - $x->is_inf(sign) # true if +inf or -inf (sign default '+') + $x->is_inf(sign); # true if +inf, or -inf (default is '+') + $x->bcmp($y); # compare numbers (undef,<0,=0,>0) $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) $x->sign(); # return the sign, either +,- or NaN + $x->digit($n); # return the nth digit, counting from right + $x->digit(-$n); # return the nth digit, counting from left # The following all modify their first argument: - + # set $x->bzero(); # set $i to 0 $x->bnan(); # set $i to NaN + $x->bone(); # set $x to +1 + $x->bone('-'); # set $x to -1 + $x->binf(); # set $x to inf + $x->binf('-'); # set $x to -inf $x->bneg(); # negation $x->babs(); # absolute value @@ -1485,18 +1602,23 @@ Math::BigFloat - Arbitrary size floating point math package $x->bior($y); # bit-wise inclusive or $x->bxor($y); # bit-wise exclusive or $x->bnot(); # bit-wise not (two's complement) - + + $x->bsqrt(); # calculate square-root + $x->bfac(); # factorial of $x (1*2*3*4*..$x) + $x->bround($N); # accuracy: preserver $N digits $x->bfround($N); # precision: round to the $Nth digit # The following do not modify their arguments: - bgcd(@values); # greatest common divisor blcm(@values); # lowest common multiplicator $x->bstr(); # return string $x->bsstr(); # return string in scientific notation - + + $x->bfloor(); # return integer less or equal than $x + $x->bceil(); # return integer greater or equal than $x + $x->exponent(); # return exponent as BigInt $x->mantissa(); # return mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 516406b..c36014a 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -1,5 +1,3 @@ -#!/usr/bin/perl -w - # The following hash values are used: # value: unsigned int with actual value (as a Math::BigInt::Calc or similiar) # sign : +,-,NaN,+inf,-inf @@ -14,11 +12,12 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.49'; +$VERSION = '1.51'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify _swap bgcd blcm); use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/; +use vars qw/$upgrade $downgrade/; use strict; # Inside overload, the first arg is always an object. If the original code had @@ -57,6 +56,7 @@ use overload '|=' => sub { $_[0]->bior($_[1]); }, '**=' => sub { $_[0]->bpow($_[1]); }, +# not supported by Perl yet '..' => \&_pointpoint, '<=>' => sub { $_[2] ? @@ -64,13 +64,14 @@ use overload ref($_[0])->bcmp($_[0],$_[1])}, 'cmp' => sub { $_[2] ? - $_[1] cmp $_[0]->bstr() : - $_[0]->bstr() cmp $_[1] }, + "$_[1]" cmp $_[0]->bstr() : + $_[0]->bstr() cmp "$_[1]" }, 'log' => sub { $_[0]->copy()->blog(); }, 'int' => sub { $_[0]->copy(); }, 'neg' => sub { $_[0]->copy()->bneg(); }, 'abs' => sub { $_[0]->copy()->babs(); }, +'sqrt' => sub { $_[0]->copy()->bsqrt(); }, '~' => sub { $_[0]->copy()->bnot(); }, '*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); }, @@ -95,7 +96,7 @@ use overload # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-( my $t = !$_[0]->is_zero(); undef $t if $t == 0; - return $t; + $t; }, # the original qw() does not work with the TIESCALAR below, why? @@ -114,13 +115,15 @@ my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do low level math my $IMPORT = 0; # did import() yet? -sub _core_lib () { return $CALC; } # for test suite $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' $accuracy = undef; $precision = undef; $div_scale = 40; +$upgrade = undef; # default is no upgrade +$downgrade = undef; # default is no downgrade + ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -144,11 +147,25 @@ sub round_mode my $m = shift; die "Unknown round mode $m" if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/; - ${"${class}::round_mode"} = $m; return $m; + return ${"${class}::round_mode"} = $m; } return ${"${class}::round_mode"}; } +sub upgrade + { + no strict 'refs'; + # make Class->round_mode() work + my $self = shift; + my $class = ref($self) || $self || __PACKAGE__; + if (defined $_[0]) + { + my $u = shift; + return ${"${class}::upgrade"} = $u; + } + return ${"${class}::upgrade"}; + } + sub div_scale { no strict 'refs'; @@ -190,6 +207,7 @@ sub accuracy { # set global ${"${class}::accuracy"} = $a; + ${"${class}::precision"} = undef; # clear P } return $a; # shortcut } @@ -222,12 +240,13 @@ sub precision # $object->precision() or fallback to global $x->bfround($p) if defined $p; $x->{_p} = $p; # set/overwrite, even if not rounded - $x->{_a} = undef; # clear P + $x->{_a} = undef; # clear A } else { # set global ${"${class}::precision"} = $p; + ${"${class}::accuracy"} = undef; # clear A } return $p; # shortcut } @@ -240,6 +259,26 @@ sub precision return ${"${class}::precision"}; } +sub config + { + # return (later set?) configuration data as hash ref + my $class = shift || 'Math::BigInt'; + + no strict 'refs'; + my $lib = $CALC; + my $cfg = { + lib => $lib, + lib_version => ${"${lib}::VERSION"}, + class => $class, + }; + foreach ( + qw/upgrade downgrade precisison accuracy round_mode VERSION div_scale/) + { + $cfg->{lc($_)} = ${"${class}::$_"}; + }; + $cfg; + } + sub _scale_a { # select accuracy parameter based on precedence, @@ -376,6 +415,7 @@ sub new if ($diff < 0) # Not integer { #print "NOI 1\n"; + return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade; $self->{sign} = $nan; } else # diff >= 0 @@ -391,6 +431,7 @@ sub new { # fraction and negative/zero E => NOI #print "NOI 2 \$\$mfv '$$mfv'\n"; + return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade; $self->{sign} = $nan; } elsif ($e < 0) @@ -401,6 +442,7 @@ sub new if ($$miv !~ s/0{$e}$//) # can strip so many zero's? { #print "NOI 3\n"; + return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade; $self->{sign} = $nan; } } @@ -411,6 +453,7 @@ sub new # do not round for new($x,undef,undef) since that is used by MBF to signal # no rounding $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p; + # print "mbi new $self\n"; return $self; } @@ -683,7 +726,7 @@ sub bnorm # (numstr or BINT) return BINT # Normalize number -- no-op here my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return $x; + $x; } sub babs @@ -705,9 +748,9 @@ sub bneg my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x if $x->modify('bneg'); + # for +0 dont negate (to have always normalized) - return $x if $x->is_zero(); - $x->{sign} =~ tr/+-/-+/; # does nothing for NaN + $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN $x; } @@ -725,7 +768,7 @@ sub bcmp return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; - return +1 if $y->{sign} eq '-inf'; + return +1; } # check sign for speed first return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y @@ -747,9 +790,7 @@ sub bcmp # $x->{sign} eq '-' return -1 if $y->{sign} eq '+'; - return $CALC->_acmp($y->{value},$x->{value}); # swaped - - # &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0; + $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1) } sub bacmp @@ -766,7 +807,7 @@ sub bacmp return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; return +1; # inf is always bigger } - $CALC->_acmp($x->{value},$y->{value}) <=> 0; + $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1 } sub badd @@ -776,6 +817,12 @@ sub badd my ($self,$x,$y,@r) = objectify(2,@_); return $x if $x->modify('badd'); +# print "mbi badd ",join(' ',caller()),"\n"; +# print "upgrade => ",$upgrade||'undef', +# " \$x (",ref($x),") \$y (",ref($y),")\n"; +# return $upgrade->badd($x,$y,@r) if defined $upgrade && +# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade)); +# print "still badd\n"; $r[3] = $y; # no push! # inf and NaN handling @@ -786,9 +833,9 @@ sub badd # inf handline if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { - # + and + => +, - and - => -, + and - => 0, - and + => 0 - return $x->bzero(@r) if $x->{sign} ne $y->{sign}; - return $x; + # +inf++inf or -inf+-inf => same, rest is NaN + return $x if $x->{sign} eq $y->{sign}; + return $x->bnan(); } # +-inf + something => +inf # something +-inf => +-inf @@ -796,16 +843,6 @@ sub badd return $x; } - # speed: no add for 0+y or x+0 - return $x->round(@r) if $y->is_zero(); # x+0 - if ($x->is_zero()) # 0+y - { - # make copy, clobbering up x - $x->{value} = $CALC->_copy($y->{value}); - $x->{sign} = $y->{sign} || $nan; - return $x->round(@r); - } - my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs if ($sx eq $sy) @@ -843,16 +880,20 @@ sub bsub { # (BINT or num_str, BINT or num_str) return num_str # subtract second arg from first, modify first - my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + my ($self,$x,$y,@r) = objectify(2,@_); return $x if $x->modify('bsub'); - - if (!$y->is_zero()) # don't need to do anything if $y is 0 - { - $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN - $x->badd($y,$a,$p,$r); # badd does not leave internal zeros - $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) +# return $upgrade->badd($x,$y,@r) if defined $upgrade && +# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade)); + + if ($y->is_zero()) + { + return $x->round(@r); } + + $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN + $x->badd($y,@r); # badd does not leave internal zeros + $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) $x; # already rounded by badd() or no round necc. } @@ -905,8 +946,10 @@ sub bdec sub blog { # not implemented yet - my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade; + return $x->bnan(); } @@ -971,6 +1014,8 @@ sub bnot $x->bneg()->bdec(); # bdec already does round } +# is_foo test routines + sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') @@ -1061,6 +1106,16 @@ sub is_negative 0; } +sub is_int + { + # return true when arg (BINT or num_str) is an integer + # always true for BigInt, but different for Floats + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't + } + ############################################################################### sub bmul @@ -1074,12 +1129,11 @@ sub bmul $r[3] = $y; # no push here return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - # handle result = 0 - return $x->round(@r) if $x->is_zero(); - return $x->bzero()->round(@r) if $y->is_zero(); + # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { + return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf @@ -1090,8 +1144,9 @@ sub bmul $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + - $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math - return $x->round(@r); + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math + $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 + $x->round(@r); } sub _div_inf @@ -1104,17 +1159,10 @@ sub _div_inf if (($x->is_nan() || $y->is_nan()) || ($x->is_zero() && $y->is_zero())); - # +inf / +inf == -inf / -inf == 1, remainder is 0 (A / A = 1, remainder 0) - if (($x->{sign} eq $y->{sign}) && - ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) - { - return wantarray ? ($x->bone(),$self->bzero()) : $x->bone(); - } - # +inf / -inf == -inf / +inf == -1, remainder 0 - if (($x->{sign} ne $y->{sign}) && - ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + # +-inf / +-inf == NaN, reminder also NaN + if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { - return wantarray ? ($x->bone('-'),$self->bzero()) : $x->bone('-'); + return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan(); } # x / +-inf => 0, remainder x (works even if x == 0) if ($y->{sign} =~ /^[+-]inf$/) @@ -1163,10 +1211,12 @@ sub bdiv return wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero(); - # Is $x in the interval [0, $y) ? + # Is $x in the interval [0, $y) (aka $x <= $y) ? my $cmp = $CALC->_acmp($x->{value},$y->{value}); - if (($cmp < 0) and ($x->{sign} eq $y->{sign})) + if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray)) { + return $upgrade->bdiv($x,$y,@r) if defined $upgrade; + return $x->bzero()->round(@r) unless wantarray; my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x return ($x->bzero()->round(@r),$t); @@ -1232,9 +1282,9 @@ sub bmod { # calc new sign and in case $y == +/- 1, return $x $x->{value} = $CALC->_mod($x->{value},$y->{value}); - my $xsign = $x->{sign}; if (!$CALC->_is_zero($x->{value})) { + my $xsign = $x->{sign}; $x->{sign} = $y->{sign}; $x = $y-$x if $xsign ne $y->{sign}; # one of them '-' } @@ -1244,9 +1294,44 @@ sub bmod } return $x->round(@r); } - $x = (&bdiv($self,$x,$y,@r))[1]; # slow way (also rounds) + my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds) + # modify in place + foreach (qw/value sign _a _p/) + { + $x->{$_} = $rem->{$_}; + } + $x; } +sub bfac + { + # (BINT or num_str, BINT or num_str) return BINT + # compute factorial numbers + # modifies first argument + my ($self,$x,@r) = objectify(1,@_); + + return $x if $x->modify('bfac'); + + return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN + return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 + + if ($CALC->can('_fac')) + { + $x->{value} = $CALC->_fac($x->{value}); + return $x->round(@r); + } + + my $n = $x->copy(); + $x->bone(); + my $f = $self->new(2); + while ($f->bacmp($n) < 0) + { + $x->bmul($f); $f->binc(); + } + $x->bmul($f); # last step + $x->round(@r); # round + } + sub bpow { # (BINT or num_str, BINT or num_str) return BINT @@ -1312,40 +1397,81 @@ sub blsft { # (BINT or num_str, BINT or num_str) return BINT # compute x << y, base n, y >= 0 - my ($self,$x,$y,$n) = objectify(2,@_); + my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); return $x if $x->modify('blsft'); return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + return $x->round($a,$p,$r) if $y->is_zero(); $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); if (defined $t) { - $x->{value} = $t; return $x; + $x->{value} = $t; return $x->round($a,$p,$r); } # fallback - return $x->bmul( $self->bpow($n, $y) ); + return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r ); } sub brsft { # (BINT or num_str, BINT or num_str) return BINT # compute x >> y, base n, y >= 0 - my ($self,$x,$y,$n) = objectify(2,@_); + my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); return $x if $x->modify('brsft'); return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); + return $x->round($a,$p,$r) if $y->is_zero(); + return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; + # this only works for negative numbers when shifting in base 2 + if (($x->{sign} eq '-') && ($n == 2)) + { + return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1 + if (!$y->is_one()) + { + # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al + # but perhaps there is a better emulation for two's complement shift... + # if $y != 1, we must simulate it by doing: + # convert to bin, flip all bits, shift, and be done + $x->binc(); # -3 => -2 + my $bin = $x->as_bin(); + $bin =~ s/^-0b//; # strip '-0b' prefix + $bin =~ tr/10/01/; # flip bits + # now shift + if (length($bin) <= $y) + { + $bin = '0'; # shifting to far right creates -1 + # 0, because later increment makes + # that 1, attached '-' makes it '-1' + # because -1 >> x == -1 ! + } + else + { + $bin =~ s/.{$y}$//; # cut off at the right side + $bin = '1' . $bin; # extend left side by one dummy '1' + $bin =~ tr/10/01/; # flip bits back + } + my $res = $self->new('0b'.$bin); # add prefix and convert back + $res->binc(); # remember to increment + $x->{value} = $res->{value}; # take over value + return $x->round($a,$p,$r); # we are done now, magic, isn't? + } + $x->bdec(); # n == 2, but $y == 1: this fixes it + } + my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); if (defined $t) { - $x->{value} = $t; return $x; + $x->{value} = $t; + return $x->round($a,$p,$r); } # fallback - return scalar bdiv($x, $self->bpow($n, $y)); + $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r); + $x; } sub band @@ -1356,6 +1482,8 @@ sub band return $x if $x->modify('band'); + local $Math::BigInt::upgrade = undef; + return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x->bzero() if $y->is_zero() || $x->is_zero(); @@ -1370,8 +1498,8 @@ sub band return $x->round($a,$p,$r); } - my $m = Math::BigInt->bone(); my ($xr,$yr); - my $x10000 = new Math::BigInt (0x1000); + my $m = $self->bone(); my ($xr,$yr); + my $x10000 = $self->new (0x1000); my $y1 = copy(ref($x),$y); # make copy $y1->babs(); # and positive my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! @@ -1398,6 +1526,8 @@ sub bior return $x if $x->modify('bior'); + local $Math::BigInt::upgrade = undef; + return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x if $y->is_zero(); @@ -1413,8 +1543,8 @@ sub bior return $x->round($a,$p,$r); } - my $m = Math::BigInt->bone(); my ($xr,$yr); - my $x10000 = Math::BigInt->new(0x10000); + my $m = $self->bone(); my ($xr,$yr); + my $x10000 = $self->new(0x10000); my $y1 = copy(ref($x),$y); # make copy $y1->babs(); # and positive my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! @@ -1441,6 +1571,8 @@ sub bxor return $x if $x->modify('bxor'); + local $Math::BigInt::upgrade = undef; + return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x if $y->is_zero(); @@ -1457,7 +1589,7 @@ sub bxor } my $m = $self->bone(); my ($xr,$yr); - my $x10000 = Math::BigInt->new(0x10000); + my $x10000 = $self->new(0x10000); my $y1 = copy(ref($x),$y); # make copy $y1->babs(); # and positive my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! @@ -1513,10 +1645,13 @@ sub bsqrt { my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x if $x->modify('bsqrt'); + return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0 return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1 - return $x->bone($a,$p) if $x < 4; # 2,3 => 1 + + return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade; if ($CALC->can('_sqrt')) { @@ -1524,6 +1659,7 @@ sub bsqrt return $x->round($a,$p,$r); } + return $x->bone($a,$p) if $x < 4; # 2,3 => 1 my $y = $x->copy(); my $l = int($x->length()/2); @@ -1540,7 +1676,7 @@ sub bsqrt $x /= $two; } $x-- if $x * $x > $y; # overshot? - return $x->round($a,$p,$r); + $x->round($a,$p,$r); } sub exponent @@ -1594,6 +1730,7 @@ sub bfround my $x = shift; $x = $class->new($x) unless ref $x; my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_); return $x if !defined $scale; # no-op + return $x if $x->modify('bfround'); # no-op for BigInts if $n <= 0 if ($scale <= 0) @@ -1644,6 +1781,7 @@ sub bround my $x = shift; $x = $class->new($x) unless ref $x; my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_); return $x if !defined $scale; # no-op + return $x if $x->modify('bround'); if ($x->is_zero() || $scale == 0) { @@ -1916,11 +2054,18 @@ sub import overload::constant integer => sub { $self->new(shift) }; splice @a, $j, 1; $j --; } + elsif ($_[$i] eq 'upgrade') + { + # this causes upgrading + $upgrade = $_[$i+1]; # or undef to disable + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; + } elsif ($_[$i] =~ /^lib$/i) { # this causes a different low lib to take care... $CALC = $_[$i+1] || ''; - my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." splice @a, $j, $s; $j -= $s; } } @@ -2236,6 +2381,7 @@ Math::BigInt - Arbitrary size integer math package $x->is_positive(); # true if >= 0 $x->is_negative(); # true if < 0 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+') + $x->is_int(); # true if $x is an integer (not a float) $x->bcmp($y); # compare numbers (undef,<0,=0,>0) $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) @@ -2250,6 +2396,8 @@ Math::BigInt - Arbitrary size integer math package $x->bnan(); # set $x to NaN $x->bone(); # set $x to +1 $x->bone('-'); # set $x to -1 + $x->binf(); # set $x to inf + $x->binf('-'); # set $x to -inf $x->bneg(); # negation $x->babs(); # absolute value @@ -2277,6 +2425,7 @@ Math::BigInt - Arbitrary size integer math package $x->bnot(); # bitwise not (two's complement) $x->bsqrt(); # calculate square-root + $x->bfac(); # factorial of $x (1*2*3*4*..$x) $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r $x->bround($N); # accuracy: preserve $N digits @@ -2355,6 +2504,291 @@ return either undef, <0, 0 or >0 and are suited for sort. =back +=head1 METHODS + +Each of the methods below accepts three additional parameters. These arguments +$A, $P and $R are accuracy, precision and round_mode. Please see more in the +section about ACCURACY and ROUNDIND. + +=head2 brsft + + $x->brsft($y,$n); + +Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and +2, but others work, too. + +Right shifting usually amounts to dividing $x by $n ** $y and truncating the +result: + + + $x = Math::BigInt->new(10); + $x->brsft(1); # same as $x >> 1: 5 + $x = Math::BigInt->new(1234); + $x->brsft(2,10); # result 12 + +There is one exception, and that is base 2 with negative $x: + + + $x = Math::BigInt->new(-5); + print $x->brsft(1); + +This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the +result). + +=head2 new + + $x = Math::BigInt->new($str,$A,$P,$R); + +Creates a new BigInt object from a string or another BigInt object. The +input is accepted as decimal, hex (with leading '0x') or binary (with leading +'0b'). + +=head2 bnan + + $x = Math::BigInt->bnan(); + +Creates a new BigInt object representing NaN (Not A Number). +If used on an object, it will set it to NaN: + + $x->bnan(); + +=head2 bzero + + $x = Math::BigInt->bzero(); + +Creates a new BigInt object representing zero. +If used on an object, it will set it to zero: + + $x->bzero(); + +=head2 binf + + $x = Math::BigInt->binf($sign); + +Creates a new BigInt object representing infinity. The optional argument is +either '-' or '+', indicating whether you want infinity or minus infinity. +If used on an object, it will set it to infinity: + + $x->binf(); + $x->binf('-'); + +=head2 bone + + $x = Math::BigInt->binf($sign); + +Creates a new BigInt object representing one. The optional argument is +either '-' or '+', indicating whether you want one or minus one. +If used on an object, it will set it to one: + + $x->bone(); # +1 + $x->bone('-'); # -1 + +=head2 is_one()/is_zero()/is_nan()/is_positive()/is_negative()/is_inf()/is_odd()/is_even()/is_int() + + $x->is_zero(); # true if arg is +0 + $x->is_nan(); # true if arg is NaN + $x->is_one(); # true if arg is +1 + $x->is_one('-'); # true if arg is -1 + $x->is_odd(); # true if odd, false for even + $x->is_even(); # true if even, false for odd + $x->is_positive(); # true if >= 0 + $x->is_negative(); # true if < 0 + $x->is_inf(); # true if +inf + $x->is_inf('-'); # true if -inf (sign is default '+') + $x->is_int(); # true if $x is an integer + +These methods all test the BigInt for one condition and return true or false +depending on the input. + +=head2 bcmp + + $x->bcmp($y); # compare numbers (undef,<0,=0,>0) + +=head2 bacmp + + $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) + +=head2 sign + + $x->sign(); # return the sign, either +,- or NaN + +=head2 bcmp + + $x->digit($n); # return the nth digit, counting from right + +=head2 bneg + + $x->bneg(); + +Negate the number, e.g. change the sign between '+' and '-', or between '+inf' +and '-inf', respectively. Does nothing for NaN or zero. + +=head2 babs + + $x->babs(); + +Set the number to it's absolute value, e.g. change the sign from '-' to '+' +and from '-inf' to '+inf', respectively. Does nothing for NaN or positive +numbers. + +=head2 bnorm + + $x->bnorm(); # normalize (no-op) + +=head2 bnot + + $x->bnot(); # two's complement (bit wise not) + +=head2 binc + + $x->binc(); # increment x by 1 + +=head2 bdec + + $x->bdec(); # decrement x by 1 + +=head2 badd + + $x->badd($y); # addition (add $y to $x) + +=head2 bsub + + $x->bsub($y); # subtraction (subtract $y from $x) + +=head2 bmul + + $x->bmul($y); # multiplication (multiply $x by $y) + +=head2 bdiv + + $x->bdiv($y); # divide, set $x to quotient + # return (quo,rem) or quo if scalar + +=head2 bmod + + $x->bmod($y); # modulus (x % y) + +=head2 bpow + + $x->bpow($y); # power of arguments (x ** y) + +=head2 blsft + + $x->blsft($y); # left shift + $x->blsft($y,$n); # left shift, by base $n (like 10) + +=head2 brsft + + $x->brsft($y); # right shift + $x->brsft($y,$n); # right shift, by base $n (like 10) + +=head2 band + + $x->band($y); # bitwise and + +=head2 bior + + $x->bior($y); # bitwise inclusive or + +=head2 bxor + + $x->bxor($y); # bitwise exclusive or + +=head2 bnot + + $x->bnot(); # bitwise not (two's complement) + +=head2 bsqrt + + $x->bsqrt(); # calculate square-root + +=head2 bfac + + $x->bfac(); # factorial of $x (1*2*3*4*..$x) + +=head2 round + + $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r + +=head2 bround + + $x->bround($N); # accuracy: preserve $N digits + +=head2 bfround + + $x->bfround($N); # round to $Nth digit, no-op for BigInts + +=head2 bfloor + + $x->bfloor(); + +Set $x to the integer less or equal than $x. This is a no-op in BigInt, but +does change $x in BigFloat. + +=head2 bceil + + $x->bceil(); + +Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but +does change $x in BigFloat. + +=head2 bgcd + + bgcd(@values); # greatest common divisor (no OO style) + +=head2 blcm + + blcm(@values); # lowest common multiplicator (no OO style) + +head2 length + + $x->length(); + ($xl,$fl) = $x->length(); + +Returns the number of digits in the decimal representation of the number. +In list context, returns the length of the integer and fraction part. For +BigInt's, the length of the fraction part will always be 0. + +=head2 exponent + + $x->exponent(); + +Return the exponent of $x as BigInt. + +=head2 mantissa + + $x->mantissa(); + +Return the signed mantissa of $x as BigInt. + +=head2 parts + + $x->parts(); # return (mantissa,exponent) as BigInt + +=head2 copy + + $x->copy(); # make a true copy of $x (unlike $y = $x;) + +=head2 as_number + + $x->as_number(); # return as BigInt (in BigInt: same as copy()) + +=head2 bsrt + + $x->bstr(); # normalized string + +=head2 bsstr + + $x->bsstr(); # normalized string in scientific notation + +=head2 as_hex + + $x->as_hex(); # as signed hexadecimal string with prefixed 0x + +=head2 as_bin + + $x->as_bin(); # as signed binary string with prefixed 0b + =head1 ACCURACY and PRECISION Since version v1.33, Math::BigInt and Math::BigFloat have full support for @@ -2534,29 +2968,48 @@ This is how it works now: =item Setting/Accessing - * You can set the A global via $Math::BigInt::accuracy or - $Math::BigFloat::accuracy or whatever class you are using. - * You can also set P globally by using $Math::SomeClass::precision likewise. + * You can set the A global via Math::BigInt->accuracy() or + Math::BigFloat->accuracy() or whatever class you are using. + * You can also set P globally by using Math::SomeClass->precision() likewise. * Globals are classwide, and not inherited by subclasses. - * to undefine A, use $Math::SomeCLass::accuracy = undef - * to undefine P, use $Math::SomeClass::precision = undef + * to undefine A, use Math::SomeCLass->accuracy(undef); + * to undefine P, use Math::SomeClass->precision(undef); + * Setting Math::SomeClass->accuracy() clears automatically + Math::SomeClass->precision(), and vice versa. * To be valid, A must be > 0, P can have any value. * If P is negative, this means round to the P'th place to the right of the decimal point; positive values mean to the left of the decimal point. P of 0 means round to integer. - * to find out the current global A, take $Math::SomeClass::accuracy - * use $x->accuracy() for the local setting of $x. - * to find out the current global P, take $Math::SomeClass::precision - * use $x->precision() for the local setting + * to find out the current global A, take Math::SomeClass->accuracy() + * to find out the current global P, take Math::SomeClass->precision() + * use $x->accuracy() respective $x->precision() for the local setting of $x. + * Please note that $x->accuracy() respecive $x->precision() fall back to the + defined globals, when $x's A or P is not set. =item Creating numbers - !* When you create a number, there should be a way to define its A & P - * When a number without specific A or P is created, but the globals are - defined, these should be used to round the number immediately and also - stored locally with the number. Thus changing the global defaults later on + * When you create a number, you can give it's desired A or P via: + $x = Math::BigInt->new($number,$A,$P); + * Only one of A or P can be defined, otherwise the result is NaN + * If no A or P is give ($x = Math::BigInt->new($number) form), then the + globals (if set) will be used. Thus changing the global defaults later on will not change the A or P of previously created numbers (i.e., A and P of - $x will be what was in effect when $x was created) + $x will be what was in effect when $x was created) + * If given undef for A and P, B rounding will occur, and the globals will + B be used. This is used by subclasses to create numbers without + suffering rounding in the parent. Thus a subclass is able to have it's own + globals enforced upon creation of a number by using + $x = Math::BigInt->new($number,undef,undef): + + use Math::Bigint::SomeSubclass; + use Math::BigInt; + + Math::BigInt->accuracy(2); + Math::BigInt::SomeSubClass->accuracy(3); + $x = Math::BigInt::SomeSubClass->new(1234); + + $x is now 1230, and not 1200. A subclass might choose to implement + this otherwise, e.g. falling back to the parent's A and P. =item Usage @@ -2574,9 +3027,8 @@ This is how it works now: Since you can set/get both A and P, there is a rule that will practically enforce only A or P to be in effect at a time, even if both are set. This is called precedence. - !* If two objects are involved in an operation, and one of them has A in - ! effect, and the other P, this should result in a warning or an error, - ! probably in NaN. + * If two objects are involved in an operation, and one of them has A in + effect, and the other P, this results in an error (NaN). * A takes precendence over P (Hint: A comes before P). If A is defined, it is used, otherwise P is used. If neither of them is defined, nothing is used, i.e. the result will have as many digits as it can (with an @@ -2587,7 +3039,7 @@ This is how it works now: the value of F, the higher value will be used instead of F. This is to limit the digits (A) of the result (just consider what would happen with unlimited A and P in the case of 1/3 :-) - * fdiv will calculate 1 more digit than required (determined by + * fdiv will calculate (at least) 4 more digits than required (determined by A, P or F), and, if F is not used, round the result (this will still fail in the case of a result like 0.12345000000001 with A or P of 5, but this can not be helped - or can it?) @@ -2623,7 +3075,7 @@ This is how it works now: * you will be able to give A, P and R as an argument to all the calculation routines; the second parameter is A, the third one is P, and the fourth is - R (shift place by one for binary operations like add). P is used only if + R (shift right by one for binary operations like badd). P is used only if the first parameter (A) is undefined. These three parameters override the globals in the order detailed as follows, i.e. the first defined value wins: @@ -2631,7 +3083,7 @@ This is how it works now: + parameter A + parameter P + local A (if defined on both of the operands: smaller one is taken) - + local P (if defined on both of the operands: smaller one is taken) + + local P (if defined on both of the operands: bigger one is taken) + global A + global P + global F @@ -2643,6 +3095,7 @@ This is how it works now: * You can set A and P locally by using $x->accuracy() and $x->precision() and thus force different A and P for different objects/numbers. * Setting A or P this way immediately rounds $x to the new value. + * $x->accuracy() clears $x->precision(), and vice versa. =item Rounding @@ -2710,10 +3163,10 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: use Math::BigInt lib => 'Foo,Math::BigInt::Bar'; Calc.pm uses as internal format an array of elements of some decimal base -(usually 1e5, but this might change to 1e7) with the least significant digit -first, while BitVect.pm uses a bit vector of base 2, most significant bit -first. Other modules might use even different means of representing the -numbers. See the respective module documentation for further details. +(usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm +uses a bit vector of base 2, most significant bit first. Other modules might +use even different means of representing the numbers. See the respective +module documentation for further details. =head2 SIGN @@ -2869,6 +3322,116 @@ See L for more information. For more benchmark results see L. +=head2 SUBCLASSING + +=head1 Subclassing Math::BigInt + +The basic design of Math::BigInt allows simple subclasses with very little +work, as long as a few simple rules are followed: + +=over 2 + +=item * + +The public API must remain consistent, i.e. if a sub-class is overloading +addition, the sub-class must use the same name, in this case badd(). The +reason for this is that Math::BigInt is optimized to call the object methods +directly. + +=item * + +The private object hash keys like C<$x->{sign}> may not be changed, but +additional keys can be added, like C<$x->{_custom}>. + +=item * + +Accessor functions are available for all existing object hash keys and should +be used instead of directly accessing the internal hash keys. The reason for +this is that Math::BigInt itself has a pluggable interface which permits it +to support different storage methods. + +=back + +More complex sub-classes may have to replicate more of the logic internal of +Math::BigInt if they need to change more basic behaviors. A subclass that +needs to merely change the output only needs to overload C. + +All other object methods and overloaded functions can be directly inherited +from the parent class. + +At the very minimum, any subclass will need to provide it's own C and can +store additional hash keys in the object. There are also some package globals +that must be defined, e.g.: + + # Globals + $accuracy = undef; + $precision = -2; # round to 2 decimal places + $round_mode = 'even'; + $div_scale = 40; + +Additionally, you might want to provide the following two globals to allow +auto-upgrading and auto-downgrading to work correctly: + + $upgrade = undef; + $downgrade = undef; + +This allows Math::BigInt to correctly retrieve package globals from the +subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or +t/Math/BigFloat/SubClass.pm completely functional subclass examples. + +Don't forget to + + use overload; + +in your subclass to automatically inherit the overloading from the parent. If +you like, you can change part of the overloading, look at Math::String for an +example. + +=head1 UPGRADING + +When used like this: + + use Math::BigInt upgrade => 'Foo::Bar'; + +certain operations will 'upgrade' their calculation and thus the result to +the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat: + + use Math::BigInt upgrade => 'Math::BigFloat'; + +As a shortcut, you can use the module C: + + use bignum; + +Also good for oneliners: + + perl -Mbignum -le 'print 2 ** 255' + +This makes it possible to mix arguments of different classes (as in 2.5 + 2) +as well es preserve accuracy (as in sqrt(3)). + +Beware: This feature is not fully implemented yet. + +=head2 Auto-upgrade + +The following methods upgrade themselves unconditionally; that is if upgrade +is in effect, they will always hand up their work: + +=over 2 + +=item bsqrt() + +=item div() + +=item blog() + +=back + +Beware: This list is not complete. + +All other methods upgrade themselves only when one (or all) of their +arguments are of the class mentioned in $upgrade (This might change in later +versions to a more sophisticated scheme): + =head1 BUGS =over 2 @@ -3180,6 +3743,8 @@ will both result in the proper type due to the way the overloaded math works. This section also applies to other overloaded math packages, like Math::String. +One solution to you problem might be L. + =item bsqrt() C works only good if the result is a big integer, e.g. the square @@ -3197,6 +3762,10 @@ If you want a better approximation of the square root, then use: print $x->bsqrt(),"\n"; # 3.46 print $x->bsqrt(3),"\n"; # 3.464 +=item brsft() + +For negative numbers in base see also L. + =back =head1 LICENSE diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index d91272e..d76aa09 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.20'; +$VERSION = '0.22'; # Package to store unsigned big integers in decimal and do math with them @@ -330,6 +330,13 @@ sub _add # This routine clobbers up array x, but not y. my ($c,$x,$y) = @_; + + return $x if (@$y == 1) && $y->[0] == 0; # $x + 0 => $x + if ((@$x == 1) && $x->[0] == 0) # 0 + $y => $y->copy + { + # twice as slow as $x = [ @$y ], but necc. to retain $x as ref :( + @$x = @$y; return $x; + } # for each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry @@ -419,17 +426,24 @@ sub _mul_use_mul # modifies first arg, second need not be different from first my ($c,$xv,$yv) = @_; - # shortcut for two very short numbers - # +0 since part maybe string '00001' from new() + # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference - if ((@$xv == 1) && (@$yv == 1) - && (length($xv->[0]+0) <= $BASE_LEN2) - && (length($yv->[0]+0) <= $BASE_LEN2)) - { - $xv->[0] *= $yv->[0]; - return $xv; - } - + if ((@$xv == 1) && (@$yv == 1)) + { + if (($xv->[0] *= $yv->[0]) >= $MBASE) + { + $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE; + }; + return $xv; + } + # shortcut for result == 0 + if ( ((@$xv == 1) && ($xv->[0] == 0)) || + ((@$yv == 1) && ($yv->[0] == 0)) ) + { + @$xv = (0); + return $xv; + } + # since multiplying $x with $x fails, make copy in this case $yv = [@$xv] if "$xv" eq "$yv"; # same references? if ($LEN_CONVERT != 0) @@ -487,16 +501,25 @@ sub _mul_use_div # modifies first arg, second need not be different from first my ($c,$xv,$yv) = @_; - # shortcut for two very short numbers - # +0 since part maybe string '00001' from new() + # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference - if ((@$xv == 1) && (@$yv == 1) - && (length($xv->[0]+0) <= $BASE_LEN2) - && (length($yv->[0]+0) <= $BASE_LEN2)) - { - $xv->[0] *= $yv->[0]; - return $xv; - } + if ((@$xv == 1) && (@$yv == 1)) + { + if (($xv->[0] *= $yv->[0]) >= $MBASE) + { + $xv->[0] = + $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE; + }; + return $xv; + } + # shortcut for result == 0 + if ( ((@$xv == 1) && ($xv->[0] == 0)) || + ((@$yv == 1) && ($yv->[0] == 0)) ) + { + @$xv = (0); + return $xv; + } + # since multiplying $x with $x fails, make copy in this case $yv = [@$xv] if "$xv" eq "$yv"; # same references? @@ -1122,7 +1145,50 @@ sub _pow $cx; } -sub _sqrt1 +sub _fac + { + # factorial of $x + # ref to array, return ref to array + my ($c,$cx) = @_; + + if ((@$cx == 1) && ($cx->[0] <= 2)) + { + $cx->[0] = 1 * ($cx->[0]||1); # 0,1 => 1, 2 => 2 + return $cx; + } + + # go forward until $base is exceeded + # limit is either $x or $base (x == 100 means as result too high) + my $steps = 100; $steps = $cx->[0] if @$cx == 1; + my $r = 2; my $cf = 3; my $step = 1; my $last = $r; + while ($r < $BASE && $step < $steps) + { + $last = $r; $r *= $cf++; $step++; + } + if ((@$cx == 1) && ($step == $cx->[0])) + { + # completely done + $cx = [$last]; + return $cx; + } + my $n = _copy($c,$cx); + $cx = [$last]; + + #$cx = _one(); + while (!(@$n == 1 && $n->[0] == $step)) + { + _mul($c,$cx,$n); _dec($c,$n); + } + $cx; + } + +use constant DEBUG => 0; + +my $steps = 0; + +sub steps { $steps }; + +sub _sqrt { # square-root of $x # ref to array, return ref to array @@ -1135,31 +1201,68 @@ sub _sqrt1 return $x; } my $y = _copy($c,$x); - my $l = _len($c,$x) / 2; # hopefully _len/2 is < $BASE - # my $l2 = [ _len($c,$x) / 2 ]; # old way: hopefully _len/2 is < $BASE - - splice @$x,0; $x->[0] = 1; # keep ref($x), but modify it - - # old way - # _lsft($c,$x,$l2,10); + # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess + # since our guess will "grow" + my $l = int((_len($c,$x)-1) / 2); + + my $lastelem = $x->[-1]; # for guess + my $elems = scalar @$x - 1; + # not enough digits, but could have more? + if ((length($lastelem) <= 3) && ($elems > 1)) + { + # right-align with zero pad + my $len = length($lastelem) & 1; + print "$lastelem => " if DEBUG; + $lastelem .= substr($x->[-2] . '0' x $BASE_LEN,0,$BASE_LEN); + # former odd => make odd again, or former even to even again + $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len; + print "$lastelem\n" if DEBUG; + } # construct $x (instead of _lsft($c,$x,$l,10) my $r = $l % $BASE_LEN; # 10000 00000 00000 00000 ($BASE_LEN=5) $l = int($l / $BASE_LEN); - $x->[$l--] = int('1' . '0' x $r); - $x->[$l--] = 0 while ($l >= 0); + print "l = $l " if DEBUG; + + splice @$x,$l; # keep ref($x), but modify it + + # we make the first part of the guess not '1000...0' but int(sqrt($lastelem)) + # that gives us: + # 14400 00000 => sqrt(14400) => 120 + # 144000 000000 => sqrt(144000) => 379 + + # $x->[$l--] = int('1' . '0' x $r); # old way of guessing + print "$lastelem (elems $elems) => " if DEBUG; + $lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even? + my $g = sqrt($lastelem); $g =~ s/\.//; # 2.345 => 2345 + $r -= 1 if $elems & 1 == 0; # 70 => 7 + + # padd with zeros if result is too short + $x->[$l--] = int(substr($g . '0' x $r,0,$r+1)); + print "now ",$x->[-1] if DEBUG; + print " would have been ", int('1' . '0' x $r),"\n" if DEBUG; + + # If @$x > 1, we could compute the second elem of the guess, too, to create + # an even better guess. Not implemented yet. + $x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero + print "start x= ",${_str($c,$x)},"\n" if DEBUG; my $two = _two(); my $last = _zero(); my $lastlast = _zero(); + $steps = 0 if DEBUG; while (_acmp($c,$last,$x) != 0 && _acmp($c,$lastlast,$x) != 0) { + $steps++ if DEBUG; $lastlast = _copy($c,$last); $last = _copy($c,$x); _add($c,$x, _div($c,_copy($c,$y),$x)); _div($c,$x, $two ); + print " x= ",${_str($c,$x)},"\n" if DEBUG; } + print "\nsteps in sqrt: $steps, " if DEBUG; _dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot? + print " final ",$x->[-1],"\n" if DEBUG; $x; } @@ -1466,6 +1569,7 @@ slow) fallback routines to emulate these: _mod(obj,obj) Return remainder of div of the 1st by the 2nd object _sqrt(obj) return the square root of object (truncate to int) + _fac(obj) return factorial of object 1 (1*2*3*4..) _pow(obj,obj) return object 1 to the power of object 2 _gcd(obj,obj) return Greatest Common Divisor of two objects diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t new file mode 100644 index 0000000..2e669f8 --- /dev/null +++ b/lib/Math/BigInt/t/bare_mbf.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/bare_mbf.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../t/lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + + plan tests => 1585; + } + +use Math::BigInt lib => 'BareCalc'; +use Math::BigFloat; + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigFloat"; +$CL = "Math::BigInt::BareCalc"; + +require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index 5b2df41..b5ffa9d 100644 --- a/lib/Math/BigInt/t/bare_mbi.t +++ b/lib/Math/BigInt/t/bare_mbi.t @@ -26,18 +26,18 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2005; + plan tests => 2095; } use Math::BigInt lib => 'BareCalc'; -print "# ",Math::BigInt::_core_lib(),"\n"; +print "# ",Math::BigInt->config()->{lib},"\n"; use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigInt"; $CL = "Math::BigInt::BareCalc"; -my $version = '1.49'; # for $VERSION tests, match current release (by hand!) +my $version = '1.51'; # for $VERSION tests, match current release (by hand!) require 'bigintpm.inc'; # perform same tests as bigintpm diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index a5e527e..e7860d3 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -1,4 +1,7 @@ #include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + while () { chop; @@ -52,11 +55,11 @@ while () $try .= "\$x->numify();"; } elsif ($f eq "length") { $try .= "\$x->length();"; - # some unary ops (test the bxxx form, since that is done by AUTOLOAD) + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { $try .= "\$x->f$1();"; # some is_xxx test function - } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan)$/) { + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { $try .= "\$x->$f();"; } elsif ($f eq "as_number") { $try .= '$x->as_number();'; @@ -70,14 +73,16 @@ while () $try .= "$setup; \$x->ffround($args[1]);"; } elsif ($f eq "fsqrt") { $try .= "$setup; \$x->fsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->flog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->ffac();"; } else { $try .= "\$y = new $class \"$args[1]\";"; if ($f eq "fcmp") { $try .= '$x <=> $y;'; - } elsif ($f eq "flog") { - $try .= '$x->flog($y);'; } elsif ($f eq "facmp") { $try .= '$x->facmp($y);'; } elsif ($f eq "fpow") { @@ -90,6 +95,8 @@ while () $try .= '$x * $y;'; } elsif ($f eq "fdiv") { $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->fdiv(\$y));"; } elsif ($f eq "frsft") { $try .= '$x >> $y;'; } elsif ($f eq "flsft") { @@ -140,14 +147,7 @@ $x = Math::BigInt->new(1200); $y = $class->new($x); ok ($y,1200); ok ($x,1200); ############################################################################### -# fdiv() in list context - -$x = $class->bzero(); ($x,$y) = $x->fdiv(0); -ok ($x,'NaN'); ok ($y,'NaN'); - -# fdiv() in list context -$x = $class->bzero(); ($x,$y) = $x->fdiv(1); -ok ($x,0); ok ($y,0); +# zero,inf,one,nan $x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); @@ -168,7 +168,7 @@ $x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); $class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); # A and P set => NaN -$class->accuracy(4); $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN'); +${${class}.'::accuracy'} = 4; $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN'); # supplied arg overrides set global $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); @@ -188,19 +188,31 @@ sub ok_undef } __DATA__ -#&flog -#$div_scale = 14; -#10:0:2.30258509299405 +$div_scale = 40; +&flog +0:NaN +-1:NaN +-2:NaN +1:0 +# this is too slow for the testsuite +#2.718281828:0.9999999998311266953289851340574956564911 +#$div_scale = 20; +#2.718281828:0.99999999983112669533 +1:0 +# too slow, too (or hangs?) +#123:4.8112184355 +# $div_scale = 14; +#10:0:2.302585092994 #1000:0:6.90775527898214 #100:0:4.60517018598809 #2:0:0.693147180559945 #3.1415:0:1.14470039286086 #12345:0:9.42100640177928 #0.001:0:-6.90775527898214 -## reset for further tests -#$div_scale = 40; +# reset for further tests +$div_scale = 40; &frsft -#NaNfrsft:NaN +NaNfrsft:2:NaN 0:2:0 1:1:0.5 2:1:1 @@ -208,7 +220,7 @@ __DATA__ 123:1:61.5 32:3:4 &flsft -#NaNflsft:NaN +NaNflsft:0:NaN 2:1:4 4:3:32 5:3:40 @@ -880,6 +892,11 @@ NaNmul:-inf:NaN +99999999999:+9:899999999991 6:120:720 10:10000:100000 +&fdiv-list +0:0:NaN,NaN +0:1:0,0 +9:4:2.25,1 +9:5:1.8,4 &fdiv $div_scale = 40; $round_mode = 'even' abc:abc:NaN @@ -975,10 +992,10 @@ inf:-5:0 -inf:-5:0 5:5:0 -5:-5:0 -inf:inf:0 --inf:-inf:0 --inf:inf:0 -inf:-inf:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN 8:0:8 inf:0:inf # exceptions to reminder rule @@ -1041,6 +1058,19 @@ abc:1:abc:NaN 1230:2.5:0 123.4:2.5:0.9 123e1:25:5 +&ffac +Nanfac:NaN +-1:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 &fsqrt +0:0 -1:NaN @@ -1062,6 +1092,7 @@ nanfsqrt:NaN # sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 1.44E10:120000 2e10:141421.356237309504880168872420969807857 +144e20:120000000000 # proved to be an endless loop under 7-9 12:3.464101615137754587054892683011744733886 &is_nan @@ -1097,6 +1128,18 @@ abc:0 123.45:0 -123.45:0 2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 &is_even abc:0 0:1 @@ -1111,6 +1154,11 @@ abc:0 -inf:0 123.456:0 -123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 &is_positive 0:1 1:1 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 2c98122..0ed5c4a 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -26,13 +26,14 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1528; + plan tests => 1585; } use Math::BigInt; use Math::BigFloat; -use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigFloat"; +$CL = "Math::BigInt::Calc"; require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 220ce30..26530ca 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -16,7 +16,7 @@ BEGIN { my $additional = 0; $additional = 27 if $Math::BigInt::Calc::VERSION > 0.18; - plan tests => 71 + $additional; + plan tests => 80 + $additional; } # testing of Math::BigInt::Calc, primarily for interface/api and not for the @@ -124,6 +124,19 @@ $x = $C->_new(\"123"); $y = $C->_new(\"1111"); # _num $x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345); +# _sqrt +$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12'); + +# _fac +$x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1'); +$x = $C->_new(\"1"); ok (${$C->_str($C->_fac($x))},'1'); +$x = $C->_new(\"2"); ok (${$C->_str($C->_fac($x))},'2'); +$x = $C->_new(\"3"); ok (${$C->_str($C->_fac($x))},'6'); +$x = $C->_new(\"4"); ok (${$C->_str($C->_fac($x))},'24'); +$x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120'); +$x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800'); +$x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800'); + # _inc $x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001'); $C->_dec($x); ok (${$C->_str($x)},'1000'); diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 5d8bddb..137ead4 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -34,9 +34,9 @@ sub _swap ############################################################################## package main; -my $CALC = $class->_core_lib(); ok ($CALC,$CL); +my $CALC = $class->config()->{lib}; ok ($CALC,$CL); -my ($f,$z,$a,$exp,@a,$m,$e,$round_mode); +my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class); while () { @@ -52,12 +52,17 @@ while () } @args = split(/:/,$_,99); $ans = pop(@args); + $expected_class = $class; + if ($ans =~ /(.*?)=(.*)/) + { + $expected_class = $2; $ans = $1; + } $try = "\$x = $class->new(\"$args[0]\");"; if ($f eq "bnorm") { $try = "\$x = $class->bnorm(\"$args[0]\");"; # some is_xxx tests - } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) { + } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { $try .= "\$x->$f();"; } elsif ($f eq "as_hex") { $try .= '$x->as_hex();'; @@ -70,7 +75,7 @@ while () } elsif ($f eq "bone") { $try .= "\$x->bone('$args[1]');"; # some unary ops - } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) { + } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) { $try .= "\$x->$f();"; } elsif ($f eq "length") { $try .= '$x->length();'; @@ -177,6 +182,7 @@ while () { # print "try: $try ans: $ans1 $ans\n"; print "# Tried: '$try'\n" if !ok ($ans1, $ans); + ok (ref($ans),$expected_class) if $expected_class ne $class; } # check internal state of number objects is_valid($ans1,$f) if ref $ans1; @@ -562,6 +568,13 @@ NaNneg:0 +inf:1 -inf:0 NaNneg:0 +&is_int +-inf:0 ++inf:0 +NaNis_int:0 +1:1 +0:1 +123e12:1 &is_odd abc:0 0:0 @@ -572,6 +585,8 @@ abc:0 10000001:1 10000002:0 2:0 +120:0 +121:1 &is_even abc:0 0:1 @@ -582,6 +597,8 @@ abc:0 10000001:0 10000002:1 2:1 +120:1 +121:0 &bacmp +0:-0:0 +0:+1:-1 @@ -836,6 +853,10 @@ abc:abc:NaN +12:2:10:1200 +1234:-3:10:NaN 1234567890123:12:10:1234567890123000000000000 +-3:1:2:-6 +-5:1:2:-10 +-2:1:2:-4 +-102533203:1:2:-205066406 &brsft abc:abc:NaN +8:+2:2 @@ -854,6 +875,27 @@ abc:abc:NaN 1230000000000:10:10:123 09876123456789067890:12:10:9876123 1234561234567890123:13:10:123456 +820265627:1:2:410132813 +# test shifting negative numbers in base 2 +-15:1:2:-8 +-14:1:2:-7 +-13:1:2:-7 +-12:1:2:-6 +-11:1:2:-6 +-10:1:2:-5 +-9:1:2:-5 +-8:1:2:-4 +-7:1:2:-4 +-6:1:2:-3 +-5:1:2:-3 +-4:1:2:-2 +-3:1:2:-2 +-2:1:2:-1 +-1:1:2:-1 +-1640531254:2:2:-410132814 +-1640531254:1:2:-820265627 +-820265627:1:2:-410132814 +-205066405:1:2:-102533203 &bsstr 1e+34:1e+34 123.456E3:123456e+0 @@ -940,8 +982,8 @@ abc:NaN abc:abc:NaN abc:0:NaN +0:abc:NaN -+inf:-inf:0 --inf:+inf:0 ++inf:-inf:NaN +-inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN @@ -988,8 +1030,8 @@ abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf -+inf:+inf:0 --inf:-inf:0 ++inf:+inf:NaN +-inf:-inf:NaN +0:+0:0 +1:+0:1 +0:+1:-1 @@ -1091,6 +1133,8 @@ NaNmul:-inf:NaN 4095:-4095:-1,0 -4095:4095:-1,0 123:2:61,1 +9:5:1,4 +9:4:2,1 # inf handling and general remainder 5:8:0,5 0:8:0,0 @@ -1110,10 +1154,10 @@ inf:-5:-inf,0 -inf:-5:inf,0 5:5:1,0 -5:-5:1,0 -inf:inf:1,0 --inf:-inf:1,0 --inf:inf:-1,0 -inf:-inf:-1,0 +inf:inf:NaN,NaN +-inf:-inf:NaN,NaN +-inf:inf:NaN,NaN +inf:-inf:NaN,NaN 8:0:inf,8 inf:0:inf,inf # exceptions to reminder rule @@ -1138,10 +1182,10 @@ inf:-5:-inf -inf:-5:inf 5:5:1 -5:-5:1 -inf:inf:1 --inf:-inf:1 --inf:inf:-1 -inf:-inf:-1 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN 8:0:inf inf:0:inf -8:0:-inf @@ -1213,10 +1257,10 @@ inf:-5:0 -inf:-5:0 5:5:0 -5:-5:0 -inf:inf:0 --inf:-inf:0 --inf:inf:0 -inf:-inf:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN 8:0:8 inf:0:inf # exceptions to reminder rule @@ -1273,6 +1317,7 @@ abc:1:abc:NaN 4095:4095:0 100041000510123:3:0 152403346:12345:4321 +9:5:4 &bgcd abc:abc:NaN abc:+0:NaN @@ -1483,6 +1528,21 @@ abc:NaN,NaN 0:0,1 +inf:inf,inf -inf:-inf,inf +&bfac +-1:NaN +NaNfac:NaN ++inf:NaN +-inf:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 &bpow abc:12:NaN 12:abc:NaN diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index 913c19b..f4b2a79 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 => 2005; + plan tests => 2095; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t index 800b879..ca78fe9 100644 --- a/lib/Math/BigInt/t/calling.t +++ b/lib/Math/BigInt/t/calling.t @@ -97,7 +97,7 @@ ok_undef ( $_ ); # should result in error! # test whether fallback to calc works $try = "use $class ($version,'lib','foo, bar , ');"; -$try .= "$class\->_core_lib();"; +$try .= "$class\->config()->{lib};"; $ans = eval $try; ok ( $ans, "Math::BigInt::Calc"); diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t new file mode 100644 index 0000000..5c660a7 --- /dev/null +++ b/lib/Math/BigInt/t/config.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl -w + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + plan tests => 10; + } + +# test whether Math::BigInt constant works + +use Math::BigInt; + +ok (Math::BigInt->can('config')); + +my $cfg = Math::BigInt->config(); + +ok (ref($cfg),'HASH'); + +ok ($cfg->{lib},'Math::BigInt::Calc'); +ok ($cfg->{lib_version},'0.22'); +ok ($cfg->{class},'Math::BigInt'); +ok ($cfg->{upgrade}||'',''); +ok ($cfg->{div_scale},40); + +ok ($cfg->{precision}||0,0); # should test for undef +ok ($cfg->{accuracy}||0,0); + +ok ($cfg->{round_mode},'even'); + +# all tests done + diff --git a/lib/Math/BigInt/t/constant.t b/lib/Math/BigInt/t/constant.t new file mode 100644 index 0000000..ef3e223 --- /dev/null +++ b/lib/Math/BigInt/t/constant.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + plan tests => 5; + } + +use Math::BigInt ':constant'; + +ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968'); + +use Math::BigFloat ':constant'; +ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333'); + +# stress-test Math::BigFloat->import() + +Math::BigFloat->import( qw/:constant/ ); +ok (1,1); + +Math::BigFloat->import( qw/:constant upgrade Math::BigRat/ ); +ok (1,1); + +Math::BigFloat->import( qw/upgrade Math::BigRat :constant/ ); +ok (1,1); + +# all tests done + diff --git a/lib/Math/BigInt/t/inf_nan.t b/lib/Math/BigInt/t/inf_nan.t new file mode 100644 index 0000000..38ebe03 --- /dev/null +++ b/lib/Math/BigInt/t/inf_nan.t @@ -0,0 +1,255 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + plan tests => 7*6*4; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + } + +use Math::BigInt; + +my (@args,$x,$y,$z); + +# + +foreach (qw/ + -inf:-inf:-inf + -1:-inf:-inf + -0:-inf:-inf + 0:-inf:-inf + 1:-inf:-inf + inf:-inf:NaN + NaN:-inf:NaN + + -inf:-1:-inf + -1:-1:-2 + -0:-1:-1 + 0:-1:-1 + 1:-1:0 + inf:-1:inf + NaN:-1:NaN + + -inf:0:-inf + -1:0:-1 + -0:0:0 + 0:0:0 + 1:0:1 + inf:0:inf + NaN:0:NaN + + -inf:1:-inf + -1:1:0 + -0:1:1 + 0:1:1 + 1:1:2 + inf:1:inf + NaN:1:NaN + + -inf:inf:NaN + -1:inf:inf + -0:inf:inf + 0:inf:inf + 1:inf:inf + inf:inf:inf + NaN:inf:NaN + + -inf:NaN:NaN + -1:NaN:NaN + -0:NaN:NaN + 0:NaN:NaN + 1:NaN:NaN + inf:NaN:NaN + NaN:NaN:NaN + /) + { + @args = split /:/,$_; + $x = Math::BigInt->new($args[0]); + $y = Math::BigInt->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 + print "# $args[0] + $args[1] should be $args[2] but is ",$x->bstr(),"\n" + if !ok ($x->badd($y)->bstr(),$args[2]); + } + +# - +foreach (qw/ + -inf:-inf:NaN + -1:-inf:inf + -0:-inf:inf + 0:-inf:inf + 1:-inf:inf + inf:-inf:inf + NaN:-inf:NaN + + -inf:-1:-inf + -1:-1:0 + -0:-1:1 + 0:-1:1 + 1:-1:2 + inf:-1:inf + NaN:-1:NaN + + -inf:0:-inf + -1:0:-1 + -0:0:-0 + 0:0:0 + 1:0:1 + inf:0:inf + NaN:0:NaN + + -inf:1:-inf + -1:1:-2 + -0:1:-1 + 0:1:-1 + 1:1:0 + inf:1:inf + NaN:1:NaN + + -inf:inf:-inf + -1:inf:-inf + -0:inf:-inf + 0:inf:-inf + 1:inf:-inf + inf:inf:NaN + NaN:inf:NaN + + -inf:NaN:NaN + -1:NaN:NaN + -0:NaN:NaN + 0:NaN:NaN + 1:NaN:NaN + inf:NaN:NaN + NaN:NaN:NaN + /) + { + @args = split /:/,$_; + $x = Math::BigInt->new($args[0]); + $y = Math::BigInt->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 + print "# $args[0] - $args[1] should be $args[2] but is $x\n" + if !ok ($x->bsub($y)->bstr(),$args[2]); + } + +# * +foreach (qw/ + -inf:-inf:inf + -1:-inf:inf + -0:-inf:NaN + 0:-inf:NaN + 1:-inf:-inf + inf:-inf:-inf + NaN:-inf:NaN + + -inf:-1:inf + -1:-1:1 + -0:-1:0 + 0:-1:-0 + 1:-1:-1 + inf:-1:-inf + NaN:-1:NaN + + -inf:0:NaN + -1:0:-0 + -0:0:-0 + 0:0:0 + 1:0:0 + inf:0:NaN + NaN:0:NaN + + -inf:1:-inf + -1:1:-1 + -0:1:-0 + 0:1:0 + 1:1:1 + inf:1:inf + NaN:1:NaN + + -inf:inf:-inf + -1:inf:-inf + -0:inf:NaN + 0:inf:NaN + 1:inf:inf + inf:inf:inf + NaN:inf:NaN + + -inf:NaN:NaN + -1:NaN:NaN + -0:NaN:NaN + 0:NaN:NaN + 1:NaN:NaN + inf:NaN:NaN + NaN:NaN:NaN + /) + { + @args = split /:/,$_; + $x = Math::BigInt->new($args[0]); + $y = Math::BigInt->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 + print "# $args[0] * $args[1] should be $args[2] but is $x\n" + if !ok ($x->bmul($y)->bstr(),$args[2]); + } + +# / +foreach (qw/ + -inf:-inf:NaN + -1:-inf:0 + -0:-inf:0 + 0:-inf:-0 + 1:-inf:-0 + inf:-inf:NaN + NaN:-inf:NaN + + -inf:-1:inf + -1:-1:1 + -0:-1:0 + 0:-1:-0 + 1:-1:-1 + inf:-1:-inf + NaN:-1:NaN + + -inf:0:-inf + -1:0:-inf + -0:0:NaN + 0:0:NaN + 1:0:inf + inf:0:inf + NaN:0:NaN + + -inf:1:-inf + -1:1:-1 + -0:1:-0 + 0:1:0 + 1:1:1 + inf:1:inf + NaN:1:NaN + + -inf:inf:NaN + -1:inf:-0 + -0:inf:-0 + 0:inf:0 + 1:inf:0 + inf:inf:NaN + NaN:inf:NaN + + -inf:NaN:NaN + -1:NaN:NaN + -0:NaN:NaN + 0:NaN:NaN + 1:NaN:NaN + inf:NaN:NaN + NaN:NaN:NaN + /) + { + @args = split /:/,$_; + $x = Math::BigInt->new($args[0]); + $y = Math::BigInt->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 + print "# $args[0] / $args[1] should be $args[2] but is $x\n" + if !ok ($x->bdiv($y)->bstr(),$args[2]); + + } + + diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc index bdb1271..f432918 100644 --- a/lib/Math/BigInt/t/mbimbf.inc +++ b/lib/Math/BigInt/t/mbimbf.inc @@ -149,7 +149,7 @@ ok ($x->copy()->round(5),'123.46'); ok ($x->copy()->round(4),'123.5'); ok ($x->copy()->round(5,2),'NaN'); ok ($x->copy()->round(undef,-2),'123.46'); -ok ($x->copy()->round(undef,2),100); +ok ($x->copy()->round(undef,2),120); $x = $mbi->new('123'); ok ($x->round(5,2),'NaN'); @@ -265,7 +265,9 @@ $y = $mbi->new(12345); $z = $u->copy()->bmul($y,2,undef,'odd'); ok ($z,31000); $z = $u->copy()->bmul($y,3,undef,'odd'); ok ($z,30900); $z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863); -$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860); +$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30863); +$z = $u->copy()->bmul($y,undef,2,'odd'); ok ($z,30860); +$z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900); $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5); # breakage: @@ -392,8 +394,12 @@ $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(6); # must be no-op ok ($x,'12345'); -$x = $mbf->new('0.0061'); $x->bfround(-2); -ok ($x,'0.01'); +$x = $mbf->new('0.0061'); $x->bfround(-2); ok ($x,'0.01'); +$x = $mbf->new('0.004'); $x->bfround(-2); ok ($x,'0.00'); +$x = $mbf->new('0.005'); $x->bfround(-2); ok ($x,'0.00'); + +$x = $mbf->new('12345'); $x->bfround(2); ok ($x,'12340'); +$x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340'); # MBI::bfround should clear A for negative P $x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2); @@ -572,11 +578,16 @@ foreach (qw/new bsqrt/) print "# Tried: '$try'\n" if !ok ($rc, 'NaN'); } +# see if $x->bsub(0) really rounds +$x = $mbi->new(123); $mbi->accuracy(2); $x->bsub(0); +ok ($x,120); +$mbi->accuracy(undef); + ############################################################################### # test whether shortcuts returning zero/one preserve A and P my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args); -my $CALC = Math::BigInt::_core_lib(); +my $CALC = Math::BigInt->config()->{lib}; while () { chop; @@ -619,7 +630,7 @@ while () $a = $xa || $ya; $p = $xp || $yp; # print "Check a=$a p=$p\n"; - print "# Tried: '$try'\n"; + # print "# Tried: '$try'\n"; ok ($x->{_a}, $a) && ok_undef ($x->{_p}) if $a ne ''; ok ($x->{_p}, $p) && ok_undef ($x->{_a}) if $p ne ''; } @@ -671,7 +682,6 @@ sub is_valid # the A or P of the result is calculated automatically __DATA__ &badd -# bsub uses badd anyway, so it should be right 123,,:123,,:246 123,3,:0,,:123 123,,-3:0,,:123 diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index af3e4cf..736006c 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -31,12 +31,12 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 428 - + 8; # own test + plan tests => 435 + + 16; # own tests } -use Math::BigInt 1.49; -use Math::BigFloat 1.26; +use Math::BigInt 1.50; +use Math::BigFloat 1.27; use vars qw/$mbi $mbf/; @@ -70,3 +70,11 @@ ok ($@ =~ /^Unknown round mode huhmbf at/); $mbi->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd'); $mbf->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd'); +foreach my $class (qw/Math::BigInt Math::BigFloat/) + { + ok ($class->accuracy(5),5); # set A + ok_undef ($class->precision()); # and now P must be cleared + ok ($class->precision(5),5); # set P + ok_undef ($class->accuracy()); # and now A must be cleared + } + diff --git a/lib/Math/BigInt/t/require.t b/lib/Math/BigInt/t/require.t index f98dbeb..de109f1 100644 --- a/lib/Math/BigInt/t/require.t +++ b/lib/Math/BigInt/t/require.t @@ -23,5 +23,3 @@ ok ($x||'undef',2); # all tests done -1; - diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 92d04e8..417bbce 100755 --- a/lib/Math/BigInt/t/sub_mbf.t +++ b/lib/Math/BigInt/t/sub_mbf.t @@ -26,14 +26,15 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1528 + plan tests => 1585 + 4; # + 4 own tests } use Math::BigFloat::Subclass; -use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigFloat::Subclass"; +$CL = "Math::BigInt::Calc"; require 'bigfltpm.inc'; # perform same tests as bigfltpm diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index eeedafe..89b7d9a 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 => 2005 + plan tests => 2095 + 4; # +4 own tests } diff --git a/lib/Math/BigInt/t/sub_mif.t b/lib/Math/BigInt/t/sub_mif.t index 01b87db..5abd6ae 100644 --- a/lib/Math/BigInt/t/sub_mif.t +++ b/lib/Math/BigInt/t/sub_mif.t @@ -13,9 +13,9 @@ BEGIN my $location = $0; $location =~ s/sub_mif.t//i; if ($ENV{PERL_CORE}) { - @INC = qw(../t/lib); # testing with the core distribution + @INC = qw(../t/lib); # testing with the core distribution } - unshift @INC, '../lib'; # for testing manually + unshift @INC, '../lib'; # for testing manually if (-d 't') { chdir 't'; @@ -27,8 +27,8 @@ BEGIN unshift @INC, $location; } print "# INC = @INC\n"; - - plan tests => 428; + + plan tests => 435; } use Math::BigInt::Subclass; diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc new file mode 100644 index 0000000..6dcaa75 --- /dev/null +++ b/lib/Math/BigInt/t/upgrade.inc @@ -0,0 +1,1463 @@ +#include this file into another for subclass testing + +# This file is nearly identical to bigintpm.t, except that certain results +# are _requird_ to be different due to "upgrading" or "promoting" to BigFloat. +# The reverse is not true, any unmarked results can be either BigInt or +# BigFloat, depending on how good the internal optimization is. + +# Plaese note that the testcount goes up by two for each extra result marked +# with ^, since then we test whether it has the proper class and that it left +# the upgrade variable alone. + +my $version = ${"$class\::VERSION"}; + +############################################################################## +# for testing inheritance of _swap + +package Math::Foo; + +use Math::BigInt lib => $main::CL; +use vars qw/@ISA/; +@ISA = (qw/Math::BigInt/); + +use overload +# customized overload for sub, since original does not use swap there +'-' => sub { my @a = ref($_[0])->_swap(@_); + $a[0]->bsub($a[1])}; + +sub _swap + { + # a fake _swap, which reverses the params + my $self = shift; # for override in subclass + if ($_[2]) + { + my $c = ref ($_[0] ) || 'Math::Foo'; + return ( $_[0]->copy(), $_[1] ); + } + else + { + return ( Math::Foo->new($_[1]), $_[0] ); + } + } + +############################################################################## +package main; + +my $CALC = $class->config()->{lib}; ok ($CALC,$CL); + +my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class); + +while () + { + chop; + next if /^#/; # skip comments + if (s/^&//) + { + $f = $_; next; + } + elsif (/^\$/) + { + $round_mode = $_; $round_mode =~ s/^\$/$class\->/; next; + } + + @args = split(/:/,$_,99); $ans = pop(@args); + $expected_class = $class; + if ($ans =~ /\^$/) + { + $expected_class = $ECL; $ans =~ s/\^$//; + } + $try = "\$x = $class->new(\"$args[0]\");"; + if ($f eq "bnorm") + { + $try = "\$x = $class->bnorm(\"$args[0]\");"; + # some is_xxx tests + } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "as_hex") { + $try .= '$x->as_hex();'; + } elsif ($f eq "as_bin") { + $try .= '$x->as_bin();'; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "binf") { + $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "bone") { + $try .= "\$x->bone('$args[1]');"; + # some unary ops + } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "length") { + $try .= '$x->length();'; + } elsif ($f eq "exponent"){ + # ->bstr() to see if an object is returned + $try .= '$x = $x->exponent()->bstr();'; + } elsif ($f eq "mantissa"){ + # ->bstr() to see if an object is returned + $try .= '$x = $x->mantissa()->bstr();'; + } elsif ($f eq "parts"){ + $try .= '($m,$e) = $x->parts();'; + # ->bstr() to see if an object is returned + $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;'; + $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;'; + $try .= '"$m,$e";'; + } else { + $try .= "\$y = $class->new('$args[1]');"; + if ($f eq "bcmp") + { + $try .= '$x <=> $y;'; + } elsif ($f eq "bround") { + $try .= "$round_mode; \$x->bround(\$y);"; + } elsif ($f eq "bacmp"){ + $try .= '$x->bacmp($y);'; + } elsif ($f eq "badd"){ + $try .= '$x + $y;'; + } elsif ($f eq "bsub"){ + $try .= '$x - $y;'; + } elsif ($f eq "bmul"){ + $try .= '$x * $y;'; + } elsif ($f eq "bdiv"){ + $try .= '$x / $y;'; + } elsif ($f eq "bdiv-list"){ + $try .= 'join (",",$x->bdiv($y));'; + # overload via x= + } elsif ($f =~ /^.=$/){ + $try .= "\$x $f \$y;"; + # overload via x + } elsif ($f =~ /^.$/){ + $try .= "\$x $f \$y;"; + } elsif ($f eq "bmod"){ + $try .= '$x % $y;'; + } elsif ($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 "blsft"){ + if (defined $args[2]) + { + $try .= "\$x->blsft(\$y,$args[2]);"; + } + else + { + $try .= "\$x << \$y;"; + } + }elsif ($f eq "brsft"){ + if (defined $args[2]) + { + $try .= "\$x->brsft(\$y,$args[2]);"; + } + else + { + $try .= "\$x >> \$y;"; + } + }elsif ($f eq "band"){ + $try .= "\$x & \$y;"; + }elsif ($f eq "bior"){ + $try .= "\$x | \$y;"; + }elsif ($f eq "bxor"){ + $try .= "\$x ^ \$y;"; + }elsif ($f eq "bpow"){ + $try .= "\$x ** \$y;"; + }elsif ($f eq "digit"){ + $try = "\$x = $class->new('$args[0]'); \$x->digit($args[1]);"; + } else { warn "Unknown op '$f'"; } + } # end else all other ops + + $ans1 = eval $try; + # convert hex/binary targets to decimal + if ($ans =~ /^(0x0x|0b0b)/) + { + $ans =~ s/^0[xb]//; $ans = Math::BigInt->new($ans)->bstr(); + } + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + # print "try: $try ans: $ans1 $ans\n"; + print "# Tried: '$try'\n" if !ok ($ans1, $ans); + if ($expected_class ne $class) + { + ok (ref($ans1),$expected_class); # also checks that it really is ref! + ok ($Math::BigInt::upgrade,'Math::BigFloat'); # still okay? + } + } + # check internal state of number objects + is_valid($ans1,$f) if ref $ans1; + } # endwhile data tests +close DATA; + +# all tests done + +1; + +############################################################################### +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +############################################################################### +# sub to check validity of a BigInt internally, to ensure that no op leaves a +# number object in an invalid state (f.i. "-0") + +sub is_valid + { + my ($x,$f,$c) = @_; + + # The checks here are loosened a bit to allow BigInt or BigFloats to pass + + my $e = 0; # error? + # ok as reference? + # $e = "Not a reference to $c" if (ref($x) || '') ne $c; + + # has ok sign? + $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'" + if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; + + $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; + #$e = $CALC->_check($x->{value}) if $e eq '0'; + + # test done, see if error did crop up + ok (1,1), return if ($e eq '0'); + + ok (1,$e." after op '$f'"); + } + +__DATA__ +&.= +1234:-345:1234-345 +&+= +1:2:3 +-1:-2:-3 +&-= +1:2:-1 +-1:-2:1 +&*= +2:3:6 +-1:5:-5 +&%= +100:3:1 +8:9:8 +&/= +100:3:33 +-8:2:-4 +&|= +2:1:3 +&&= +5:7:5 +&^= +5:7:2 +&is_negative +0:0 +-1:1 +1:0 ++inf:0 +-inf:1 +NaNneg:0 +&is_positive +0:1 +-1:0 +1:1 ++inf:1 +-inf:0 +NaNneg:0 +&is_odd +abc:0 +0:0 +1:1 +3:1 +-1:1 +-3:1 +10000001:1 +10000002:0 +2:0 +120:0 +121:1 +&is_int +NaN:0 +inf:0 +-inf:0 +1:1 +12:1 +123e12:1 +&is_even +abc:0 +0:1 +1:0 +3:0 +-1:0 +-3:0 +10000001:0 +10000002:1 +2:1 +120:1 +121:0 +&bacmp ++0:-0:0 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:+2:-1 ++2:-1:1 +-123456789:+987654321:-1 ++123456789:-987654321:-1 ++987654321:+123456789:1 +-987654321:+123456789:1 +-123:+4567889:-1 +# NaNs +acmpNaN:123: +123:acmpNaN: +acmpNaN:acmpNaN: +# infinity ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 ++inf:123:1 +-inf:123:1 ++inf:-123:1 +-inf:-123:1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&bnorm +123:123 +12.3:12.3^ +# binary input +0babc:NaN +0b123:NaN +0b0:0 +-0b0:0 +-0b1:-1 +0b0001:1 +0b001:1 +0b011:3 +0b101:5 +0b1001:9 +0b10001:17 +0b100001:33 +0b1000001:65 +0b10000001:129 +0b100000001:257 +0b1000000001:513 +0b10000000001:1025 +0b100000000001:2049 +0b1000000000001:4097 +0b10000000000001:8193 +0b100000000000001:16385 +0b1000000000000001:32769 +0b10000000000000001:65537 +0b100000000000000001:131073 +0b1000000000000000001:262145 +0b10000000000000000001:524289 +0b100000000000000000001:1048577 +0b1000000000000000000001:2097153 +0b10000000000000000000001:4194305 +0b100000000000000000000001:8388609 +0b1000000000000000000000001:16777217 +0b10000000000000000000000001:33554433 +0b100000000000000000000000001:67108865 +0b1000000000000000000000000001:134217729 +0b10000000000000000000000000001:268435457 +0b100000000000000000000000000001:536870913 +0b1000000000000000000000000000001:1073741825 +0b10000000000000000000000000000001:2147483649 +0b100000000000000000000000000000001:4294967297 +0b1000000000000000000000000000000001:8589934593 +0b10000000000000000000000000000000001:17179869185 +0b_101:NaN +0b1_0_1:5 +0b0_0_0_1:1 +# hex input +-0x0:0 +0xabcdefgh:NaN +0x1234:4660 +0xabcdef:11259375 +-0xABCDEF:-11259375 +-0x1234:-4660 +0x12345678:305419896 +0x1_2_3_4_56_78:305419896 +0xa_b_c_d_e_f:11259375 +0x_123:NaN +0x9:9 +0x11:17 +0x21:33 +0x41:65 +0x81:129 +0x101:257 +0x201:513 +0x401:1025 +0x801:2049 +0x1001:4097 +0x2001:8193 +0x4001:16385 +0x8001:32769 +0x10001:65537 +0x20001:131073 +0x40001:262145 +0x80001:524289 +0x100001:1048577 +0x200001:2097153 +0x400001:4194305 +0x800001:8388609 +0x1000001:16777217 +0x2000001:33554433 +0x4000001:67108865 +0x8000001:134217729 +0x10000001:268435457 +0x20000001:536870913 +0x40000001:1073741825 +0x80000001:2147483649 +0x100000001:4294967297 +0x200000001:8589934593 +0x400000001:17179869185 +0x800000001:34359738369 +# inf input +inf:inf ++inf:inf +-inf:-inf +0inf:NaN +# abnormal input +:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +# only one underscore between two digits +_123:NaN +_123_:NaN +123_:NaN +1__23:NaN +1E1__2:NaN +1_E12:NaN +1E_12:NaN +1_E_12:NaN ++_1E12:NaN ++0_1E2:100 ++0_0_1E2:100 +-0_0_1E2:-100 +-0_0_1E+0_0_2:-100 +E1:NaN +E23:NaN +1.23E1:12.3^ +1.23E-1:0.123^ +# bug with two E's in number beeing valid +1e2e3:NaN +1e2r:NaN +1e2.0:NaN +# leading zeros +012:12 +0123:123 +01234:1234 +012345:12345 +0123456:123456 +01234567:1234567 +012345678:12345678 +0123456789:123456789 +01234567891:1234567891 +012345678912:12345678912 +0123456789123:123456789123 +01234567891234:1234567891234 +# normal input +0:0 ++0:0 ++00:0 ++000:0 +000000000000000000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +1_2_3:123 +10000000000E-1_0:1 +1E2:100 +1E1:10 +1E0:1 +1.23E2:123 +100E-1:10 +# floating point input +# .2e2:20 +1.E3:1000 +1.01E2:101 +1010E-1:101 +-1010E0:-1010 +-1010E1:-10100 +1234.00:1234 +# non-integer numbers +-1010E-2:-10.1^ +-1.01E+1:-10.1^ +-1.01E-1:-0.101^ +&bnan +1:NaN +2:NaN +abc:NaN +&bone +2:+:1 +2:-:-1 +boneNaN:-:-1 +boneNaN:+:1 +2:abc:1 +3::1 +&binf +1:+:inf +2:-:-inf +3:abc:inf +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&blsft +abc:abc:NaN ++2:+2:8 ++1:+32:4294967296 ++1:+48:281474976710656 ++8:-2:NaN +# excercise base 10 ++12345:4:10:123450000 +-1234:0:10:-1234 ++1234:0:10:1234 ++2:2:10:200 ++12:2:10:1200 ++1234:-3:10:NaN +1234567890123:12:10:1234567890123000000000000 +&brsft +abc:abc:NaN ++8:+2:2 ++4294967296:+32:1 ++281474976710656:+48:1 ++2:-2:NaN +# excercise base 10 +-1234:0:10:-1234 ++1234:0:10:1234 ++200:2:10:2 ++1234:3:10:1 ++1234:2:10:12 ++1234:-3:10:NaN +310000:4:10:31 +12300000:5:10:123 +1230000000000:10:10:123 +09876123456789067890:12:10:9876123 +1234561234567890123:13:10:123456 +&bsstr +1e+34:1e+34 +123.456E3:123456e+0 +100:1e+2 +abc:NaN +&bneg +bnegNaN:NaN ++inf:-inf +-inf:inf +abd:NaN +0:0 +1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 +&babs +babsNaN:NaN ++inf:inf +-inf:inf +0:0 +1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 +&bcmp +bcmpNaN:bcmpNaN: +bcmpNaN:0: +0:bcmpNaN: +0:0:0 +-1:0:-1 +0:-1:1 +1:0:1 +0:1:-1 +-1:1:-1 +1:-1:1 +-1:-1:0 +1:1:0 +123:123:0 +123:12:1 +12:123:-1 +-123:-123:0 +-123:-12:-1 +-12:-123:1 +123:124:-1 +124:123:1 +-123:-124:1 +-124:-123:-1 +100:5:1 +-123456789:987654321:-1 ++123456789:-987654321:1 +-987654321:123456789:-1 +-inf:5432112345:-1 ++inf:5432112345:1 +-inf:-5432112345:-1 ++inf:-5432112345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 +5:inf:-1 +5:inf:-1 +-5:-inf:1 +-5:-inf:1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&binc +abc:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +&bdec +abc:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +&badd +abc:abc:NaN +abc:0:NaN ++0:abc:NaN ++inf:-inf:NaN +-inf:+inf:NaN ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN +0:0:0 +1:0:1 +0:1:1 +1:1:2 +-1:0:-1 +0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:987654321:1111111110 +-123456789:987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +#2:2.5:4.5^ +#-123:-1.5:-124.5^ +#-1.2:1:-0.2^ +&bsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:NaN +-inf:-inf:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +&bmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN +-inf:NaNmul:NaN ++inf:NaNmul:NaN ++inf:+inf:inf ++inf:-inf:-inf +-inf:+inf:-inf +-inf:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 +123456789123456789:0:0 +0:123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 +111:111:12321 +10101:10101:102030201 +1001001:1001001:1002003002001 +100010001:100010001:10002000300020001 +10000100001:10000100001:100002000030000200001 +11111111111:9:99999999999 +22222222222:9:199999999998 +33333333333:9:299999999997 +44444444444:9:399999999996 +55555555555:9:499999999995 +66666666666:9:599999999994 +77777777777:9:699999999993 +88888888888:9:799999999992 +99999999999:9:899999999991 ++25:+25:625 ++12345:+12345:152399025 ++99999:+11111:1111088889 +9999:10000:99990000 +99999:100000:9999900000 +999999:1000000:999999000000 +9999999:10000000:99999990000000 +99999999:100000000:9999999900000000 +999999999:1000000000:999999999000000000 +9999999999:10000000000:99999999990000000000 +99999999999:100000000000:9999999999900000000000 +999999999999:1000000000000:999999999999000000000000 +9999999999999:10000000000000:99999999999990000000000000 +99999999999999:100000000000000:9999999999999900000000000000 +999999999999999:1000000000000000:999999999999999000000000000000 +9999999999999999:10000000000000000:99999999999999990000000000000000 +99999999999999999:100000000000000000:9999999999999999900000000000000000 +999999999999999999:1000000000000000000:999999999999999999000000000000000000 +9999999999999999999:10000000000000000000:99999999999999999990000000000000000000 +&bdiv-list +100:20:5,0 +4095:4095:1,0 +-4095:-4095:1,0 +4095:-4095:-1,0 +-4095:4095:-1,0 +123:2:61,1 +9:5:1,4 +9:4:2,1 +# inf handling and general remainder +5:8:0.625,5 +0:8:0,0 +11:2:5,1 +11:-2:-5,-1 +-11:2:-5,1 +# see table in documentation in MBI +0:inf:0,0 +0:-inf:0,0 +5:inf:0,5 +5:-inf:0,5 +-5:inf:0,-5 +-5:-inf:0,-5 +inf:5:inf,0 +-inf:5:-inf,0 +inf:-5:-inf,0 +-inf:-5:inf,0 +5:5:1,0 +-5:-5:1,0 +inf:inf:NaN,NaN +-inf:-inf:NaN,NaN +-inf:inf:NaN,NaN +inf:-inf:NaN,NaN +8:0:inf,8 +inf:0:inf,inf +# exceptions to reminder rule +-8:0:-inf,-8 +-inf:0:-inf,-inf +0:0:NaN,NaN +&bdiv +abc:abc:NaN +abc:1:NaN +1:abc:NaN +0:0:NaN +# inf handling (see table in doc) +0:inf:0 +0:-inf:0 +5:inf:0 +5:-inf:0 +-5:inf:0 +-5:-inf:0 +inf:5:inf +-inf:5:-inf +inf:-5:-inf +-inf:-5:inf +5:5:1 +-5:-5:1 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN +8:0:inf +inf:0:inf +-8:0:-inf +-inf:0:-inf +0:0:NaN +11:2:5 +-11:-2:5 +-11:2:-5 +11:-2:-5 +0:1:0 +0:-1:0 +1:1:1 +-1:-1:1 +1:-1:-1 +-1:1:-1 +1:2:0.5^ +2:1:2 +1000000000:9:111111111 +2000000000:9:222222222 +3000000000:9:333333333 +4000000000:9:444444444 +5000000000:9:555555555 +6000000000:9:666666666 +7000000000:9:777777777 +8000000000:9:888888888 +9000000000:9:1000000000 +35500000:113:314159 +71000000:226:314159 +106500000:339:314159 +1000000000:3:333333333 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 +999999999999:9:111111111111 +999999999999:99:10101010101 +999999999999:999:1001001001 +999999999999:9999:100010001 +999999999999999:99999:10000100001 ++1111088889:99999:11111 +-5:-3:1 +-5:3:-1 +4:3:1 +4:-3:-1 +1:3:0.3333333333333333333333333333333333333333 +1:-3:-0.3333333333333333333333333333333333333333 +-2:-3:0.6666666666666666666666666666666666666667 +-2:3:-0.6666666666666666666666666666666666666667 +#8:5:1.6^ +#-8:5:-1.6^ +8:5:1 +-8:5:-1 +14:-3:-4 +-14:3:-4 +-14:-3:4 +14:3:4 +# bug in Calc with '99999' vs $BASE-1 +10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576 +12:24:0.5^ +&bmod +# inf handling, see table in doc +0:inf:0 +0:-inf:0 +5:inf:5 +5:-inf:5 +-5:inf:-5 +-5:-inf:-5 +inf:5:0 +-inf:5:0 +inf:-5:0 +-inf:-5:0 +5:5:0 +-5:-5:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN +8:0:8 +inf:0:inf +# exceptions to reminder rule +-inf:0:-inf +-8:0:-8 +0:0:NaN +abc:abc:NaN +abc:1:abc:NaN +1:abc:NaN +0:0:NaN +0:1:0 +1:0:1 +0:-1:0 +-1:0:-1 +1:1:0 +-1:-1:0 +1:-1:0 +-1:1:0 +1:2:1 +2:1:0 +1000000000:9:1 +2000000000:9:2 +3000000000:9:3 +4000000000:9:4 +5000000000:9:5 +6000000000:9:6 +7000000000:9:7 +8000000000:9:8 +9000000000:9:0 +35500000:113:33 +71000000:226:66 +106500000:339:99 +1000000000:3:1 +10:5:0 +100:4:0 +1000:8:0 +10000:16:0 +999999999999:9:0 +999999999999:99:0 +999999999999:999:0 +999999999999:9999:0 +999999999999999:99999:0 +-9:+5:1 ++9:-5:-1 +-9:-5:-4 +-5:3:1 +-2:3:1 +4:3:1 +1:3:1 +-5:-3:-2 +-2:-3:-2 +4:-3:-2 +1:-3:-2 +4095:4095:0 +100041000510123:3:0 +152403346:12345:4321 +9:5:4 +&bgcd +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 +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 +&band +abc:abc:NaN +abc:0:NaN +0:abc:NaN +1:2:0 +3:2:2 ++8:+2:0 ++281474976710656:0:0 ++281474976710656:1:0 ++281474976710656:+281474976710656:281474976710656 +-2:-3:-4 +-1:-1:-1 +-6:-6:-6 +-7:-4:-8 +-7:4:0 +-4:7:4 +# equal arguments are treated special, so also do some test with unequal ones +0xFFFF:0xFFFF:0x0xFFFF +0xFFFFFF:0xFFFFFF:0x0xFFFFFF +0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF +0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF +0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF +0xF0F0:0xF0F0:0x0xF0F0 +0x0F0F:0x0F0F:0x0x0F0F +0xF0F0F0:0xF0F0F0:0x0xF0F0F0 +0x0F0F0F:0x0F0F0F:0x0x0F0F0F +0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 +0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F +0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 +0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F +0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 +0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F +0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F +&bior +abc:abc:NaN +abc:0:NaN +0:abc:NaN +1:2:3 ++8:+2:10 ++281474976710656:0:281474976710656 ++281474976710656:1:281474976710657 ++281474976710656:281474976710656:281474976710656 +-2:-3:-1 +-1:-1:-1 +-6:-6:-6 +-7:4:-3 +-4:7:-1 +# equal arguments are treated special, so also do some test with unequal ones +0xFFFF:0xFFFF:0x0xFFFF +0xFFFFFF:0xFFFFFF:0x0xFFFFFF +0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF +0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF +0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF +0:0xFFFF:0x0xFFFF +0:0xFFFFFF:0x0xFFFFFF +0:0xFFFFFFFF:0x0xFFFFFFFF +0:0xFFFFFFFFFF:0x0xFFFFFFFFFF +0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF +0xFFFF:0:0x0xFFFF +0xFFFFFF:0:0x0xFFFFFF +0xFFFFFFFF:0:0x0xFFFFFFFF +0xFFFFFFFFFF:0:0x0xFFFFFFFFFF +0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF +0xF0F0:0xF0F0:0x0xF0F0 +0x0F0F:0x0F0F:0x0x0F0F +0xF0F0:0x0F0F:0x0xFFFF +0xF0F0F0:0xF0F0F0:0x0xF0F0F0 +0x0F0F0F:0x0F0F0F:0x0x0F0F0F +0x0F0F0F:0xF0F0F0:0x0xFFFFFF +0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 +0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F +0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF +0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 +0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F +0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF +0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 +0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F +0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF +0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF +&bxor +abc:abc:NaN +abc:0:NaN +0:abc:NaN +1:2:3 ++8:+2:10 ++281474976710656:0:281474976710656 ++281474976710656:1:281474976710657 ++281474976710656:281474976710656:0 +-2:-3:3 +-1:-1:0 +-6:-6:0 +-7:4:-3 +-4:7:-5 +4:-7:-3 +-4:-7:5 +# equal arguments are treated special, so also do some test with unequal ones +0xFFFF:0xFFFF:0 +0xFFFFFF:0xFFFFFF:0 +0xFFFFFFFF:0xFFFFFFFF:0 +0xFFFFFFFFFF:0xFFFFFFFFFF:0 +0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0 +0:0xFFFF:0x0xFFFF +0:0xFFFFFF:0x0xFFFFFF +0:0xFFFFFFFF:0x0xFFFFFFFF +0:0xFFFFFFFFFF:0x0xFFFFFFFFFF +0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF +0xFFFF:0:0x0xFFFF +0xFFFFFF:0:0x0xFFFFFF +0xFFFFFFFF:0:0x0xFFFFFFFF +0xFFFFFFFFFF:0:0x0xFFFFFFFFFF +0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF +0xF0F0:0xF0F0:0 +0x0F0F:0x0F0F:0 +0xF0F0:0x0F0F:0x0xFFFF +0xF0F0F0:0xF0F0F0:0 +0x0F0F0F:0x0F0F0F:0 +0x0F0F0F:0xF0F0F0:0x0xFFFFFF +0xF0F0F0F0:0xF0F0F0F0:0 +0x0F0F0F0F:0x0F0F0F0F:0 +0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF +0xF0F0F0F0F0:0xF0F0F0F0F0:0 +0x0F0F0F0F0F:0x0F0F0F0F0F:0 +0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF +0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0 +0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0 +0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF +&bnot +abc:NaN ++0:-1 ++8:-9 ++281474976710656:-281474976710657 +-1:0 +-2:1 +-12:11 +&digit +0:0:0 +12:0:2 +12:1:1 +123:0:3 +123:1:2 +123:2:1 +123:-1:1 +123:-2:2 +123:-3:3 +123456:0:6 +123456:1:5 +123456:2:4 +123456:3:3 +123456:4:2 +123456:5:1 +123456:-1:1 +123456:-2:2 +123456:-3:3 +100000:-3:0 +100000:0:0 +100000:1:0 +&mantissa +abc:NaN +1e4:1 +2e0:2 +123:123 +-1:-1 +-2:-2 ++inf:inf +-inf:-inf +&exponent +abc:NaN +1e4:4 +2e0:0 +123:0 +-1:0 +-2:0 +0:1 ++inf:inf +-inf:inf +&parts +abc:NaN,NaN +1e4:1,4 +2e0:2,0 +123:123,0 +-1:-1,0 +-2:-2,0 +0:0,1 ++inf:inf,inf +-inf:-inf,inf +&bfac +-1:NaN +NaNfac:NaN ++inf:NaN +-inf:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 +&bpow +abc:12:NaN +12:abc:NaN +0:0:1 +0:1:0 +0:2:0 +0:-1:NaN +0:-2:NaN +1:0:1 +1:1:1 +1:2:1 +1:3:1 +1:-1:1 +1:-2:1 +1:-3:1 +2:0:1 +2:1:2 +2:2:4 +2:3:8 +3:3:27 +2:-1:NaN +-2:-1:NaN +2:-2:NaN +-2:-2:NaN ++inf:1234500012:inf +-inf:1234500012:-inf ++inf:-12345000123:inf +-inf:-12345000123:-inf +# 1 ** -x => 1 / (1 ** x) +-1:0:1 +-2:0:1 +-1:1:-1 +-1:2:1 +-1:3:-1 +-1:4:1 +-1:5:-1 +-1:-1:-1 +-1:-2:1 +-1:-3:-1 +-1:-4:1 +10:2:100 +10:3:1000 +10:4:10000 +10:5:100000 +10:6:1000000 +10:7:10000000 +10:8:100000000 +10:9:1000000000 +10:20:100000000000000000000 +123456:2:15241383936 +&length +100:3 +10:2 +1:1 +0:1 +12345:5 +10000000000000000:17 +-123:3 +215960156869840440586892398248:30 +&bsqrt +145:12.04159457879229548012824103037860805243^ +144:12^ +143:11.95826074310139802112984075619561661399^ +16:4 +170:13.03840481040529742916594311485836883306^ +169:13 +168:12.96148139681572046193193487217599331541^ +4:2 +3:1.732050807568877293527446341505872366943^ +2:1.41421356237309504880168872420969807857^ +9:3 +12:3.464101615137754587054892683011744733886^ +256:16 +100000000:10000 +4000000000000:2000000 +152399026:12345.00004050222755607815159966235881398^ +152399025:12345 +152399024:12344.99995949777231103967404745303741942^ +1:1 +0:0 +-2:NaN +-123:NaN +Nan:NaN ++inf:NaN +&bround +$round_mode('trunc') +0:12:0 +NaNbround:12:NaN ++inf:12:inf +-inf:12:-inf +1234:0:1234 +1234:2:1200 +123456:4:123400 +123456:5:123450 +123456:6:123456 ++10123456789:5:10123000000 +-10123456789:5:-10123000000 ++10123456789:9:10123456700 +-10123456789:9:-10123456700 ++101234500:6:101234000 +-101234500:6:-101234000 +#+101234500:-4:101234000 +#-101234500:-4:-101234000 +$round_mode('zero') ++20123456789:5:20123000000 +-20123456789:5:-20123000000 ++20123456789:9:20123456800 +-20123456789:9:-20123456800 ++201234500:6:201234000 +-201234500:6:-201234000 +#+201234500:-4:201234000 +#-201234500:-4:-201234000 ++12345000:4:12340000 +-12345000:4:-12340000 +$round_mode('+inf') ++30123456789:5:30123000000 +-30123456789:5:-30123000000 ++30123456789:9:30123456800 +-30123456789:9:-30123456800 ++301234500:6:301235000 +-301234500:6:-301234000 +#+301234500:-4:301235000 +#-301234500:-4:-301234000 ++12345000:4:12350000 +-12345000:4:-12340000 +$round_mode('-inf') ++40123456789:5:40123000000 +-40123456789:5:-40123000000 ++40123456789:9:40123456800 +-40123456789:9:-40123456800 ++401234500:6:401234000 ++401234500:6:401234000 +#-401234500:-4:-401235000 +#-401234500:-4:-401235000 ++12345000:4:12340000 +-12345000:4:-12350000 +$round_mode('odd') ++50123456789:5:50123000000 +-50123456789:5:-50123000000 ++50123456789:9:50123456800 +-50123456789:9:-50123456800 ++501234500:6:501235000 +-501234500:6:-501235000 +#+501234500:-4:501235000 +#-501234500:-4:-501235000 ++12345000:4:12350000 +-12345000:4:-12350000 +$round_mode('even') ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601234000 +-601234500:6:-601234000 +#+601234500:-4:601234000 +#-601234500:-4:-601234000 +#-601234500:-9:0 +#-501234500:-9:0 +#-601234500:-8:0 +#-501234500:-8:0 ++1234567:7:1234567 ++1234567:6:1234570 ++12345000:4:12340000 +-12345000:4:-12340000 +&is_zero +0:1 +NaNzero:0 ++inf:0 +-inf:0 +123:0 +-1:0 +1:0 +&is_one +0:0 +NaNone:0 ++inf:0 +-inf:0 +1:1 +2:0 +-1:0 +-2:0 +# floor and ceil tests are pretty pointless in integer space...but play safe +&bfloor +0:0 +NaNfloor:NaN ++inf:inf +-inf:-inf +-1:-1 +-2:-2 +2:2 +3:3 +abc:NaN +&bceil +NaNceil:NaN ++inf:inf +-inf:-inf +0:0 +-1:-1 +-2:-2 +2:2 +3:3 +abc:NaN +&as_hex +128:0x80 +-128:-0x80 +0:0x0 +-0:0x0 +1:0x1 +0x123456789123456789:0x123456789123456789 ++inf:inf +-inf:-inf +NaNas_hex:NaN +&as_bin +128:0b10000000 +-128:-0b10000000 +0:0b0 +-0:0b0 +1:0b1 +0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101 ++inf:inf +-inf:-inf +NaNas_bin:NaN diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t new file mode 100644 index 0000000..297d526 --- /dev/null +++ b/lib/Math/BigInt/t/upgrade.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/upgrade.t//i; + if ($ENV{PERL_CORE}) + { + @INC = qw(../t/lib); # testing with the core distribution + } + unshift @INC, '../lib'; # for testing manually + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + + plan tests => 1991; + } + +use Math::BigInt upgrade => 'Math::BigFloat'; +use Math::BigFloat; + +use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup + $ECL $CL); +$class = "Math::BigInt"; +$CL = "Math::BigInt::Calc"; +$ECL = "Math::BigFloat"; + +ok (Math::BigInt->upgrade(),'Math::BigFloat'); + +require 'upgrade.inc'; # all tests here for sharing diff --git a/t/lib/Math/BigFloat/Subclass.pm b/t/lib/Math/BigFloat/Subclass.pm index ca9bbce..db8ccb7 100644 --- a/t/lib/Math/BigFloat/Subclass.pm +++ b/t/lib/Math/BigFloat/Subclass.pm @@ -12,7 +12,9 @@ use vars qw($VERSION @ISA $PACKAGE @ISA = qw(Exporter Math::BigFloat); -$VERSION = 0.02; +$VERSION = 0.03; + +use overload; # inherit overload from BigInt # Globals $accuracy = $precision = undef; diff --git a/t/lib/Math/BigInt/Subclass.pm b/t/lib/Math/BigInt/Subclass.pm index 03795da..0ec798b 100644 --- a/t/lib/Math/BigInt/Subclass.pm +++ b/t/lib/Math/BigInt/Subclass.pm @@ -13,7 +13,9 @@ use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK @ISA = qw(Exporter Math::BigInt); @EXPORT_OK = qw(bgcd); -$VERSION = 0.02; +$VERSION = 0.03; + +use overload; # inherit overload from BigInt # Globals $accuracy = $precision = undef;