From: Jarkko Hietaniemi Date: Fri, 12 Oct 2001 18:35:31 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.44 from Tels and X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee15d750d0fc6440f96c67c89ec14cd068bb13c5;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.44 from Tels and further fixes from John Peacock. p4raw-id: //depot/perl@12413 --- diff --git a/MANIFEST b/MANIFEST index 16fe167..3245867 100644 --- a/MANIFEST +++ b/MANIFEST @@ -852,8 +852,8 @@ lib/constant.t See if compile-time constants work lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions -lib/CPAN/t/Nox.t See if CPAN::Nox works lib/CPAN/t/loadme.t See if CPAN the module works +lib/CPAN/t/Nox.t See if CPAN::Nox works lib/CPAN/t/vcmp.t See if CPAN the module works lib/ctime.pl A ctime workalike lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) @@ -1019,10 +1019,14 @@ 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/bigfltpm.inc Shared tests for bigfltpm.t and subclass.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.t See if BigInt.pm works +lib/Math/BigInt/t/calling.t Test calling conventions +lib/Math/BigInt/t/Math/Subclass.pm Empty subclass of BigFloat for test lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode +lib/Math/BigInt/t/subclass.t Empty subclass test of BigFloat lib/Math/Complex.pm A Complex package lib/Math/Complex.t See if Math::Complex works lib/Math/Trig.pm A simple interface to complex trigonometry diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index dfd722c..0acd62a 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -11,7 +11,7 @@ package Math::BigFloat; -$VERSION = '1.21'; +$VERSION = '1.23'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -29,7 +29,7 @@ use Math::BigInt qw/objectify/; #@EXPORT = qw( ); use strict; -use vars qw/$AUTOLOAD $accuracy $precision $div_scale $rnd_mode/; +use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode/; my $class = "Math::BigFloat"; use overload @@ -49,23 +49,30 @@ my $NaNOK=1; # constant for easier life my $nan = 'NaN'; -# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' -$rnd_mode = 'even'; -$accuracy = undef; -$precision = undef; -$div_scale = 40; +# class constants, use Class->constant_name() to access +$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' +$accuracy = undef; +$precision = undef; +$div_scale = 40; # in case we call SUPER::->foo() and this wants to call modify() # sub modify () { 0; } { - # checks for AUTOLOAD + # valid method aliases for AUTOLOAD my %methods = map { $_ => 1 } qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm - fabs fneg fint fcmp fzero fnan finc fdec + fneg fint facmp fcmp fzero fnan finf finc fdec + fceil ffloor + /; + # valid method's that need to be hand-ed up (for AUTOLOAD) + my %hand_ups = map { $_ => 1 } + qw / is_nan is_inf is_negative is_positive + accuracy precision div_scale round_mode fabs babs /; - sub method_valid { return exists $methods{$_[0]||''}; } + sub method_alias { return exists $methods{$_[0]||''}; } + sub method_hand_up { return exists $hand_ups{$_[0]||''}; } } ############################################################################## @@ -97,11 +104,12 @@ sub new } # got string # handle '+inf', '-inf' first - if ($wanted =~ /^[+-]inf$/) + if ($wanted =~ /^[+-]?inf$/) { $self->{_e} = Math::BigInt->new(0); $self->{_m} = Math::BigInt->new(0); $self->{sign} = $wanted; + $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self->bnorm(); } #print "new string '$wanted'\n"; @@ -125,7 +133,7 @@ sub new #print "$wanted => $self->{sign} $self->{value}\n"; $self->bnorm(); # first normalize # if any of the globals is set, round to them and thus store them insid $self - $self->round($accuracy,$precision,$rnd_mode) + $self->round($accuracy,$precision,$class->round_mode) if defined $accuracy || defined $precision; return $self; } @@ -202,7 +210,9 @@ sub bstr # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to (non-scientific) string format. # internal format is always normalized (no leading zeros, "-0" => "+0") - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + #my $x = shift; my $class = ref($x) || $x; + #$x = $class->new(shift) unless ref($x); #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; @@ -272,7 +282,9 @@ sub bsstr # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + #my $x = shift; my $class = ref($x) || $x; + #$x = $class->new(shift) unless ref($x); #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; @@ -290,7 +302,7 @@ sub numify { # Make a number from a BigFloat object # simple return string and let Perl's atoi()/atof() handle the rest - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bsstr(); } @@ -377,21 +389,63 @@ sub bacmp # Returns one of undef, <0, =0, >0. (suitable for sort) # (BFLOAT or num_str, BFLOAT or num_str) return cond_code my ($self,$x,$y) = objectify(2,@_); - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - - # signs are ignored, so check length - # length(x) is length(m)+e aka length of non-fraction part - # the longer one is bigger - my $l = $x->length() - $y->length(); - #print "$l\n"; - return $l if $l != 0; - #print "equal lengths\n"; - - # if both are equal long, make full compare - # first compare only the mantissa - # if mantissa are equal, compare fractions + + # handle +-inf and NaN's + if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]/) + { + 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()); + } + + # shortcut + my $xz = $x->is_zero(); + my $yz = $y->is_zero(); + return 0 if $xz && $yz; # 0 <=> 0 + return -1 if $xz && !$yz; # 0 <=> +y + return 1 if $yz && !$xz; # +x <=> 0 + + # adjust so that exponents are equal + my $lxm = $x->{_m}->length(); + 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"; + return $l <=> 0 if $l != 0; - return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e}; + # lengths (corrected by exponent) are equal + # so make mantissa euqal length by padding with zero (shift left) + my $diff = $lxm - $lym; + my $xm = $x->{_m}; # not yet copy it + my $ym = $y->{_m}; + if ($diff > 0) + { + $ym = $y->{_m}->copy()->blsft($diff,10); + } + elsif ($diff < 0) + { + $xm = $x->{_m}->copy()->blsft(-$diff,10); + } + my $rc = $xm->bcmp($ym); + # $rc = -$rc if $x->{sign} eq '-'; # -124 < -123 + return $rc <=> 0; + +# # signs are ignored, so check length +# # length(x) is length(m)+e aka length of non-fraction part +# # the longer one is bigger +# my $l = $x->length() - $y->length(); +# #print "$l\n"; +# return $l if $l != 0; +# #print "equal lengths\n"; +# +# # if both are equal long, make full compare +# # first compare only the mantissa +# # if mantissa are equal, compare fractions +# +# return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e}; } sub badd @@ -481,20 +535,20 @@ sub bsub sub binc { # increment arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); - $x->badd($self->_one())->round($a,$p,$r); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + $x->badd($self->bone())->round($a,$p,$r); } sub bdec { # decrement arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); - $x->badd($self->_one('-'))->round($a,$p,$r); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + $x->badd($self->bone('-'))->round($a,$p,$r); } sub blcm { - # (BINT or num_str, BINT or num_str) return BINT + # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT # does not modify arguments, but returns new object # Lowest Common Multiplicator @@ -506,7 +560,7 @@ sub blcm sub bgcd { - # (BINT or num_str, BINT or num_str) return BINT + # (BFLOAT or num_str, BFLOAT or num_str) return BINT # does not modify arguments, but returns new object # GCD -- Euclids algorithm Knuth Vol 2 pg 296 @@ -518,8 +572,8 @@ sub bgcd sub is_zero { - # return true if arg (BINT or num_str) is zero (array '+', '0') - my $x = shift; $x = $class->new($x) unless ref $x; + # return true if arg (BFLOAT or num_str) is zero (array '+', '0') + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero(); return 0; @@ -527,33 +581,35 @@ sub is_zero sub is_one { - # return true if arg (BINT or num_str) is +1 (array '+', '1') + # return true if arg (BFLOAT or num_str) is +1 (array '+', '1') # or -1 if signis given - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); - my $sign = $_[2] || '+'; - return ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one()); + 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; } sub is_odd { - # return true if arg (BINT or num_str) is odd or false if even - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + # 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 ($x->{_e}->is_zero() && $x->{_m}->is_odd()); + return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_odd()); + return 0; } sub is_even { # return true if arg (BINT or num_str) is even or false if odd - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + 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 ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never + return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never + return 0; } sub bmul @@ -596,6 +652,7 @@ sub bdiv # (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem) my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + # x / +-inf => 0, reminder x return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero() if $y->{sign} =~ /^[+-]inf$/; @@ -610,23 +667,40 @@ sub bdiv ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign}) if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); - $y = $class->new($y) if ref($y) ne $class; # promote bigints + # promote BigInts and it's subclasses (except when already a BigFloat) + $y = $self->new($y) unless $y->isa('Math::BigFloat'); + + # old, broken way + # $y = $class->new($y) if ref($y) ne $self; # promote bigints # print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n"; # we need to limit the accuracy to protect against overflow - my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p + my $fallback = 0; - if (!defined $scale) + my $scale = 0; +# print "s=$scale a=",$a||'undef'," p=",$p||'undef'," r=",$r||'undef',"\n"; + my @params = $x->_find_round_parameters($a,$p,$r,$y); + + # no rounding at all, so must use fallback + if (scalar @params == 1) { # simulate old behaviour - $scale = $div_scale+1; # one more for proper riund - $a = $div_scale; # and round to it - $fallback = 1; # to clear a/p afterwards + $scale = $self->div_scale()+1; # at least one more for proper round + $params[1] = $self->div_scale(); # and round to it as accuracy + $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 } + # print "s=$scale a=",$params[1]||'undef'," p=",$params[2]||'undef'," f=$fallback\n"; my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length(); $scale = $lx if $lx > $scale; $scale = $ly if $ly > $scale; - #print "scale $scale $lx $ly\n"; +# print "scale $scale $lx $ly\n"; my $diff = $ly - $lx; $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx! @@ -637,40 +711,48 @@ sub bdiv # check for / +-1 ( +/- 1E0) if ($y->is_one()) { - return wantarray ? ($x,$self->bzero()) : $x; + return wantarray ? ($x,$self->bzero()) : $x; } + # calculate the result to $scale digits and then round it # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) + #$scale = 82; #print "self: $self x: $x ref(x) ", ref($x)," m: $x->{_m}\n"; - # my $scale_10 = 10 ** $scale; $x->{_m}->bmul($scale_10); $x->{_m}->blsft($scale,10); #print "m: $x->{_m} $y->{_m}\n"; $x->{_m}->bdiv( $y->{_m} ); # a/c #print "m: $x->{_m}\n"; - #print "e: $x->{_e} $y->{_e}",$scale,"\n"; + #print "e: $x->{_e} $y->{_e} ",$scale,"\n"; $x->{_e}->bsub($y->{_e}); # b-d #print "e: $x->{_e}\n"; $x->{_e}->bsub($scale); # correct for 10**scale #print "after div: m: $x->{_m} e: $x->{_e}\n"; $x->bnorm(); # remove trailing 0's - #print "after div: m: $x->{_m} e: $x->{_e}\n"; - $x->round($a,$p,$r); # then round accordingly + #print "after norm: m: $x->{_m} e: $x->{_e}\n"; + + # shortcut to not run trough _find_round_parameters again + if (defined $params[1]) + { + $x->bround($params[1],undef,$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; + $x->{_a} = undef; $x->{_p} = undef; } if (wantarray) { my $rem = $x->copy(); - $rem->bmod($y,$a,$p,$r); + $rem->bmod($y,$params[1],$params[2],$params[3]); if ($fallback) { # clear a/p after round, since user did not request it - $x->{_a} = undef; - $x->{_p} = undef; + $rem->{_a} = undef; $rem->{_p} = undef; } return ($x,$rem); } @@ -693,21 +775,21 @@ sub bsqrt { # calculate square root; this should probably # use a different test to see whether the accuracy we want is... - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN return $x if $x->{sign} eq '+inf'; # +inf return $x if $x->is_zero() || $x == 1; - # we need to limit the accuracy to protect against overflow - my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p + # we need to limit the accuracy to protect against overflow (ignore $p) + my ($scale) = $x->_scale_a($self->accuracy(),$self->round_mode,$a,$r); my $fallback = 0; if (!defined $scale) { # simulate old behaviour - $scale = $div_scale+1; # one more for proper riund - $a = $div_scale; # and round to it - $fallback = 1; # to clear a/p afterwards + $scale = $self->div_scale()+1; # one more for proper riund + $a = $self->div_scale(); # and round to it + $fallback = 1; # to clear a/p afterwards } my $lx = $x->{_m}->length(); $scale = $lx if $scale < $lx; @@ -720,28 +802,36 @@ sub bsqrt $lx = 1 if $lx < 1; my $gs = Math::BigFloat->new('1'. ('0' x $lx)); - # print "first guess: $gs (x $x) scale $scale\n"; +# print "first guess: $gs (x $x) scale $scale\n"; my $diff = $e; my $y = $x->copy(); my $two = Math::BigFloat->new(2); - $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts + # promote BigInts and it's subclasses (except when already a BigFloat) + $y = $self->new($y) unless $y->isa('Math::BigFloat'); + # old, broken way + # $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts + my $rem; # $scale = 2; while ($diff >= $e) { return $x->bnan() if $gs->is_zero(); - $r = $y->copy(); $r->bdiv($gs,$scale); - $x = ($r + $gs); - $x->bdiv($two,$scale); + $rem = $y->copy(); $rem->bdiv($gs,$scale); + #print "y $y gs $gs ($gs->{_a}) rem (y/gs)\n $rem\n"; + $x = ($rem + $gs); + #print "x $x rem $rem gs $gs gsa: $gs->{_a}\n"; + $x->bdiv($two,$scale); + #print "x $x (/2)\n"; $diff = $x->copy()->bsub($gs)->babs(); $gs = $x->copy(); } +# print "before $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n"; $x->round($a,$p,$r); +# print "after $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n"; if ($fallback) { # clear a/p after round, since user did not request it - $x->{_a} = undef; - $x->{_p} = undef; + $x->{_a} = undef; $x->{_p} = undef; } $x; } @@ -758,7 +848,7 @@ sub bpow return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; return $x->bone() if $y->is_zero(); return $x if $x->is_one() || $y->is_one(); - my $y1 = $y->as_number(); # make bigint + my $y1 = $y->as_number(); # make bigint (trunc) if ($x == -1) { # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1 @@ -791,17 +881,22 @@ sub bfround # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 means round to integer # expects and returns normalized numbers! - my $x = shift; $x = $class->new($x) unless ref $x; + my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); return $x if $x->modify('bfround'); - my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_); + my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_); return $x if !defined $scale; # no-op # never round a 0, +-inf, NaN return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero(); # print "MBF bfround $x to scale $scale mode $mode\n"; + # don't round if x already has lower precision + return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}); + + $x->{_p} = $scale; # remember round in any case + $x->{_a} = undef; # and clear A if ($scale < 0) { # print "bfround scale $scale e $x->{_e}\n"; @@ -812,7 +907,7 @@ sub bfround my $dad = -$x->{_e}; # digits after dot my $zad = 0; # zeros after dot $zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style - # print "scale $scale dad $dad zad $zad len $len\n"; + #print "scale $scale dad $dad zad $zad len $len\n"; # number bsstr len zad dad # 0.123 123e-3 3 0 3 @@ -824,15 +919,12 @@ sub bfround # do not round after/right of the $dad return $x if $scale > $dad; # 0.123, scale >= 3 => exit - # round to zero if rounding inside the $zad, but not for last zero like: - # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) - if ($scale < $zad) - { - return $x->bzero(); - } - if ($scale == $zad) # for 0.006, scale -2 and trunc + # round to zero if rounding inside the $zad, but not for last zero like: + # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) + return $x->bzero() if $scale < $zad; + if ($scale == $zad) # for 0.006, scale -3 and trunc { - $scale = -$len; + $scale = -$len-1; } else { @@ -855,12 +947,10 @@ sub bfround # calculate digits before dot my $dbt = $x->{_m}->length(); $dbt += $x->{_e} if $x->{_e}->sign() eq '-'; - if (($scale > $dbt) && ($dbt < 0)) - { - # if not enough digits before dot, round to zero - return $x->bzero(); - } - if (($scale >= 0) && ($dbt == 0)) + # 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 @@ -890,11 +980,20 @@ sub bfround sub bround { # accuracy: preserve $N digits, and overwrite the rest with 0's - my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_); - return $x if !defined $scale; # no-op + my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); + + die ('bround() needs positive accuracy') if ($_[0] || 0) < 0; + my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_); + return $x if !defined $scale; # no-op + return $x if $x->modify('bround'); + + # scale is now either $x->{_a}, $accuracy, or the user parameter + # test whether $x already has lower accuracy, do nothing in this case + # but do round if the accuracy is the same, since a math operation might + # want to round a number with A=5 to 5 digits afterwards again + return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0]; # print "bround $scale $mode\n"; # 0 => return all digits, scale < 0 makes no sense @@ -906,8 +1005,6 @@ sub bround # subtract the delta from scale, to simulate keeping the zeros # -5 +5 => 1; -10 +5 => -4 my $delta = $x->{_e} + $x->{_m}->length() + 1; - # removed by tlr, since causes problems with fraction tests: - # $scale += $delta if $delta < 0; # if we should keep more digits than the mantissa has, do nothing return $x if $x->{_m}->length() <= $scale; @@ -916,13 +1013,15 @@ sub bround $x->{_m}->{sign} = $x->{sign}; $x->{_m}->bround($scale,$mode); # round mantissa $x->{_m}->{sign} = '+'; # fix sign back + $x->{_a} = $scale; # remember rounding + $x->{_p} = undef; # and clear P $x->bnorm(); # del trailing zeros gen. by bround() } sub bfloor { # return integer less or equal then $x - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bfloor'); @@ -941,7 +1040,7 @@ sub bfloor sub bceil { # return integer greater or equal then $x - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bceil'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf @@ -960,7 +1059,7 @@ sub bceil sub DESTROY { - # going trough AUTOLOAD for every DESTROY is costly, so avoid it by empty sub + # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub } sub AUTOLOAD @@ -971,16 +1070,26 @@ sub AUTOLOAD $name =~ s/.*:://; # split package #print "$name\n"; - if (!method_valid($name)) + no strict 'refs'; + if (!method_alias($name)) { - #no strict 'refs'; - ## try one level up - #&{$class."::SUPER->$name"}(@_); - # delayed load of Carp and avoid recursion - require Carp; - Carp::croak ("Can't call $class\-\>$name, not a valid method"); + if (!defined $name) + { + # delayed load of Carp and avoid recursion + require Carp; + Carp::croak ("Can't call a method without name"); + } + # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() + if (!method_hand_up($name)) + { + # delayed load of Carp and avoid recursion + require Carp; + Carp::croak ("Can't call $class\-\>$name, not a valid method"); + } + # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() + $name =~ s/^f/b/; + return &{'Math::BigInt'."::$name"}(@_); } - no strict 'refs'; my $bname = $name; $bname =~ s/^f/b/; *{$class."\:\:$name"} = \&$bname; &$bname; # uses @_ @@ -989,22 +1098,28 @@ sub AUTOLOAD sub exponent { # return a copy of the exponent - my $self = shift; - $self = $class->new($self) unless ref $self; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $self->is_nan(); - return $self->{_e}->copy(); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+-]//; + return $self->new($s); # -inf, +inf => +inf + } + return $x->{_e}->copy(); } sub mantissa { # return a copy of the mantissa - my $self = shift; - $self = $class->new($self) unless ref $self; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $self->is_nan(); - my $m = $self->{_m}->copy(); # faster than going via bstr() - $m->bneg() if $self->{sign} eq '-'; + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+]//; + return $self->new($s); # -inf, +inf => +inf + } + my $m = $x->{_m}->copy(); # faster than going via bstr() + $m->bneg() if $x->{sign} eq '-'; return $m; } @@ -1012,33 +1127,24 @@ sub mantissa sub parts { # return a copy of both the exponent and the mantissa - my $self = shift; - $self = $class->new($self) unless ref $self; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return (bnan(),bnan()) if $self->is_nan(); - my $m = $self->{_m}->copy(); # faster than going via bstr() - $m->bneg() if $self->{sign} eq '-'; - return ($m,$self->{_e}->copy()); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//; + return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf + } + my $m = $x->{_m}->copy(); # faster than going via bstr() + $m->bneg() if $x->{sign} eq '-'; + return ($m,$x->{_e}->copy()); } ############################################################################## # private stuff (internal use only) -sub _one - { - # internal speedup, set argument to 1, or create a +/- 1 - my $self = shift; $self = ref($self) if ref($self); - my $x = {}; bless $x, $self; - $x->{_m} = Math::BigInt->new(1); - $x->{_e} = Math::BigInt->new(0); - $x->{sign} = shift || '+'; - return $x; - } - sub import { my $self = shift; - #print "import $self\n"; for ( my $i = 0; $i < @_ ; $i++ ) { if ( $_[$i] eq ':constant' ) @@ -1059,7 +1165,7 @@ sub bnorm { # adjust m and e so that m is smallest possible # round number according to accuracy and precision settings - my $x = shift; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -1068,10 +1174,14 @@ sub bnorm { $x->{_m}->brsft($zeros,10); $x->{_e} += $zeros; } - # for something like 0Ey, set y to 1 - $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero(); + # for something like 0Ey, set y to 1, and -0 => +0 + $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero(); + # this is to prevent automatically rounding when MBI's globals are set $x->{_m}->{_f} = MB_NEVER_ROUND; $x->{_e}->{_f} = MB_NEVER_ROUND; + # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround() + $x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef; + $x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef; return $x; # MBI bnorm is no-op } @@ -1081,7 +1191,7 @@ sub bnorm sub as_number { # return a bigint representation of this BigFloat number - my ($self,$x) = objectify(1,@_); + my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x); my $z; if ($x->{_e}->is_zero()) @@ -1105,8 +1215,11 @@ sub as_number sub length { - my $x = shift; $x = $class->new($x) unless ref $x; + my $x = shift; + my $class = ref($x) || $x; + $x = $class->new(shift) unless ref($x); + return 1 if $x->{_m}->is_zero(); my $len = $x->{_m}->length(); $len += $x->{_e} if $x->{_e}->sign() eq '+'; if (wantarray()) @@ -1341,8 +1454,8 @@ All rounding functions take as a second parameter a rounding mode from one of the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'. The default rounding mode is 'even'. By using -C<< Math::BigFloat::round_mode($rnd_mode); >> you can get and set the default -mode for subsequent rounding. The usage of C<$Math::BigFloat::$rnd_mode> is +C<< Math::BigFloat::round_mode($round_mode); >> you can get and set the default +mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is no longer supported. The second parameter to the round functions then overrides the default temporarily. diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index df7881c..8aab185 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -19,7 +19,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.42'; +$VERSION = '1.44'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub @@ -33,7 +33,7 @@ use Exporter; objectify _swap ); #@EXPORT = qw( ); -use vars qw/$rnd_mode $accuracy $precision $div_scale/; +use vars qw/$round_mode $accuracy $precision $div_scale/; use strict; # Inside overload, the first arg is always an object. If the original code had @@ -122,59 +122,116 @@ my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do low level math sub _core_lib () { return $CALC; } # for test suite -# Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' -$rnd_mode = 'even'; -$accuracy = undef; -$precision = undef; -$div_scale = 40; +$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' +$accuracy = undef; +$precision = undef; +$div_scale = 40; sub round_mode { + no strict 'refs'; # make Class->round_mode() work - my $self = shift || $class; - # shift @_ if defined $_[0] && $_[0] eq $class; + my $self = shift; + my $class = ref($self) || $self || __PACKAGE__; if (defined $_[0]) { my $m = shift; die "Unknown round mode $m" if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/; - $rnd_mode = $m; return; + ${"${class}::round_mode"} = $m; return $m; } - return $rnd_mode; + return ${"${class}::round_mode"}; + } + +sub div_scale + { + no strict 'refs'; + # make Class->round_mode() work + my $self = shift; + my $class = ref($self) || $self || __PACKAGE__; + if (defined $_[0]) + { + die ('div_scale must be greater than zero') if $_[0] < 0; + ${"${class}::div_scale"} = shift; + } + return ${"${class}::div_scale"}; } sub accuracy { - # $x->accuracy($a); ref($x) a - # $x->accuracy(); ref($x); - # Class::accuracy(); # not supported - #print "MBI @_ ($class)\n"; - my $x = shift; + # $x->accuracy($a); ref($x) $a + # $x->accuracy(); ref($x) + # Class->accuracy(); class + # Class->accuracy($a); class $a - die ("accuracy() needs reference to object as first parameter.") - if !ref $x; + my $x = shift; + my $class = ref($x) || $x || __PACKAGE__; + no strict 'refs'; + # need to set new value? if (@_ > 0) { - $x->{_a} = shift; - $x->round() if defined $x->{_a}; + my $a = shift; + die ('accuracy must not be zero') if defined $a && $a == 0; + if (ref($x)) + { + # $object->accuracy() or fallback to global + $x->bround($a) if defined $a; + $x->{_a} = $a; # set/overwrite, even if not rounded + $x->{_p} = undef; # clear P + } + else + { + # set global + ${"${class}::accuracy"} = $a; + } + return $a; # shortcut + } + + if (ref($x)) + { + # $object->accuracy() or fallback to global + return $x->{_a} || ${"${class}::accuracy"}; } - return $x->{_a}; + return ${"${class}::accuracy"}; } sub precision { - my $x = shift; + # $x->precision($p); ref($x) $p + # $x->precision(); ref($x) + # Class->precision(); class + # Class->precision($p); class $p - die ("precision() needs reference to object as first parameter.") - if !ref $x; + my $x = shift; + my $class = ref($x) || $x || __PACKAGE__; + no strict 'refs'; + # need to set new value? if (@_ > 0) { - $x->{_p} = shift; - $x->round() if defined $x->{_p}; + my $p = shift; + if (ref($x)) + { + # $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 + } + else + { + # set global + ${"${class}::precision"} = $p; + } + return $p; # shortcut } - return $x->{_p}; + + if (ref($x)) + { + # $object->precision() or fallback to global + return $x->{_p} || ${"${class}::precision"}; + } + return ${"${class}::precision"}; } sub _scale_a @@ -270,10 +327,10 @@ sub new my $self = {}; bless $self, $class; # handle '+inf', '-inf' first - if ($wanted =~ /^[+-]inf$/) + if ($wanted =~ /^[+-]?inf$/) { $self->{value} = $CALC->_zero(); - $self->{sign} = $wanted; + $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self; } # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign @@ -336,7 +393,7 @@ sub new $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/; #print "$wanted => $self->{sign}\n"; # if any of the globals is set, use them to round and store them inside $self - $self->round($accuracy,$precision,$rnd_mode) + $self->round($accuracy,$precision,$round_mode) if defined $accuracy || defined $precision; return $self; } @@ -418,7 +475,12 @@ sub bsstr # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") - my ($self,$x) = objectify(1,@_); +# print "bsstr $_[0] $_[1]\n"; +# my $x = shift; $class = ref($x) || $x; +# print "class $class $x (",ref($x),") $_[0]\n"; +# $x = $class->new(shift) if !ref($x); +# + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { @@ -435,7 +497,9 @@ sub bsstr sub bstr { # make a string from bigint object - my $x = shift; $x = $class->new($x) unless ref $x; + my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); + # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN @@ -461,11 +525,12 @@ sub numify sub sign { # return the sign of the number: +/-/NaN - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x->{sign}; } -sub round +sub _find_round_parameters { # After any operation or when calling round(), the result is rounded by # regarding the A & P from arguments, local parameters, or globals. @@ -482,18 +547,13 @@ sub round my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops) $self = new($self) unless ref($self); # if not object, make one - my $c = ref($args[0]); # find out class of argument + my $c = ref($self); # find out class of argument(s) unshift @args,$self; # add 'first' argument # leave bigfloat parts alone - return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0; + return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0; no strict 'refs'; - my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef; - if (!defined $aa) - { - $z = "$c\::precision"; $ap = $$z; - } # now pick $a or $p, but only if we have got "arguments" if ((!defined $a) && (!defined $p) && (@args > 0)) @@ -507,33 +567,59 @@ sub round { foreach (@args) { - # take the defined one, or if both defined, the one that is smaller - $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p); + # take the defined one, or if both defined, the one that is bigger + # -2 > -3, and 3 > 2 + $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } # if none defined, use globals (#2) if (!defined $p) { - $a = $aa; $p = $ap; # save the check: if !defined $a; + my $z = "$c\::accuracy"; my $a = $$z; + if (!defined $a) + { + $z = "$c\::precision"; $p = $$z; + } } } # endif !$a } # endif !$a || !$P && args > 0 - # for clearity, this is not merged at place (#2) + my @params = ($self); + if (defined $a || defined $p) + { +# print "r => ",$r||'r undef'," in $c\n"; + $r = $r || ${"$c\::round_mode"}; + die "Unknown round mode '$r'" + if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/; + push @params, ($a,$p,$r); + } + return @params; + } + +sub round + { + # round $self according to given parameters, or given second argument's + # parameters or global defaults + my $self = shift; + + my @params = $self->_find_round_parameters(@_); + return $self->bnorm() if @params == 1; # no-op + # now round, by calling fround or ffround: - if (defined $a) + if (defined $params[1]) { - $self->{_a} = $a; $self->bround($a,$r); + $self->bround($params[1],$params[3]); } - elsif (defined $p) + else { - $self->{_p} = $p; $self->bfround($p,$r); + $self->bfround($params[2],$params[3]); } - return $self->bnorm(); + return $self->bnorm(); # after round, normalize } sub bnorm { - # (num_str or BINT) return BINT + # (numstr or or BINT) return BINT # Normalize number -- no-op here + return Math::BigInt->new($_[0]) if !ref($_[0]); return $_[0]; } @@ -541,7 +627,8 @@ sub babs { # (BINT or num_str) return BINT # make number absolute, or return absolute BINT from string - my $x = shift; $x = $class->new($x) unless ref $x; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x if $x->modify('babs'); # post-normalized abs for internal use (does nothing for NaN) $x->{sign} =~ s/^-/+/; @@ -552,7 +639,8 @@ sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string - my $x = shift; $x = $class->new($x) unless ref $x; + 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(); @@ -692,8 +780,7 @@ sub bsub sub binc { # increment arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); - # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('binc'); $x->badd($self->__one())->round($a,$p,$r); } @@ -701,7 +788,7 @@ sub binc sub bdec { # decrement arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bdec'); $x->badd($self->__one('-'))->round($a,$p,$r); } @@ -775,59 +862,69 @@ sub bnot { # (num_str or BINT) return BINT # represent ~x as twos-complement number - my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); + return $x if $x->modify('bnot'); - $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday - $x; + $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday + return $x->round($a,$p,$r); } sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't $CALC->_is_zero($x->{value}); - #return $CALC->_is_zero($x->{value}); } sub is_nan { # return true if arg (BINT or num_str) is NaN - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} eq $nan); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} eq $nan; + return 0; } sub is_inf { # return true if arg (BINT or num_str) is +-inf - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - my $sign = shift || ''; + my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + + $sign = '' if !defined $sign; + return 0 if $sign !~ /^([+-]|)$/; - return $x->{sign} =~ /^[+-]inf$/ if $sign eq ''; - return $x->{sign} =~ /^[$sign]inf$/; + if ($sign eq '') + { + return 1 if ($x->{sign} =~ /^[+-]inf$/); + return 0; + } + $sign = quotemeta($sign.'inf'); + return 1 if ($x->{sign} =~ /^$sign$/); + return 0; } sub is_one { # return true if arg (BINT or num_str) is +1 # or -1 if sign is given - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - my $sign = shift || ''; $sign = '+' if $sign ne '-'; + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); + + $sign = '' if !defined $sign; $sign = '+' if $sign ne '-'; - return 0 if $x->{sign} ne $sign; + return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either return $CALC->_is_one($x->{value}); } sub is_odd { # return true when arg (BINT or num_str) is odd, false for even - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_odd($x->{value}); @@ -836,8 +933,8 @@ sub is_odd sub is_even { # return true when arg (BINT or num_str) is even, false for odd - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_even($x->{value}); @@ -846,15 +943,21 @@ sub is_even sub is_positive { # return true when arg (BINT or num_str) is positive (>= 0) - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} =~ /^\+/); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} =~ /^\+/; + return 0; } sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} =~ /^-/); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^-/); + return 0; } ############################################################################### @@ -943,15 +1046,15 @@ sub bdiv # call div here my $rem = $self->bzero(); $rem->{sign} = $y->{sign}; - #($x->{value},$rem->{value}) = div($x->{value},$y->{value}); ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value}); - # do not leave rest "-0"; + # do not leave reminder "-0"; # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0); $rem->{sign} = '+' if $CALC->_is_zero($rem->{value}); if (($x->{sign} eq '-') and (!$rem->is_zero())) { $x->bdec(); } +# print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n"; $x->round($a,$p,$r,$y); if (wantarray) { @@ -1200,7 +1303,7 @@ sub bxor sub length { - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); my $e = $CALC->_len($x->{value}); # # fallback, since we do not know the underlying representation @@ -1238,7 +1341,7 @@ sub _trailing_zeros sub bsqrt { - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN return $x->bzero() if $x->is_zero(); # 0 => 0 @@ -1266,9 +1369,13 @@ sub bsqrt sub exponent { # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $x->is_nan(); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+-]//; + return $self->new($s); # -inf,+inf => inf + } my $e = $class->bzero(); return $e->binc() if $x->is_zero(); $e += $x->_trailing_zeros(); @@ -1277,10 +1384,14 @@ sub exponent sub mantissa { - # return a copy of the mantissa (here always $self) - my ($self,$x) = objectify(1,@_); + # return the mantissa (compatible to Math::BigFloat, e.g. reduced) + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $x->is_nan(); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+]//; + return $self->new($s); # +inf => inf + } my $m = $x->copy(); # that's inefficient my $zeros = $m->_trailing_zeros(); @@ -1290,11 +1401,10 @@ sub mantissa sub parts { - # return a copy of both the exponent and the mantissa (here 0 and self) - my $self = shift; - $self = $class->new($self) unless ref $self; + # return a copy of both the exponent and the mantissa + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return ($self->mantissa(),$self->exponent()); + return ($x->mantissa(),$x->exponent()); } ############################################################################## @@ -1303,15 +1413,21 @@ sub parts sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' - # $n == 0 => round to integer + # $n == 0 || $n == 1 => round to integer my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_); + my ($scale,$mode) = $x->_scale_p($precision,$round_mode,@_); return $x if !defined $scale; # no-op # no-op for BigInts if $n <= 0 - return $x if $scale <= 0; + if ($scale <= 0) + { + $x->{_p} = $scale; return $x; + } $x->bround( $x->length()-$scale, $mode); + $x->{_a} = undef; # bround sets {_a} + $x->{_p} = $scale; # so correct it + $x; } sub _scan_for_nonzero @@ -1348,37 +1464,43 @@ sub bround # and overwrite the rest with 0's, return normalized number # do not return $x->bnorm(), but $x my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_); + my ($scale,$mode) = $x->_scale_a($accuracy,$round_mode,@_); return $x if !defined $scale; # no-op # print "MBI round: $x to $scale $mode\n"; - # -scale means what? tom? hullo? -$scale needed by MBF round, but what for? return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0; # we have fewer digits than we want to scale to my $len = $x->length(); - # print "$len $scale\n"; - return $x if $len < abs($scale); + # print "$scale $len\n"; + # scale < 0, but > -len (not >=!) + if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) + { + $x->{_a} = $scale if !defined $x->{_a}; # if not yet defined overwrite + return $x; + } # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6 my ($pad,$digit_round,$digit_after); $pad = $len - $scale; - $pad = abs($scale)+1 if $scale < 0; + $pad = abs($scale-1) if $scale < 0; + # do not use digit(), it is costly for binary => decimal #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len; #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0; + my $xs = $CALC->_str($x->{value}); my $pl = -$pad-1; + + # print "pad $pad pl $pl scale $scale len $len\n"; # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len; $pl++; $pl ++ if $pad >= $len; $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0; - - #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len; - #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0; - # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n"; + + # print "$pad $pl $$xs dr $digit_round da $digit_after\n"; # in case of 01234 we round down, for 6789 up, and only in case 5 we look # closer at the remaining digits of the original $x, remember decision @@ -1428,21 +1550,31 @@ sub bround { $x->bzero(); # round to '0' } - # print "res $pad $len $x $$xs\n"; + # print "res $pad $len $x $$xs\n"; } # move this later on after the inc of the string #$x->{value} = $CALC->_new($xs); # put back in if ($round_up) # what gave test above? { + #print " $pad => "; $pad = $len if $scale < 0; # tlr: whack 0.51=>1.0 # modify $x in place, undef, undef to avoid rounding # str creation much faster than 10 ** something + #print " $pad, $x => "; $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) ); + #print "$x\n"; # increment string in place, to avoid dec=>hex for the '1000...000' # $xs ...blah foo } # to here: #$x->{value} = $CALC->_new($xs); # put back in + + $x->{_a} = $scale if $scale >= 0; + if ($scale < 0) + { + $x->{_a} = $len+$scale; + $x->{_a} = 0 if $scale < -$len; + } $x; } @@ -1450,10 +1582,9 @@ sub bfloor { # return integer less or equal then number, since it is already integer, # always returns $self - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # not needed: return $x if $x->modify('bfloor'); - return $x->round($a,$p,$r); } @@ -1461,10 +1592,9 @@ sub bceil { # return integer greater or equal then number, since it is already integer, # always returns $self - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # not needed: return $x if $x->modify('bceil'); - return $x->round($a,$p,$r); } @@ -1530,7 +1660,17 @@ sub objectify # $class,1,2. (We can not take '1' as class ;o) # badd($class,1) is not supported (it should, eventually, try to add undef) # currently it tries 'Math::BigInt' + 1, which will not work. - + + # some shortcut for the common cases + + # $x->unary_op(); + return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); + # $x->binary_op($y); + #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2) + # && ref($_[1]) && ref($_[2]); + +# print "obj '",join ("' '", @_),"'\n"; + my $count = abs(shift || 0); #print caller(),"\n"; @@ -1575,6 +1715,7 @@ sub objectify #print "$count\n"; $count--; $k = shift; + # print "$k (",ref($k),") => \n"; if (!ref($k)) { $k = $a[0]->new($k); @@ -1584,6 +1725,7 @@ sub objectify # foreign object, try to convert to integer $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k); } + # print "$k (",ref($k),")\n"; push @a,$k; } push @a,@_; # return other params, too @@ -1810,10 +1952,9 @@ sub as_hex my $es = ''; my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; - $s .= '0x'; if ($CALC->can('_as_hex')) { - $es = $CALC->_as_hex($x->{value}); + $es = ${$CALC->_as_hex($x->{value})}; } else { @@ -1826,6 +1967,7 @@ sub as_hex } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros + $s .= '0x'; } $s . $es; } @@ -1840,10 +1982,9 @@ sub as_bin my $es = ''; my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; - $s .= '0b'; if ($CALC->can('_as_bin')) { - $es = $CALC->_as_bin($x->{value}); + $es = ${$CALC->_as_bin($x->{value})}; } else { @@ -1856,6 +1997,7 @@ sub as_bin } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros + $s .= '0b'; } $s . $es; } @@ -2008,7 +2150,7 @@ Math::BigInt - Arbitrary size integer math package # latter is always 0 digits long for BigInt's $x->exponent(); # return exponent as BigInt - $x->mantissa(); # return mantissa as BigInt + $x->mantissa(); # return (signed) mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->copy(); # make a true copy of $x (unlike $y = $x;) $x->as_number(); # return as BigInt (in BigInt: same as copy()) @@ -2019,7 +2161,6 @@ Math::BigInt - Arbitrary size integer math package $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b - =head1 DESCRIPTION All operators (inlcuding basic math operations) are overloaded if you @@ -2366,11 +2507,11 @@ This is how it works now: following rounding modes (R): 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' * you can set and get the global R by using Math::SomeClass->round_mode() - or by setting $Math::SomeClass::rnd_mode + or by setting $Math::SomeClass::round_mode * after each operation, $result->round() is called, and the result may eventually be rounded (that is, if A or P were set either locally, globally or as parameter to the operation) - * to manually round a number, call $x->round($A,$P,$rnd_mode); + * to manually round a number, call $x->round($A,$P,$round_mode); this will round the number by using the appropriate rounding function and then normalize it. * rounding modifies the local settings of the number: diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index ebaf5a1..a2b73e0 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.10'; +$VERSION = '0.12'; # Package to store unsigned big integers in decimal and do math with them @@ -19,7 +19,8 @@ $VERSION = '0.10'; # - fully remove funky $# stuff (maybe) # USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used -# instead of "/ 1e5" at some places, (marked with USE_MUL). +# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms +# BS2000, some Crays need USE_DIV instead. # The BEGIN block is used to determine which of the two variants gives the # correct result. @@ -29,9 +30,36 @@ $VERSION = '0.10'; # constants for easier life my $nan = 'NaN'; -my $BASE_LEN = 7; -my $BASE = int("1e".$BASE_LEN); # var for trying to change it to 1e7 -my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL +my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL); + +sub _base_len + { + my $b = shift; + if (defined $b) + { + $BASE_LEN = $b; + $BASE = int("1e".$BASE_LEN); + $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + $MAX_VAL = $BASE-1; + # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL\n"; + # print "int: ",int($BASE * $RBASE),"\n"; + if (int($BASE * $RBASE) == 0) # should be 1 + { + # must USE_MUL + # print "use mul\n"; + *{_mul} = \&_mul_use_mul; + *{_div} = \&_div_use_mul; + } + else + { + # print "use div\n"; + # can USE_DIV instead + *{_mul} = \&_mul_use_div; + *{_div} = \&_div_use_div; + } + } + $BASE_LEN-1; + } BEGIN { @@ -43,23 +71,10 @@ BEGIN $num = ('9' x ++$e) + 0; $num *= $num + 1; } until ($num == $num - 1 or $num - 1 == $num - 2); - $BASE_LEN = $e-1; - $BASE = int("1e".$BASE_LEN); - $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + _base_len($e-1); } # for quering and setting, to debug/benchmark things -sub _base_len - { - my $b = shift; - if (defined $b) - { - $BASE_LEN = $b; - $BASE = int("1e".$BASE_LEN); - $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL - } - $BASE_LEN; - } ############################################################################## # create objects from various representations @@ -208,7 +223,7 @@ sub _sub } } -sub _mul +sub _mul_use_mul { # (BINT, BINT) return nothing # multiply two numbers in internal representation @@ -252,7 +267,37 @@ sub _mul return $xv; } -sub _div +sub _mul_use_div + { + # (BINT, BINT) return nothing + # multiply two numbers in internal representation + # modifies first arg, second need not be different from first + my ($c,$xv,$yv) = @_; + + my @prod = (); my ($prod,$car,$cty,$xi,$yi); + # since multiplying $x with $x fails, make copy in this case + $yv = [@$xv] if "$xv" eq "$yv"; # same references? + for $xi (@$xv) + { + $car = 0; $cty = 0; + # looping through this if $xi == 0 is silly - so optimize it away! + $xi = (shift @prod || 0), next if $xi == 0; + for $yi (@$yv) + { + $prod = $xi * $yi + ($prod[$cty] || 0) + $car; + $prod[$cty++] = + $prod - ($car = int($prod / $BASE)) * $BASE; + } + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift @prod; + } + push @$xv, @prod; + __strip_zeros($xv); + # normalize (handled last to save check for $y->is_zero() + return $xv; + } + +sub _div_use_mul { # ref to array, ref to array, modify first array and return remainder if # in list context @@ -291,7 +336,8 @@ sub _div $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1)); + # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1)); + $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { @@ -341,6 +387,96 @@ sub _div return $x; } +sub _div_use_div + { + # ref to array, ref to array, modify first array and return remainder if + # in list context + # no longer handles sign + my ($c,$x,$yorg) = @_; + my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1); + + my (@d,$tmp,$q,$u2,$u1,$u0); + + $car = $bar = $prd = 0; + + my $y = [ @$yorg ]; + if (($dd = int($BASE/($y->[-1]+1))) != 1) + { + for $xi (@$x) + { + $xi = $xi * $dd + $car; + $xi -= ($car = int($xi / $BASE)) * $BASE; + } + push(@$x, $car); $car = 0; + for $yi (@$y) + { + $yi = $yi * $dd + $car; + $yi -= ($car = int($yi / $BASE)) * $BASE; + } + } + else + { + push(@$x, 0); + } + @q = (); ($v2,$v1) = @$y[-2,-1]; + $v2 = 0 unless $v2; + while ($#$x > $#$y) + { + ($u2,$u1,$u0) = @$x[-3..-1]; + $u2 = 0 unless $u2; + #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" + # if $v1 == 0; + # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1)); + $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); + --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); + if ($q) + { + ($car, $bar) = (0,0); + for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) + { + $prd = $q * $y->[$yi] + $car; + $prd -= ($car = int($prd / $BASE)) * $BASE; + $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + } + if ($x->[-1] < $car + $bar) + { + $car = 0; --$q; + for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) + { + $x->[$xi] -= $BASE + if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE)); + } + } + } + pop(@$x); unshift(@q, $q); + } + if (wantarray) + { + @d = (); + if ($dd != 1) + { + $car = 0; + for $xi (reverse @$x) + { + $prd = $car * $BASE + $xi; + $car = $prd - ($tmp = int($prd / $dd)) * $dd; + unshift(@d, $tmp); + } + } + else + { + @d = @$x; + } + @$x = @q; + __strip_zeros($x); + __strip_zeros(\@d); + return ($x,\@d); + } + @$x = @q; + __strip_zeros($x); + return $x; + } + ############################################################################## # shifts @@ -614,9 +750,9 @@ Math::BigInt::Calc - Pure Perl module to support Math::BigInt =head1 SYNOPSIS -Provides support for big integer calculations. Not intended -to be used by other modules. Other modules which export the -same functions can also be used to support Math::Bigint +Provides support for big integer calculations. Not intended to be used by other +modules (except Math::BigInt::Cached). Other modules which sport the same +functions can also be used to support Math::Bigint, like Math::BigInt::Pari. =head1 DESCRIPTION @@ -625,7 +761,7 @@ was rewritten to use library modules for core math routines. Any module which follows the same API as this can be used instead by using the following call: - use Math::BigInt lib => BigNum; + use Math::BigInt lib => 'libname'; =head1 EXPORT @@ -670,12 +806,19 @@ the use by Math::BigInt: return 0 for ok, otherwise error message as string The following functions are optional, and can be defined if the underlying lib -has a fast way to do them. If not defined, Math::BigInt will use a pure, but +has a fast way to do them. If undefined, Math::BigInt will use a pure, but slow, Perl way as fallback to emulate these: _from_hex(str) return ref to new object from ref to hexadecimal string _from_bin(str) return ref to new object from ref to binary string + _as_hex(str) return ref to scalar string containing the value as + unsigned hex string, with the '0x' prepended. + Leading zeros must be stripped. + _as_bin(str) Like as_hex, only as binary string containing only + zeros and ones. Leading zeros must be stripped and a + '0b' must be prepended. + _rsft(obj,N,B) shift object in base B by N 'digits' right _lsft(obj,N,B) shift object in base B by N 'digits' left @@ -737,7 +880,7 @@ Seperated from BigInt and shaped API with the help of John Peacock. =head1 SEE ALSO -L, L, L and -L. +L, L, L, +L, L and L. =cut diff --git a/lib/Math/BigInt/t/Math/Subclass.pm b/lib/Math/BigInt/t/Math/Subclass.pm new file mode 100644 index 0000000..c78731c --- /dev/null +++ b/lib/Math/BigInt/t/Math/Subclass.pm @@ -0,0 +1,45 @@ +#!/usr/bin/perl -w + +package Math::Subclass; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigFloat(1.23); +use vars qw($VERSION @ISA @EXPORT + @EXPORT_OK %EXPORT_TAGS $PACKAGE + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigFloat); + +%EXPORT_TAGS = ( 'all' => [ qw( +) ] ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@EXPORT = qw( +); +$VERSION = 0.01; + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +sub new +{ + my $proto = shift; + my $class = ref($proto) || $proto; + + my $value = shift || 0; # Set to 0 if not provided + my $decimal = shift; + my $radix = 0; + + # Store the floating point value + my $self = bless Math::BigFloat->new($value), $class; + $self->{'_custom'} = 1; # make sure this never goes away + return $self; +} + +1; diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc new file mode 100644 index 0000000..9599253 --- /dev/null +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -0,0 +1,1026 @@ +#include this file into another test for subclass testing... +while () + { + chop; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "fnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->finf('$args[1]');"; + } elsif ($f eq "fnan") { + $try .= "\$x->fnan();"; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->fstr();'; + } elsif ($f eq "fsstr") { + $try .= '$x->fsstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if a BigFloat is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "length") { + $try .= '$x->length();'; + } elsif ($f eq "exponent") { + # ->bstr() to see if a BigFloat is returned + $try .= '$x->exponent()->bstr();'; + } elsif ($f eq "mantissa") { + # ->bstr() to see if a BigFloat is returned + $try .= '$x->mantissa()->bstr();'; + } elsif ($f eq "fneg") { + $try .= '$x->bneg();'; + } elsif ($f eq "fnorm") { + $try .= '$x->fnorm();'; + } elsif ($f eq "bfloor") { + $try .= '$x->ffloor();'; + } elsif ($f eq "bceil") { + $try .= '$x->fceil();'; + } elsif ($f eq "is_zero") { + $try .= '$x->is_zero();'; + } elsif ($f eq "is_one") { + $try .= '$x->is_one();'; + } elsif ($f eq "is_positive") { + $try .= '$x->is_positive();'; + } elsif ($f eq "is_negative") { + $try .= '$x->is_negative();'; + } elsif ($f eq "is_odd") { + $try .= '$x->is_odd();'; + } elsif ($f eq "is_even") { + $try .= '$x->is_even();'; + } elsif ($f eq "as_number") { + $try .= '$x->as_number();'; + } elsif ($f eq "fabs") { + $try .= '$x->fabs();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->fround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->ffround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->fsqrt();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "fcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "facmp") { + $try .= '$x->facmp($y);'; + } elsif ($f eq "fpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "fadd") { + $try .= '$x + $y;'; + } elsif ($f eq "fsub") { + $try .= '$x - $y;'; + } elsif ($f eq "fmul") { + $try .= '$x * $y;'; + } elsif ($f eq "fdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); + if (ref($ans1) eq "$class") + { + #print $ans1->_trailing_zeros(),"\n"; + print "# Has trailing zeros after '$try'\n" + if !ok ($ans1->{_m}->_trailing_zeros(), 0); + } + } + } # end pattern or string + } + } # end while + +# check whether new() for BigInts destroys them ($y == 12 in this case) +$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); + +# all done + +############################################################################### +# 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'); + } + +__DATA__ +&fnorm +1:1 +-0:0 +fnormNaN:NaN ++inf:inf +-inf:-inf +123:123 +-123.4567:-123.4567 +&as_number +0:0 +1:1 +1.2:1 +2.345:2 +-2:-2 +-123.456:-123 +-200:-200 +&finf +1:+:inf +2:-:-inf +3:abc:inf +&numify +0:0e+1 ++1:1e+0 +1234:1234e+0 +NaN:NaN ++inf:inf +-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1234.567:1234567e-3 +&fstr ++inf:::inf +-inf:::-inf +abcfstr:::NaN +1234.567:9::1234.56700 +1234.567::-6:1234.567000 +12345:5::12345 +0.001234:6::0.00123400 +0.001234::-8:0.00123400 +0:4::0 +0::-4:0.0000 +&fnorm +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000: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 +123.456a:NaN +123.456:123.456 +0.01:0.01 +.002:0.002 ++.2:0.2 +-0.0003:-0.0003 +-.0000000004:-0.0000000004 +123456E2:12345600 +123456E-2:1234.56 +-123456E2:-12345600 +-123456E-2:-1234.56 +1e1:10 +2e-11:0.00000000002 +# excercise _split + .02e-1:0.002 + 000001:1 + -00001:-1 + -1:-1 + 000.01:0.01 + -000.0023:-0.0023 + 1.1e1:11 +-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 +&fpow +2:2:4 +1:2:1 +1:3:1 +-1:2:1 +-1:3:-1 +123.456:2:15241.383936 +2:-2:0.25 +2:-3:0.125 +128:-2:0.00006103515625 +abc:123.456:NaN +123.456:abc:NaN ++inf:123.45:inf +-inf:123.45:-inf ++inf:-123.45:inf +-inf:-123.45:-inf +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123.456789 +-123456.789:123456.789 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123.456789 +-123456.789:123456.789 +&fround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNfround:5:NaN ++10123456789:5:10123000000 +-10123456789:5:-10123000000 ++10123456789.123:5:10123000000 +-10123456789.123:5:-10123000000 ++10123456789:9:10123456700 +-10123456789:9:-10123456700 ++101234500:6:101234000 +-101234500:6:-101234000 +$round_mode = "zero" ++20123456789:5:20123000000 +-20123456789:5:-20123000000 ++20123456789.123:5:20123000000 +-20123456789.123:5:-20123000000 ++20123456789:9:20123456800 +-20123456789:9:-20123456800 ++201234500:6:201234000 +-201234500:6:-201234000 +$round_mode = "+inf" ++30123456789:5:30123000000 +-30123456789:5:-30123000000 ++30123456789.123:5:30123000000 +-30123456789.123:5:-30123000000 ++30123456789:9:30123456800 +-30123456789:9:-30123456800 ++301234500:6:301235000 +-301234500:6:-301234000 +$round_mode = "-inf" ++40123456789:5:40123000000 +-40123456789:5:-40123000000 ++40123456789.123:5:40123000000 +-40123456789.123:5:-40123000000 ++40123456789:9:40123456800 +-40123456789:9:-40123456800 ++401234500:6:401234000 +-401234500:6:-401235000 +$round_mode = "odd" ++50123456789:5:50123000000 +-50123456789:5:-50123000000 ++50123456789.123:5:50123000000 +-50123456789.123:5:-50123000000 ++50123456789:9:50123456800 +-50123456789:9:-50123456800 ++501234500:6:501235000 +-501234500:6:-501235000 +$round_mode = "even" ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601234000 +-601234500:6:-601234000 ++60123456789.0123:5:60123000000 +-60123456789.0123:5:-60123000000 +&ffround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNffround:5:NaN ++1.23:-1:1.2 ++1.234:-1:1.2 ++1.2345:-1:1.2 ++1.23:-2:1.23 ++1.234:-2:1.23 ++1.2345:-2:1.23 ++1.23:-3:1.230 ++1.234:-3:1.234 ++1.2345:-3:1.234 +-1.23:-1:-1.2 ++1.27:-1:1.2 +-1.27:-1:-1.2 ++1.25:-1:1.2 +-1.25:-1:-1.2 ++1.35:-1:1.3 +-1.35:-1:-1.3 +-0.0061234567890:-1:0.0 +-0.0061:-1:0.0 +-0.00612:-1:0.0 +-0.00612:-2:0.00 +-0.006:-1:0.0 +-0.006:-2:0.00 +-0.0006:-2:0.00 +-0.0006:-3:0.000 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:0 +0.41:0:0 +$round_mode = "zero" ++2.23:-1:/2.2(?:0{5}\d+)? +-2.23:-1:/-2.2(?:0{5}\d+)? ++2.27:-1:/2.(?:3|29{5}\d+) +-2.27:-1:/-2.(?:3|29{5}\d+) ++2.25:-1:/2.2(?:0{5}\d+)? +-2.25:-1:/-2.2(?:0{5}\d+)? ++2.35:-1:/2.(?:3|29{5}\d+) +-2.35:-1:/-2.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "+inf" ++3.23:-1:/3.2(?:0{5}\d+)? +-3.23:-1:/-3.2(?:0{5}\d+)? ++3.27:-1:/3.(?:3|29{5}\d+) +-3.27:-1:/-3.(?:3|29{5}\d+) ++3.25:-1:/3.(?:3|29{5}\d+) +-3.25:-1:/-3.2(?:0{5}\d+)? ++3.35:-1:/3.(?:4|39{5}\d+) +-3.35:-1:/-3.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "-inf" ++4.23:-1:/4.2(?:0{5}\d+)? +-4.23:-1:/-4.2(?:0{5}\d+)? ++4.27:-1:/4.(?:3|29{5}\d+) +-4.27:-1:/-4.(?:3|29{5}\d+) ++4.25:-1:/4.2(?:0{5}\d+)? +-4.25:-1:/-4.(?:3|29{5}\d+) ++4.35:-1:/4.(?:3|29{5}\d+) +-4.35:-1:/-4.(?:4|39{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "odd" ++5.23:-1:/5.2(?:0{5}\d+)? +-5.23:-1:/-5.2(?:0{5}\d+)? ++5.27:-1:/5.(?:3|29{5}\d+) +-5.27:-1:/-5.(?:3|29{5}\d+) ++5.25:-1:/5.(?:3|29{5}\d+) +-5.25:-1:/-5.(?:3|29{5}\d+) ++5.35:-1:/5.(?:3|29{5}\d+) +-5.35:-1:/-5.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "even" ++6.23:-1:/6.2(?:0{5}\d+)? +-6.23:-1:/-6.2(?:0{5}\d+)? ++6.27:-1:/6.(?:3|29{5}\d+) +-6.27:-1:/-6.(?:3|29{5}\d+) ++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) +-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) ++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) +-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +0.01234567:-3:0.012 +0.01234567:-4:0.0123 +0.01234567:-5:0.01235 +0.01234567:-6:0.012346 +0.01234567:-7:0.0123457 +0.01234567:-8:0.01234567 +0.01234567:-9:0.012345670 +0.01234567:-12:0.012345670000 +&fcmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++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 +-1.1:0:-1 ++0:-1.1:1 ++1.1:+0:1 ++0:+1.1:-1 ++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 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:1 +0:-0.1:1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:-1 +-0.1:0:-1 +0:0.0001234:-1 +0:-0.0001234:1 +0.0001234:0:1 +-0.0001234:0:-1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:-1 ++inf:5432112345:1 +-inf:-5432112345:-1 ++inf:-5432112345:1 +-inf:54321.12345:-1 ++inf:54321.12345:1 +-inf:-54321.12345:-1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&facmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:1 ++0:-1:-1 ++1:+0:1 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:-1:0 ++1:+1:0 +-1.1:0:1 ++0:-1.1:-1 ++1.1:+0:1 ++0:+1.1:-1 ++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 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:-1 +0:-0.1:-1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:1 +-0.1:0:1 +0:0.0001234:-1 +0:-0.0001234:-1 +0.0001234:0:1 +-0.0001234:0:1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:1 ++inf:5432112345:1 +-inf:-5432112345:1 ++inf:-5432112345:1 +-inf:54321.12345:1 ++inf:54321.12345:1 +-inf:-54321.12345:1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 +# return undef ++inf:facmpNaN: +facmpNaN:inf: +-inf:facmpNaN: +facmpNaN:-inf: +&fdec +fdecNaN:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +1.23:0.23 +-1.23:-2.23 +&finc +fincNaN:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +1.23:2.23 +-1.23:-0.23 +&fadd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:0 +-inf:+inf:0 ++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 +0.001234:0.0001234:0.0013574 +&fsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:0 +-inf:-inf:0 +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN: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 +&fmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-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 +6:120:720 +10:10000:100000 +&fdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:0.5 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:111111111.1111111111111111111111111111111 ++2000000000:+9:222222222.2222222222222222222222222222222 ++3000000000:+9:333333333.3333333333333333333333333333333 ++4000000000:+9:444444444.4444444444444444444444444444444 ++5000000000:+9:555555555.5555555555555555555555555555556 ++6000000000:+9:666666666.6666666666666666666666666666667 ++7000000000:+9:777777777.7777777777777777777777777777778 ++8000000000:+9:888888888.8888888888888888888888888888889 ++9000000000:+9:1000000000 ++35500000:+113:314159.2920353982300884955752212389380531 ++71000000:+226:314159.2920353982300884955752212389380531 ++106500000:+339:314159.2920353982300884955752212389380531 ++1000000000:+3:333333333.3333333333333333333333333333333 +2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 +$div_scale = 20 ++1000000000:+9:111111111.11111111111 ++2000000000:+9:222222222.22222222222 ++3000000000:+9:333333333.33333333333 ++4000000000:+9:444444444.44444444444 ++5000000000:+9:555555555.55555555556 ++6000000000:+9:666666666.66666666667 ++7000000000:+9:777777777.77777777778 ++8000000000:+9:888888888.88888888889 ++9000000000:+9:1000000000 +1:10:0.1 +1:100:0.01 +1:1000:0.001 +1:10000:0.0001 +1:504:0.001984126984126984127 +2:1.987654321:1.0062111801179738436 +# the next two cases are the "old" behaviour, but are now (>v0.01) different +#+35500000:+113:314159.292035398230088 +#+71000000:+226:314159.292035398230088 ++35500000:+113:314159.29203539823009 ++71000000:+226:314159.29203539823009 ++106500000:+339:314159.29203539823009 ++1000000000:+3:333333333.33333333333 +$div_scale = 1 +# round to accuracy 1 after bdiv ++124:+3:40 +# reset scale for further tests +$div_scale = 40 +&fmod ++0:0:NaN ++0:1:0 ++3:1:0 +#+5:2:1 +#+9:4:1 +#+9:5:4 +#+9000:56:40 +#+56:9000:56 +&fsqrt ++0:0 +-1:NaN +-2:NaN +-16:NaN +-123.45:NaN +nanfsqrt:NaN ++inf:inf +-inf:NaN ++1:1 ++2:1.41421356237309504880168872420969807857 ++4:2 ++16:4 ++100:10 ++123.456:11.11107555549866648462149404118219234119 ++15241.38393:123.4559999756998444766131352122991626468 ++1.44:1.2 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +&is_positive +0:1 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&parts +0:0 1 +1:1 0 +123:123 0 +-123:-123 0 +-1200:-12 2 +NaNparts:NaN NaN ++inf:inf inf +-inf:-inf inf +&exponent +0:1 +1:0 +123:0 +-123:0 +-1200:2 ++inf:inf +-inf:inf +NaNexponent:NaN +&mantissa +0:0 +1:1 +123:123 +-123:-123 +-1200:-12 ++inf:inf +-inf:-inf +NaNmantissa:NaN +&length +123:3 +-123:3 +0:1 +1:1 +12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +&bfloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +&bceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 0ee6ff3..dd85adc 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -6,908 +6,17 @@ use strict; BEGIN { $| = 1; - unshift @INC, '../lib'; # for running manually + unshift @INC, '../../lib'; # for running manually + my $location = $0; $location =~ s/bigfltpm.t//; + unshift @INC, $location; # to locate the testing files # chdir 't' if -d 't'; - plan tests => 1162; + plan tests => 1273; } use Math::BigInt; use Math::BigFloat; -my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup); -while () - { - chop; - $_ =~ s/#.*$//; # remove comments - $_ =~ s/\s+$//; # trailing spaces - next if /^$/; # skip empty lines & comments - if (s/^&//) - { - $f = $_; - } - elsif (/^\$/) - { - $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/; # rnd_mode, div_scale - # print "$setup\n"; - } - else - { - if (m|^(.*?):(/.+)$|) - { - $ans = $2; - @args = split(/:/,$1,99); - } - else - { - @args = split(/:/,$_,99); $ans = pop(@args); - } - $try = "\$x = new Math::BigFloat \"$args[0]\";"; - if ($f eq "fnorm") - { - $try .= "\$x;"; - } elsif ($f eq "binf") { - $try .= "\$x->binf('$args[1]');"; - } elsif ($f eq "bnan") { - $try .= "\$x->bnan();"; - } elsif ($f eq "numify") { - $try .= "\$x->numify();"; - } elsif ($f eq "bone") { - $try .= "\$x->bone('$args[1]');"; - } elsif ($f eq "bstr") { - $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; - $try .= '$x->bstr();'; - } elsif ($f eq "bsstr") { - $try .= '$x->bsstr();'; - } elsif ($f eq "parts") { - $try .= '($a,$b) = $x->parts(); "$a $b";'; - } elsif ($f eq "fneg") { - $try .= '$x->bneg();'; - } elsif ($f eq "bfloor") { - $try .= "\$x->bfloor();"; - } elsif ($f eq "bceil") { - $try .= "\$x->bceil();"; - } elsif ($f eq "is_zero") { - $try .= "\$x->is_zero()+0;"; - } elsif ($f eq "is_one") { - $try .= "\$x->is_one()+0;"; - } elsif ($f eq "is_positive") { - $try .= "\$x->is_positive()+0;"; - } elsif ($f eq "is_negative") { - $try .= "\$x->is_negative()+0;"; - } elsif ($f eq "is_odd") { - $try .= "\$x->is_odd()+0;"; - } elsif ($f eq "is_even") { - $try .= "\$x->is_even()+0;"; - } elsif ($f eq "as_number") { - $try .= "\$x->as_number();"; - } elsif ($f eq "fabs") { - $try .= '$x->babs();'; - } elsif ($f eq "finc") { - $try .= '++$x;'; - } elsif ($f eq "fdec") { - $try .= '--$x;'; - }elsif ($f eq "fround") { - $try .= "$setup; \$x->fround($args[1]);"; - } elsif ($f eq "ffround") { - $try .= "$setup; \$x->ffround($args[1]);"; - } elsif ($f eq "fsqrt") { - $try .= "$setup; \$x->fsqrt();"; - } - else - { - $try .= "\$y = new Math::BigFloat \"$args[1]\";"; - if ($f eq "fcmp") { - $try .= "\$x <=> \$y;"; - } elsif ($f eq "fpow") { - $try .= "\$x ** \$y;"; - } elsif ($f eq "fadd") { - $try .= "\$x + \$y;"; - } elsif ($f eq "fsub") { - $try .= "\$x - \$y;"; - } elsif ($f eq "fmul") { - $try .= "\$x * \$y;"; - } elsif ($f eq "fdiv") { - $try .= "$setup; \$x / \$y;"; - } elsif ($f eq "fmod") { - $try .= "\$x % \$y;"; - } else { warn "Unknown op '$f'"; } - } - $ans1 = eval $try; - if ($ans =~ m|^/(.*)$|) - { - my $pat = $1; - if ($ans1 =~ /$pat/) - { - ok (1,1); - } - else - { - print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); - } - } - else - { - if ($ans eq "") - { - ok_undef ($ans1); - } - else - { - print "# Tried: '$try'\n" if !ok ($ans1, $ans); - if (ref($ans1) eq 'Math::BigFloat') - { - #print $ans1->_trailing_zeros(),"\n"; - print "# Has trailing zeros after '$try'\n" - if !ok ($ans1->{_m}->_trailing_zeros(), 0); - } - } - } # end pattern or string - } - } # end while - -# check whether new() for BigInts destroys them ($y == 12 in this case) -$x = Math::BigInt->new(1200); $y = Math::BigFloat->new($x); -ok ($y,1200); ok ($x,1200); - -# all done - -############################################################################### -# 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'); - } +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); +$class = "Math::BigFloat"; -__END__ -&as_number -0:0 -1:1 -1.2:1 -2.345:2 --2:-2 --123.456:-123 --200:-200 -&binf -1:+:inf -2:-:-inf -3:abc:inf -&numify -0:0e+1 -+1:1e+0 -1234:1234e+0 -NaN:NaN -+inf:inf --inf:-inf -&bnan -abc:NaN -2:NaN --2:NaN -0:NaN -&bone -2:+:1 --2:-:-1 --2:+:1 -2:-:-1 -0::1 --2::1 -abc::1 -2:abc:1 -&bsstr -+inf:inf --inf:-inf -abcbsstr:NaN -1234.567:1234567e-3 -&bstr -+inf:::inf --inf:::-inf -abcbsstr:::NaN -1234.567:9::1234.56700 -1234.567::-6:1234.567000 -12345:5::12345 -0.001234:6::0.00123400 -0.001234::-8:0.00123400 -0:4::0 -0::-4:0.0000 -&fnorm -+inf:inf --inf:-inf -+infinity:NaN -+-inf:NaN -abc:NaN - 1 a:NaN -1bcd2:NaN -11111b:NaN -+1z:NaN --1z:NaN -0:0 -+0:0 -+00:0 -+0_0_0:0 -000000_0000000_00000: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 -123.456a:NaN -123.456:123.456 -0.01:0.01 -.002:0.002 -+.2:0.2 --0.0003:-0.0003 --.0000000004:-0.0000000004 -123456E2:12345600 -123456E-2:1234.56 --123456E2:-12345600 --123456E-2:-1234.56 -1e1:10 -2e-11:0.00000000002 -# excercise _split - .02e-1:0.002 - 000001:1 - -00001:-1 - -1:-1 - 000.01:0.01 - -000.0023:-0.0023 - 1.1e1:11 --3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 --4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 -&fpow -2:2:4 -1:2:1 -1:3:1 --1:2:1 --1:3:-1 -123.456:2:15241.383936 -2:-2:0.25 -2:-3:0.125 -128:-2:0.00006103515625 -abc:123.456:NaN -123.456:abc:NaN -+inf:123.45:inf --inf:123.45:-inf -+inf:-123.45:inf --inf:-123.45:-inf -&fneg -fnegNaN:NaN -+inf:-inf --inf:inf -+0:0 -+1:-1 --1:1 -+123456789:-123456789 --123456789:123456789 -+123.456789:-123.456789 --123456.789:123456.789 -&fabs -fabsNaN:NaN -+inf:inf --inf:inf -+0:0 -+1:1 --1:1 -+123456789:123456789 --123456789:123456789 -+123.456789:123.456789 --123456.789:123456.789 -&fround -$rnd_mode = "trunc" -+inf:5:inf --inf:5:-inf -0:5:0 -NaNfround:5:NaN -+10123456789:5:10123000000 --10123456789:5:-10123000000 -+10123456789.123:5:10123000000 --10123456789.123:5:-10123000000 -+10123456789:9:10123456700 --10123456789:9:-10123456700 -+101234500:6:101234000 --101234500:6:-101234000 -$rnd_mode = "zero" -+20123456789:5:20123000000 --20123456789:5:-20123000000 -+20123456789.123:5:20123000000 --20123456789.123:5:-20123000000 -+20123456789:9:20123456800 --20123456789:9:-20123456800 -+201234500:6:201234000 --201234500:6:-201234000 -$rnd_mode = "+inf" -+30123456789:5:30123000000 --30123456789:5:-30123000000 -+30123456789.123:5:30123000000 --30123456789.123:5:-30123000000 -+30123456789:9:30123456800 --30123456789:9:-30123456800 -+301234500:6:301235000 --301234500:6:-301234000 -$rnd_mode = "-inf" -+40123456789:5:40123000000 --40123456789:5:-40123000000 -+40123456789.123:5:40123000000 --40123456789.123:5:-40123000000 -+40123456789:9:40123456800 --40123456789:9:-40123456800 -+401234500:6:401234000 --401234500:6:-401235000 -$rnd_mode = "odd" -+50123456789:5:50123000000 --50123456789:5:-50123000000 -+50123456789.123:5:50123000000 --50123456789.123:5:-50123000000 -+50123456789:9:50123456800 --50123456789:9:-50123456800 -+501234500:6:501235000 --501234500:6:-501235000 -$rnd_mode = "even" -+60123456789:5:60123000000 --60123456789:5:-60123000000 -+60123456789:9:60123456800 --60123456789:9:-60123456800 -+601234500:6:601234000 --601234500:6:-601234000 -+60123456789.0123:5:60123000000 --60123456789.0123:5:-60123000000 -&ffround -$rnd_mode = "trunc" -+inf:5:inf --inf:5:-inf -0:5:0 -NaNffround:5:NaN -+1.23:-1:1.2 -+1.234:-1:1.2 -+1.2345:-1:1.2 -+1.23:-2:1.23 -+1.234:-2:1.23 -+1.2345:-2:1.23 -+1.23:-3:1.23 -+1.234:-3:1.234 -+1.2345:-3:1.234 --1.23:-1:-1.2 -+1.27:-1:1.2 --1.27:-1:-1.2 -+1.25:-1:1.2 --1.25:-1:-1.2 -+1.35:-1:1.3 --1.35:-1:-1.3 --0.0061234567890:-1:0 --0.0061:-1:0 --0.00612:-1:0 --0.00612:-2:0 --0.006:-1:0 --0.006:-2:0 --0.0006:-2:0 --0.0006:-3:0 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:0 -0.41:0:0 -$rnd_mode = "zero" -+2.23:-1:/2.2(?:0{5}\d+)? --2.23:-1:/-2.2(?:0{5}\d+)? -+2.27:-1:/2.(?:3|29{5}\d+) --2.27:-1:/-2.(?:3|29{5}\d+) -+2.25:-1:/2.2(?:0{5}\d+)? --2.25:-1:/-2.2(?:0{5}\d+)? -+2.35:-1:/2.(?:3|29{5}\d+) --2.35:-1:/-2.(?:3|29{5}\d+) --0.0065:-1:0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -$rnd_mode = "+inf" -+3.23:-1:/3.2(?:0{5}\d+)? --3.23:-1:/-3.2(?:0{5}\d+)? -+3.27:-1:/3.(?:3|29{5}\d+) --3.27:-1:/-3.(?:3|29{5}\d+) -+3.25:-1:/3.(?:3|29{5}\d+) --3.25:-1:/-3.2(?:0{5}\d+)? -+3.35:-1:/3.(?:4|39{5}\d+) --3.35:-1:/-3.(?:3|29{5}\d+) --0.0065:-1:0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-6e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:1 -0.51:0:1 -0.41:0:0 -$rnd_mode = "-inf" -+4.23:-1:/4.2(?:0{5}\d+)? --4.23:-1:/-4.2(?:0{5}\d+)? -+4.27:-1:/4.(?:3|29{5}\d+) --4.27:-1:/-4.(?:3|29{5}\d+) -+4.25:-1:/4.2(?:0{5}\d+)? --4.25:-1:/-4.(?:3|29{5}\d+) -+4.35:-1:/4.(?:3|29{5}\d+) --4.35:-1:/-4.(?:4|39{5}\d+) --0.0065:-1:0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.007|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -$rnd_mode = "odd" -+5.23:-1:/5.2(?:0{5}\d+)? --5.23:-1:/-5.2(?:0{5}\d+)? -+5.27:-1:/5.(?:3|29{5}\d+) --5.27:-1:/-5.(?:3|29{5}\d+) -+5.25:-1:/5.(?:3|29{5}\d+) --5.25:-1:/-5.(?:3|29{5}\d+) -+5.35:-1:/5.(?:3|29{5}\d+) --5.35:-1:/-5.(?:3|29{5}\d+) --0.0065:-1:0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.007|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:1 -0.51:0:1 -0.41:0:0 -$rnd_mode = "even" -+6.23:-1:/6.2(?:0{5}\d+)? --6.23:-1:/-6.2(?:0{5}\d+)? -+6.27:-1:/6.(?:3|29{5}\d+) --6.27:-1:/-6.(?:3|29{5}\d+) -+6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) --6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) -+6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) --6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) --0.0065:-1:0 --0.0065:-2:/-0\.01|-1e-02 --0.0065:-3:/-0\.006|-7e-03 --0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 --0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.05:0:0 -0.5:0:0 -0.51:0:1 -0.41:0:0 -0.01234567:-3:0.012 -0.01234567:-4:0.0123 -0.01234567:-5:0.01235 -0.01234567:-6:0.012346 -0.01234567:-7:0.0123457 -0.01234567:-8:0.01234567 -0.01234567:-9:0.01234567 -0.01234567:-12:0.01234567 -&fcmp -fcmpNaN:fcmpNaN: -fcmpNaN:+0: -+0:fcmpNaN: -+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 --1.1:0:-1 -+0:-1.1:1 -+1.1:+0:1 -+0:+1.1:-1 -+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 -0:0.01:-1 -0:0.0001:-1 -0:-0.0001:1 -0:-0.1:1 -0.1:0:1 -0.00001:0:1 --0.0001:0:-1 --0.1:0:-1 -0:0.0001234:-1 -0:-0.0001234:1 -0.0001234:0:1 --0.0001234:0:-1 -0.0001:0.0005:-1 -0.0005:0.0001:1 -0.005:0.0001:1 -0.001:0.0005:1 -0.000001:0.0005:-1 -0.00000123:0.0005:-1 -0.00512:0.0001:1 -0.005:0.000112:1 -0.00123:0.0005:1 -1.5:2:-1 -2:1.5:1 -1.54321:234:-1 -234:1.54321:1 -# infinity --inf:5432112345:-1 -+inf:5432112345:1 --inf:-5432112345:-1 -+inf:-5432112345:1 --inf:54321.12345:-1 -+inf:54321.12345:1 --inf:-54321.12345:-1 -+inf:-54321.12345:1 -+inf:+inf:0 --inf:-inf:0 -+inf:-inf:1 --inf:+inf:-1 -# return undef -+inf:NaN: -NaN:inf: --inf:NaN: -NaN:-inf: -&fdec -fdecNaN:NaN -+inf:inf --inf:-inf -+0:-1 -+1:0 --1:-2 -1.23:0.23 --1.23:-2.23 -&finc -fincNaN:NaN -+inf:inf --inf:-inf -+0:1 -+1:2 --1:0 -1.23:2.23 --1.23:-0.23 -&fadd -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:0 --inf:+inf:0 -+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 -0.001234:0.0001234:0.0013574 -&fsub -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:-inf:inf --inf:+inf:-inf -+inf:+inf:0 --inf:-inf:0 -baddNaN:+inf:NaN -baddNaN:+inf:NaN -+inf:baddNaN:NaN --inf:baddNaN: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 -&fmul -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+inf:NaNmul:NaN -+inf:NaNmul:NaN -NaNmul:+inf:NaN -NaNmul:-inf:NaN -+inf:+inf:inf -+inf:-inf:-inf -+inf:-inf:-inf -+inf:+inf:inf -+inf:123.34:inf -+inf:-123.34:-inf --inf:123.34:-inf --inf:-123.34:inf -123.34:+inf:inf --123.34:+inf:-inf -123.34:-inf:-inf --123.34:-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 -6:120:720 -10:10000:100000 -&fdiv -$div_scale = 40; $Math::BigFloat::rnd_mode = 'even' -abc:abc:NaN -abc:+1:abc:NaN -+1:abc:NaN --1:abc:NaN -0:abc:NaN -+0:+0:NaN -+0:+1:0 -+1:+0:inf -+3214:+0:inf -+0:-1:0 --1:+0:-inf --3214:+0:-inf -+1:+1:1 --1:-1:1 -+1:-1:-1 --1:+1:-1 -+1:+2:0.5 -+2:+1:2 -123:+inf:0 -123:-inf:0 -+10:+5:2 -+100:+4:25 -+1000:+8:125 -+10000:+16:625 -+10000:-16:-625 -+999999999999:+9:111111111111 -+999999999999:+99:10101010101 -+999999999999:+999:1001001001 -+999999999999:+9999:100010001 -+999999999999999:+99999:10000100001 -+1000000000:+9:111111111.1111111111111111111111111111111 -+2000000000:+9:222222222.2222222222222222222222222222222 -+3000000000:+9:333333333.3333333333333333333333333333333 -+4000000000:+9:444444444.4444444444444444444444444444444 -+5000000000:+9:555555555.5555555555555555555555555555556 -+6000000000:+9:666666666.6666666666666666666666666666667 -+7000000000:+9:777777777.7777777777777777777777777777778 -+8000000000:+9:888888888.8888888888888888888888888888889 -+9000000000:+9:1000000000 -+35500000:+113:314159.2920353982300884955752212389380531 -+71000000:+226:314159.2920353982300884955752212389380531 -+106500000:+339:314159.2920353982300884955752212389380531 -+1000000000:+3:333333333.3333333333333333333333333333333 -2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 -$div_scale = 20 -+1000000000:+9:111111111.11111111111 -+2000000000:+9:222222222.22222222222 -+3000000000:+9:333333333.33333333333 -+4000000000:+9:444444444.44444444444 -+5000000000:+9:555555555.55555555556 -+6000000000:+9:666666666.66666666667 -+7000000000:+9:777777777.77777777778 -+8000000000:+9:888888888.88888888889 -+9000000000:+9:1000000000 -1:10:0.1 -1:100:0.01 -1:1000:0.001 -1:10000:0.0001 -1:504:0.001984126984126984127 -2:1.987654321:1.0062111801179738436 -# the next two cases are the "old" behaviour, but are now (>v0.01) different -#+35500000:+113:314159.292035398230088 -#+71000000:+226:314159.292035398230088 -+35500000:+113:314159.29203539823009 -+71000000:+226:314159.29203539823009 -+106500000:+339:314159.29203539823009 -+1000000000:+3:333333333.33333333333 -$div_scale = 1 -# round to accuracy 1 after bdiv -+124:+3:40 -# reset scale for further tests -$div_scale = 40 -&fmod -+0:0:NaN -+0:1:0 -+3:1:0 -#+5:2:1 -#+9:4:1 -#+9:5:4 -#+9000:56:40 -#+56:9000:56 -&fsqrt -+0:0 --1:NaN --2:NaN --16:NaN --123.45:NaN -nanfsqrt:NaN -+inf:inf --inf:NaN -+1:1 -+2:1.41421356237309504880168872420969807857 -+4:2 -+16:4 -+100:10 -+123.456:11.11107555549866648462149404118219234119 -+15241.38393:123.4559999756998444766131352122991626468 -+1.44:1.2 -&is_odd -abc:0 -0:0 --1:1 --3:1 -1:1 -3:1 -1000001:1 -1000002:0 -+inf:0 --inf:0 -123.45:0 --123.45:0 -2:0 -&is_even -abc:0 -0:1 --1:0 --3:0 -1:0 -3:0 -1000001:0 -1000002:1 -2:1 -+inf:0 --inf:0 -123.456:0 --123.456:0 -&is_positive -0:1 -1:1 --1:0 --123:0 -NaN:0 --inf:0 -+inf:1 -&is_negative -0:0 -1:0 --1:1 --123:1 -NaN:0 --inf:1 -+inf:0 -&parts -0:0 1 -1:1 0 -123:123 0 --123:-123 0 --1200:-12 2 -&is_zero -NaNzero:0 -+inf:0 --inf:0 -0:1 --1:0 -1:0 -&is_one -NaNone:0 -+inf:0 --inf:0 -0:0 -2:0 -1:1 --1:0 --2:0 -&bfloor -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-52 -12.2:12 -&bceil -0:0 -abc:NaN -+inf:inf --inf:-inf -1:1 --51:-51 --51.2:-51 -12.2:13 +require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index e33e028..eb1b43f 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -8,9 +8,9 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 1447; + plan tests => 1457; } -my $version = '1.42'; # for $VERSION tests, match current release (by hand!) +my $version = '1.43'; # for $VERSION tests, match current release (by hand!) ############################################################################## # for testing inheritance of _swap @@ -72,25 +72,25 @@ while () $ans = pop(@args); $try = "\$x = Math::BigInt->new(\"$args[0]\");"; if ($f eq "bnorm"){ - # $try .= '$x+0;'; + $try = "\$x = Math::BigInt::bnorm(\"$args[0]\");"; } elsif ($f eq "is_zero") { - $try .= '$x->is_zero()+0;'; + $try .= '$x->is_zero();'; } elsif ($f eq "is_one") { - $try .= '$x->is_one()+0;'; + $try .= '$x->is_one();'; } elsif ($f eq "is_odd") { - $try .= '$x->is_odd()+0;'; + $try .= '$x->is_odd();'; } elsif ($f eq "is_even") { - $try .= '$x->is_even()+0;'; + $try .= '$x->is_even();'; } elsif ($f eq "is_negative") { - $try .= '$x->is_negative()+0;'; + $try .= '$x->is_negative();'; } elsif ($f eq "is_positive") { - $try .= '$x->is_positive()+0;'; + $try .= '$x->is_positive();'; } 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]')+0;"; + $try .= "\$x->is_inf('$args[1]');"; } elsif ($f eq "binf") { $try .= "\$x->binf('$args[1]');"; } elsif ($f eq "bone") { @@ -116,13 +116,16 @@ while () }elsif ($f eq "bsqrt") { $try .= '$x->bsqrt();'; }elsif ($f eq "length") { - $try .= "\$x->length();"; + $try .= '$x->length();'; }elsif ($f eq "exponent"){ + # ->bstr() to see if a BigInt is returned $try .= '$x = $x->exponent()->bstr();'; }elsif ($f eq "mantissa"){ + # ->bstr() to see if a BigInt is returned $try .= '$x = $x->mantissa()->bstr();'; }elsif ($f eq "parts"){ - $try .= "(\$m,\$e) = \$x->parts();"; + $try .= '($m,$e) = $x->parts();'; + # ->bstr() to see if a BigInt is returned $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;'; $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;'; $try .= '"$m,$e";'; @@ -133,19 +136,19 @@ while () }elsif ($f eq "bround") { $try .= "$round_mode; \$x->bround(\$y);"; }elsif ($f eq "bacmp"){ - $try .= "\$x->bacmp(\$y);"; + $try .= '$x->bacmp($y);'; }elsif ($f eq "badd"){ - $try .= "\$x + \$y;"; + $try .= '$x + $y;'; }elsif ($f eq "bsub"){ - $try .= "\$x - \$y;"; + $try .= '$x - $y;'; }elsif ($f eq "bmul"){ - $try .= "\$x * \$y;"; + $try .= '$x * $y;'; }elsif ($f eq "bdiv"){ - $try .= "\$x / \$y;"; + $try .= '$x / $y;'; }elsif ($f eq "bdiv-list"){ $try .= 'join (",",$x->bdiv($y));'; }elsif ($f eq "bmod"){ - $try .= "\$x % \$y;"; + $try .= '$x % $y;'; }elsif ($f eq "bgcd") { if (defined $args[2]) @@ -204,7 +207,7 @@ while () } else { - #print "try: $try ans: $ans1 $ans\n"; + # print "try: $try ans: $ans1 $ans\n"; print "# Tried: '$try'\n" if !ok ($ans1, $ans); } # check internal state of number objects @@ -483,9 +486,11 @@ ok ($args[4],7); ok (ref($args[4]),''); # test for floating-point input (other tests in bnorm() below) $z = 1050000000000000; # may be int on systems with 64bit? -$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13'); # not 1.03e+15 +$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13'); # not 1.05e+15 $z = 1e+129; # definitely a float (may fail on UTS) -$x = Math::BigInt->new($z); ok ($x->bsstr(),$z); +# don't compare to $z, since some Perl versions stringify $z into something +# like '1.e+129' or something equally ugly +$x = Math::BigInt->new($z); ok ($x->bsstr(),'1e+129'); ############################################################################### # prime number tests, also test for **= and length() @@ -534,11 +539,10 @@ ok (ref($x),'Math::Foo'); # Test whether +inf eq inf # This tried to test whether BigInt inf equals Perl inf. Unfortunately, Perl # hasn't (before 5.7.3 at least) a consistent way to say inf, and some things -# like 1e100000 crash on some platforms. So simple test for 'inf' +# like 1e100000 crash on some platforms. So simple test for the string 'inf' $x = Math::BigInt->new('+inf'); ok ($x,'inf'); -############################################################################### -# all tests done +### all tests done ############################################################ ############################################################################### # Perl 5.005 does not like ok ($x,undef) @@ -667,6 +671,7 @@ NaN:-inf: 0x1_2_3_4_56_78:305419896 0x_123:NaN # inf input +inf:inf +inf:inf -inf:-inf 0inf:NaN @@ -1047,6 +1052,7 @@ abc:+1:abc:NaN 4:-3:-2 123:+inf:0 123:-inf:0 +10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576 &bmod abc:abc:NaN abc:+1:abc:NaN @@ -1204,6 +1210,8 @@ abc:NaN 123:123 -1:-1 -2:-2 ++inf:inf +-inf:-inf &exponent abc:NaN 1e4:4 @@ -1212,6 +1220,8 @@ abc:NaN -1:0 -2:0 0:1 ++inf:inf +-inf:inf &parts abc:NaN,NaN 1e4:1,4 @@ -1220,6 +1230,8 @@ abc:NaN,NaN -1:-1,0 -2:-2,0 0:0,1 ++inf:inf,inf +-inf:-inf,inf &bpow abc:12:NaN 12:abc:NaN diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t new file mode 100644 index 0000000..4559d43 --- /dev/null +++ b/lib/Math/BigInt/t/calling.t @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +# test calling conventions + +use strict; +use Test; + +BEGIN + { + $| = 1; + # chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + plan tests => 100; + } + +package Math::BigInt::Test; + +use Math::BigInt; +use vars qw/@ISA/; +@ISA = qw/Math::BigInt/; # child of MBI +use overload; + +package Math::BigFloat::Test; + +use Math::BigFloat; +use vars qw/@ISA/; +@ISA = qw/Math::BigFloat/; # child of MBI +use overload; + +package main; + +use Math::BigInt; +use Math::BigFloat; + +my ($x,$y,$z,$u); + +############################################################################### +# check whether op's accept normal strings, even when inherited by subclasses + +# do one positive and one negative test to avoid false positives by "accident" + +my ($func,@args,$ans,$rc,$class,$try); +while () + { + chop; + next if /^#/; # skip comments + if (s/^&//) + { + $func = $_; + } + else + { + @args = split(/:/,$_,99); + $ans = pop @args; + foreach $class (qw/ + Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/) + { + $try = "$class\->$func('$args[0]');"; + $rc = eval $try; + print "# Tried: '$try'\n" if !ok ($rc, $ans); + } + } + + } + +# all done + +############################################################################### +# 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'); + } + +__END__ +&is_zero +1:0 +0:1 +&is_one +1:1 +0:0 +&is_positive +1:1 +-1:0 +&is_negative +1:0 +-1:1 +&is_nan +abc:1 +1:0 +&is_inf +inf:1 +0:0 +&bstr +5:5 +10:10 +abc:NaN ++inf:inf +-inf:-inf +&bsstr +1:1e+0 +0:0e+1 +2:2e+0 +200:2e+2 +&babs +-1:1 +1:1 +&bnot +-2:1 +1:-2 diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index 51cf41b..e5b6f36 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -1,6 +1,7 @@ #!/usr/bin/perl -w -# test accuracy, precicion and fallback, round_mode +# test rounding, accuracy, precicion and fallback, round_mode and mixing +# of classes use strict; use Test; @@ -10,9 +11,59 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 103; + plan tests => 246; } +# for finding out whether round finds correct class +package Foo; + +use Math::BigInt; +use vars qw/@ISA $precision $accuracy $div_scale $round_mode/; +@ISA = qw/Math::BigInt/; + +$precision = 6; +$accuracy = 8; +$div_scale = 5; +$round_mode = 'odd'; + +sub new + { + my $class = shift; + my $self = { _a => undef, _p => undef, value => 5 }; + bless $self, $class; + } + +sub bstr + { + my $self = shift; + + return "$self->{value}"; + } + +# these will be called with the rounding precision or accuracy, depending on +# class +sub bround + { + my ($self,$a,$r) = @_; + $self->{value} = 'a' x $a; + return $self; + } + +sub bnorm + { + my $self = shift; + return $self; + } + +sub bfround + { + my ($self,$p,$r) = @_; + $self->{value} = 'p' x $p; + return $self; + } + +package main; + use Math::BigInt; use Math::BigFloat; @@ -23,14 +74,45 @@ my ($x,$y,$z,$u); ok_undef ($Math::BigInt::accuracy); ok_undef ($Math::BigInt::precision); +ok_undef (Math::BigInt->accuracy()); +ok_undef (Math::BigInt->precision()); ok ($Math::BigInt::div_scale,40); +ok (Math::BigInt::div_scale(),40); +ok ($Math::BigInt::round_mode,'even'); ok (Math::BigInt::round_mode(),'even'); -ok ($Math::BigInt::rnd_mode,'even'); ok_undef ($Math::BigFloat::accuracy); ok_undef ($Math::BigFloat::precision); +ok_undef (Math::BigFloat->accuracy()); +ok_undef (Math::BigFloat->precision()); ok ($Math::BigFloat::div_scale,40); -ok ($Math::BigFloat::rnd_mode,'even'); +ok (Math::BigFloat::div_scale(),40); +ok ($Math::BigFloat::round_mode,'even'); +ok (Math::BigFloat::round_mode(),'even'); + +# accessors +foreach my $class (qw/Math::BigInt Math::BigFloat/) + { + ok_undef ($class->accuracy()); + ok_undef ($class->precision()); + ok ($class->round_mode(),'even'); + ok ($class->div_scale(),40); + + ok ($class->div_scale(20),20); + $class->div_scale(40); ok ($class->div_scale(),40); + + ok ($class->round_mode('odd'),'odd'); + $class->round_mode('even'); ok ($class->round_mode(),'even'); + + ok ($class->accuracy(2),2); + $class->accuracy(3); ok ($class->accuracy(),3); + ok_undef ($class->accuracy(undef)); + + ok ($class->precision(2),2); + ok ($class->precision(-2),-2); + $class->precision(3); ok ($class->precision(),3); + ok_undef ($class->precision(undef)); + } # accuracy foreach (qw/5 42 -1 0/) @@ -61,12 +143,12 @@ foreach (qw/5 42 1/) # round_mode foreach (qw/odd even zero trunc +inf -inf/) { - ok ($Math::BigFloat::rnd_mode = $_,$_); - ok ($Math::BigInt::rnd_mode = $_,$_); + ok ($Math::BigFloat::round_mode = $_,$_); + ok ($Math::BigInt::round_mode = $_,$_); } -$Math::BigFloat::rnd_mode = 4; -ok ($Math::BigFloat::rnd_mode,4); -ok ($Math::BigInt::rnd_mode,'-inf'); # from above +$Math::BigFloat::round_mode = 'zero'; +ok ($Math::BigFloat::round_mode,'zero'); +ok ($Math::BigInt::round_mode,'-inf'); # from above $Math::BigInt::accuracy = undef; $Math::BigInt::precision = undef; @@ -138,9 +220,22 @@ $y = $x->copy()->round(undef,2); ok ($y->precision(),2); ok_undef ($y->accuracy()); # P has precedence, so A still unset +# see if setting A clears P and vice versa +$x = Math::BigFloat->new(123.4567); +ok ($x,123.4567); +ok ($x->accuracy(4),4); +ok ($x->precision(-2),-2); # clear A +ok_undef ($x->accuracy()); + +$x = Math::BigFloat->new(123.4567); +ok ($x,123.4567); +ok ($x->precision(-2),-2); +ok ($x->accuracy(4),4); # clear P +ok_undef ($x->precision()); + # does copy work? $x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2); -$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2); +$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2); ############################################################################### # test wether operations round properly afterwards @@ -157,6 +252,7 @@ $z = $y - $x; ok ($z,530.9); $z = $y * $x; ok ($z,80780); $z = $x ** 2; ok ($z,15241); $z = $x * $x; ok ($z,15241); + # not: $z = -$x; ok ($z,-123.46); ok ($x,123.456); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62); $x = Math::BigFloat->new(123456); $x->{_a} = 4; @@ -175,6 +271,18 @@ $z = $x ** 2; ok ($z,15241000000); $z = $x->copy; $z++; ok ($z,123460); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000); +$x = Math::BigInt->new(123400); $x->{_a} = 4; +ok ($x->bnot(),-123400); # not -1234001 + +# both babs() and bneg() don't need to round, since the input will already +# be rounded (either as $x or via new($string)), and they don't change the +# value +# The two tests below peek at this by using _a illegally +$x = Math::BigInt->new(-123401); $x->{_a} = 4; +ok ($x->babs(),123401); +$x = Math::BigInt->new(-123401); $x->{_a} = 4; +ok ($x->bneg(),123401); + ############################################################################### # test mixed arguments @@ -199,6 +307,229 @@ $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5); # $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt'); # $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt'); +############################################################################### +# rounding in bdiv with fallback and already set A or P + +$Math::BigFloat::accuracy = undef; +$Math::BigFloat::precision = undef; +$Math::BigFloat::div_scale = 40; + +$x = Math::BigFloat->new(10); $x->{_a} = 4; +ok ($x->bdiv(3),'3.333'); +ok ($x->{_a},4); # set's it since no fallback + +$x = Math::BigFloat->new(10); $x->{_a} = 4; $y = Math::BigFloat->new(3); +ok ($x->bdiv($y),'3.333'); +ok ($x->{_a},4); # set's it since no fallback + +# rounding to P of x +$x = Math::BigFloat->new(10); $x->{_p} = -2; +ok ($x->bdiv(3),'3.33'); + +# round in div with requested P +$x = Math::BigFloat->new(10); +ok ($x->bdiv(3,undef,-2),'3.33'); + +# round in div with requested P greater than fallback +$Math::BigFloat::div_scale = 5; +$x = Math::BigFloat->new(10); +ok ($x->bdiv(3,undef,-8),'3.33333333'); +$Math::BigFloat::div_scale = 40; + +$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_a} = 4; +ok ($x->bdiv($y),'3.333'); +ok ($x->{_a},4); ok ($y->{_a},4); # set's it since no fallback +ok_undef ($x->{_p}); ok_undef ($y->{_p}); + +# rounding to P of y +$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_p} = -2; +ok ($x->bdiv($y),'3.33'); +ok ($x->{_p},-2); + ok ($y->{_p},-2); +ok_undef ($x->{_a}); ok_undef ($y->{_a}); + +############################################################################### +# test whether bround(-n) fails in MBF (undocumented in MBI) +eval { $x = Math::BigFloat->new(1); $x->bround(-2); }; +ok ($@ =~ /^bround\(\) needs positive accuracy/,1); + +# test whether rounding to higher accuracy is no-op +$x = Math::BigFloat->new(1); $x->{_a} = 4; +ok ($x,'1.000'); +$x->bround(6); # must be no-op +ok ($x->{_a},4); +ok ($x,'1.000'); + +$x = Math::BigInt->new(1230); $x->{_a} = 3; +ok ($x,'1230'); +$x->bround(6); # must be no-op +ok ($x->{_a},3); +ok ($x,'1230'); + +# bround(n) should set _a +$x->bround(2); # smaller works +ok ($x,'1200'); +ok ($x->{_a},2); + +# bround(-n) is undocumented and only used by MBF +# bround(-n) should set _a +$x = Math::BigInt->new(12345); +$x->bround(-1); +ok ($x,'12300'); +ok ($x->{_a},4); + +# bround(-n) should set _a +$x = Math::BigInt->new(12345); +$x->bround(-2); +ok ($x,'12000'); +ok ($x->{_a},3); + +# bround(-n) should set _a +$x = Math::BigInt->new(12345); $x->{_a} = 5; +$x->bround(-3); +ok ($x,'10000'); +ok ($x->{_a},2); + +# bround(-n) should set _a +$x = Math::BigInt->new(12345); $x->{_a} = 5; +$x->bround(-4); +ok ($x,'00000'); +ok ($x->{_a},1); + +# bround(-n) should be noop if n too big +$x = Math::BigInt->new(12345); +$x->bround(-5); +ok ($x,'0'); # scale to "big" => 0 +ok ($x->{_a},0); + +# bround(-n) should be noop if n too big +$x = Math::BigInt->new(54321); +$x->bround(-5); +ok ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000 +ok ($x->{_a},0); + +# bround(-n) should be noop if n too big +$x = Math::BigInt->new(54321); $x->{_a} = 5; +$x->bround(-6); +ok ($x,'100000'); # no-op +ok ($x->{_a},0); + +# bround(n) should set _a +$x = Math::BigInt->new(12345); $x->{_a} = 5; +$x->bround(5); # must be no-op +ok ($x,'12345'); +ok ($x->{_a},5); + +# bround(n) should set _a +$x = Math::BigInt->new(12345); $x->{_a} = 5; +$x->bround(6); # must be no-op +ok ($x,'12345'); + +$x = Math::BigFloat->new(0.0061); $x->bfround(-2); +ok ($x,0.01); + +############################################################################### +# rounding with already set precision/accuracy + +$x = Math::BigFloat->new(1); $x->{_p} = -5; +ok ($x,'1.00000'); + +# further rounding donw +ok ($x->bfround(-2),'1.00'); +ok ($x->{_p},-2); + +$x = Math::BigFloat->new(12345); $x->{_a} = 5; +ok ($x->bround(2),'12000'); +ok ($x->{_a},2); + +$x = Math::BigFloat->new(1.2345); $x->{_a} = 5; +ok ($x->bround(2),'1.2'); +ok ($x->{_a},2); + +# mantissa/exponent format and A/P +$x = Math::BigFloat->new(12345.678); $x->accuracy(4); +ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p}); +ok ($x->{_m}->{_f},1); ok ($x->{_e}->{_f},1); +ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a}); +ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p}); + +# check for no A/P in case of fallback +# result +$x = Math::BigFloat->new(100) / 3; +ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +# result & reminder +$x = Math::BigFloat->new(100) / 3; ($x,$y) = $x->bdiv(3); +ok_undef ($x->{_a}); ok_undef ($x->{_p}); +ok_undef ($y->{_a}); ok_undef ($y->{_p}); + +############################################################################### +# math with two numbers with differen A and P + +$x = Math::BigFloat->new(12345); $x->accuracy(4); # '12340' +$y = Math::BigFloat->new(12345); $y->accuracy(2); # '12000' +ok ($x+$y,24000); # 12340+12000=> 24340 => 24000 + +$x = Math::BigFloat->new(54321); $x->accuracy(4); # '12340' +$y = Math::BigFloat->new(12345); $y->accuracy(3); # '12000' +ok ($x-$y,42000); # 54320+12300=> 42020 => 42000 + +$x = Math::BigFloat->new(1.2345); $x->precision(-2); # '1.23' +$y = Math::BigFloat->new(1.2345); $y->precision(-4); # '1.2345' +ok ($x+$y,2.46); # 1.2345+1.2300=> 2.4645 => 2.46 + +############################################################################### +# round should find and use proper class + +$x = Foo->new(); +ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy); +ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision); +ok ($x->bfround($Foo::precision),'p' x $Foo::precision); +ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy); + +############################################################################### +# find out whether _find_round_parameters is doing what's it's supposed to do + +$Math::BigInt::accuracy = undef; +$Math::BigInt::precision = undef; +$Math::BigInt::div_scale = 40; +$Math::BigInt::round_mode = 'odd'; + +$x = Math::BigInt->new(123); +my @params = $x->_find_round_parameters(); +ok (scalar @params,1); # nothing to round + +@params = $x->_find_round_parameters(1); +ok (scalar @params,4); # a=1 +ok ($params[0],$x); # self +ok ($params[1],1); # a +ok_undef ($params[2]); # p +ok ($params[3],'odd'); # round_mode + +@params = $x->_find_round_parameters(undef,2); +ok (scalar @params,4); # p=2 +ok ($params[0],$x); # self +ok_undef ($params[1]); # a +ok ($params[2],2); # p +ok ($params[3],'odd'); # round_mode + +eval { @params = $x->_find_round_parameters(undef,2,'foo'); }; +ok ($@ =~ /^Unknown round mode 'foo'/,1); + +@params = $x->_find_round_parameters(undef,2,'+inf'); +ok (scalar @params,4); # p=2 +ok ($params[0],$x); # self +ok_undef ($params[1]); # a +ok ($params[2],2); # p +ok ($params[3],'+inf'); # round_mode + +@params = $x->_find_round_parameters(2,-2,'+inf'); +ok (scalar @params,4); # p=2 +ok ($params[0],$x); # self +ok ($params[1],2); # a +ok ($params[2],-2); # p +ok ($params[3],'+inf'); # round_mode + # all done ############################################################################### diff --git a/lib/Math/BigInt/t/subclass.t b/lib/Math/BigInt/t/subclass.t new file mode 100644 index 0000000..332d0c8 --- /dev/null +++ b/lib/Math/BigInt/t/subclass.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + unshift @INC, '../lib'; # for running manually + my $location = $0; $location =~ s/subclass.t//; + unshift @INC, $location; # to locate the testing files + #chdir 't' if -d 't'; + plan tests => 1277; + } + +use Math::BigInt; +use Math::Subclass; + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); +$class = "Math::Subclass"; + +require 'bigfltpm.inc'; # perform same tests as bigfltpm + +# Now do custom tests for Subclass itself +my $ms = new Math::Subclass 23; +print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom}); + +use Math::BigFloat; + +my $bf = new Math::BigFloat 23; # same as other +$ms += $bf; +print "# Tried: \$ms += \$bf, got $ms" if !ok (46, $ms); +print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom}); +print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));