From: Jarkko Hietaniemi Date: Sun, 4 Nov 2001 16:52:45 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.45; from Tels. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dccbb85364264831140cc0a7f1548b3b0afa23c5;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.45; from Tels. NOTE: some of the tests are failing but that's because the core integration is not yet done. p4raw-id: //depot/perl@12843 --- diff --git a/MANIFEST b/MANIFEST index 42743f7..405e294 100644 --- a/MANIFEST +++ b/MANIFEST @@ -574,21 +574,21 @@ ext/Thread/unsync4.tx Test thread implicit synchronisation ext/threads/Changes ithreads ext/threads/Makefile.PL ithreads ext/threads/README ithreads -ext/threads/t/basic.t ithreads -ext/threads/t/stress_cv.t Test with multiple threads, coderef cv argument. -ext/threads/t/stress_string.t Test with multiple threads, string cv argument. -ext/threads/threads.h ithreads -ext/threads/threads.pm ithreads -ext/threads/threads.xs ithreads ext/threads/shared/Makefile.PL thread shared variables ext/threads/shared/README thread shared variables ext/threads/shared/shared.pm thread shared variables ext/threads/shared/shared.xs thread shared variables -ext/threads/shared/t/sv_simple.t thread shared variables -ext/threads/shared/t/sv_refs.t thread shared variables ext/threads/shared/t/av_simple.t Tests for basic shared array functionality. -ext/threads/shared/t/hv_simple.t Tests for basic shared hash functionality. ext/threads/shared/t/hv_refs.t Test shared hashes containing references +ext/threads/shared/t/hv_simple.t Tests for basic shared hash functionality. +ext/threads/shared/t/sv_refs.t thread shared variables +ext/threads/shared/t/sv_simple.t thread shared variables +ext/threads/t/basic.t ithreads +ext/threads/t/stress_cv.t Test with multiple threads, coderef cv argument. +ext/threads/t/stress_string.t Test with multiple threads, string cv argument. +ext/threads/threads.h ithreads +ext/threads/threads.pm ithreads +ext/threads/threads.xs ithreads ext/Time/HiRes/Changes Time::HiRes extension ext/Time/HiRes/hints/dynixptx.pl Hint for Time::HiRes for named architecture ext/Time/HiRes/hints/sco.pl Hints for Time::HiRes for named architecture @@ -1036,9 +1036,11 @@ 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/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test +lib/Math/BigInt/t/Math/BigInt/Subclass.pm Empty subclass of BigInt 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/BigInt/t/sub_mbf.t Empty subclass test of BigFloat +lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt 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 @@ -1214,8 +1216,8 @@ lib/Test/Simple/t/skip.t Test::More test, SKIP tests lib/Test/Simple/t/skipall.t Test::More test, skip all tests lib/Test/Simple/t/todo.t Test::More test, TODO tests lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings -lib/Test/Simple/t/use_ok.t Test::More test, use_ok() lib/Test/Simple/t/useing.t Test::More test, compile test +lib/Test/Simple/t/use_ok.t Test::More test, use_ok() lib/Test/t/fail.t See if Test works lib/Test/t/mix.t See if Test works lib/Test/t/onfail.t See if Test works diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 8aab185..f854ec0 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.44'; +$VERSION = '1.45'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub @@ -391,7 +391,6 @@ sub new } $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 $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,$round_mode) if defined $accuracy || defined $precision; @@ -443,7 +442,6 @@ sub bzero return if $self->modify('bzero'); $self->{value} = $CALC->_zero(); $self->{sign} = '+'; - #print "result: $self\n"; return $self; } @@ -454,7 +452,6 @@ sub bone my $self = shift; my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; $self = $class if !defined $self; - #print "bone $self\n"; if (!ref($self)) { @@ -463,7 +460,6 @@ sub bone return if $self->modify('bone'); $self->{value} = $CALC->_one(); $self->{sign} = $sign; - #print "result: $self\n"; return $self; } @@ -475,12 +471,8 @@ 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") -# 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,@_); + 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} !~ /^[+-]$/) { @@ -585,7 +577,6 @@ sub _find_round_parameters 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)$/; @@ -619,8 +610,8 @@ sub bnorm { # (numstr or or BINT) return BINT # Normalize number -- no-op here - return Math::BigInt->new($_[0]) if !ref($_[0]); - return $_[0]; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x; } sub babs @@ -674,8 +665,19 @@ sub bcmp return 0 if $xz && $yz; # 0 <=> 0 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 - # normal compare now - &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0; + + # post-normalized compare for internal use (honors signs) + if ($x->{sign} eq '+') + { + return 1 if $y->{sign} eq '-'; # 0 check handled above + return $CALC->_acmp($x->{value},$y->{value}); + } + + # $x->{sign} eq '-' + return -1 if $y->{sign} eq '+'; + return $CALC->_acmp($y->{value},$x->{value}); # swaped + + # &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0; } sub bacmp @@ -808,7 +810,7 @@ sub blcm { $x = $class->new($y); } - while (@_) { $x = _lcm($x,shift); } + while (@_) { $x = __lcm($x,shift); } $x; } @@ -818,21 +820,15 @@ sub bgcd # does not modify arguments, but returns new object # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff) - my $y = shift; my ($x); - if (ref($y)) - { - $x = $y->copy(); - } - else - { - $x = $class->new($y); - } - + my $y = shift; + $y = __PACKAGE__->new($y) if !ref($y); + my $self = ref($y); + my $x = $y->copy(); # keep arguments if ($CALC->can('_gcd')) { while (@_) { - $y = shift; $y = $class->new($y) if !ref($y); + $y = shift; $y = $self->new($y) if !ref($y); next if $y->is_zero(); return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one(); @@ -842,22 +838,13 @@ sub bgcd { while (@_) { - $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN + $y = shift; $y = $self->new($y) if !ref($y); + $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN } } $x->babs(); } -sub bmod - { - # modulus - # (BINT or num_str, BINT or num_str) return BINT - my ($self,$x,$y) = objectify(2,@_); - - return $x if $x->modify('bmod'); - (&bdiv($self,$x,$y))[1]; - } - sub bnot { # (num_str or BINT) return BINT @@ -985,8 +972,79 @@ sub bmul } $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math return $x->round($a,$p,$r,$y); + + # from http://groups.google.com/groups?selm=3BBF69A6.72E1%40pointecom.net + # + # my $yc = $y->copy(); # make copy of second argument + # my $carry = $self->bzero(); + # + # # XXX + # while ($yc > 1) + # { + # #print "$x\t$yc\t$carry\n"; + # $carry += $x if $yc->is_odd(); + # $yc->brsft(1,2); + # $x->blsft(1,2); + # } + # $x += $carry; + # #print "result $x\n"; + # + # return $x->round($a,$p,$r,$y); + } + +sub _div_inf + { + # helper function that handles +-inf cases for bdiv()/bmod() to reuse code + my ($self,$x,$y) = @_; + + # NaN if x == NaN or y == NaN or x==y==0 + return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan() + if (($x->is_nan() || $y->is_nan()) || + ($x->is_zero() && $y->is_zero())); + + # +inf / +inf == -inf / -inf == 1, remainder is 0 (A / A = 1, remainder 0) + if (($x->{sign} eq $y->{sign}) && + ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + return wantarray ? ($x->bone(),$self->bzero()) : $x->bone(); + } + # +inf / -inf == -inf / +inf == -1, remainder 0 + if (($x->{sign} ne $y->{sign}) && + ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + return wantarray ? ($x->bone('-'),$self->bzero()) : $x->bone('-'); + } + # x / +-inf => 0, remainder x (works even if x == 0) + if ($y->{sign} =~ /^[+-]inf$/) + { + my $t = $x->copy(); # binf clobbers up $x + return wantarray ? ($x->bzero(),$t) : $x->bzero() + } + + # 5 / 0 => +inf, -6 / 0 => -inf + # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf + # exception: -8 / 0 has remainder -8, not 8 + # exception: -inf / 0 has remainder -inf, not inf + if ($y->is_zero()) + { + # +-inf / 0 => special case for -inf + return wantarray ? ($x,$x->copy()) : $x if $x->is_inf(); + if (!$x->is_zero() && !$x->is_inf()) + { + my $t = $x->copy(); # binf clobbers up $x + return wantarray ? + ($x->binf($x->{sign}),$t) : $x->binf($x->{sign}) + } + } + + # last case: +-inf / ordinary number + my $sign = '+inf'; + $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign}; + $x->{sign} = $sign; + return wantarray ? ($x,$self->bzero()) : $x; } sub bdiv @@ -997,23 +1055,8 @@ sub bdiv return $x if $x->modify('bdiv'); - # x / +-inf => 0, reminder x - return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero() - if $y->{sign} =~ /^[+-]inf$/; - - # NaN if x == NaN or y == NaN or x==y==0 - return wantarray ? ($x->bnan(),bnan()) : $x->bnan() - if (($x->is_nan() || $y->is_nan()) || - ($x->is_zero() && $y->is_zero())); - - # 5 / 0 => +inf, -6 / 0 => -inf - return wantarray - ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign}) - if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); - - # old code: always NaN if /0 - #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan() - # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero()); + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); # 0 / something return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); @@ -1035,36 +1078,74 @@ sub bdiv } # calc new sign and in case $y == +/- 1, return $x + my $xsign = $x->{sign}; # keep $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+'); # check for / +-1 (cant use $y->is_one due to '-' - if (($y == 1) || ($y == -1)) # slow! - #if ((@{$y->{value}} == 1) && ($y->{value}->[0] == 1)) + if (($y == 1) || ($y == -1)) # slow! { return wantarray ? ($x,$self->bzero()) : $x; } # call div here my $rem = $self->bzero(); - $rem->{sign} = $y->{sign}; ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value}); - # 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"; + # do not leave result "-0"; + $x->{sign} = '+' if $CALC->_is_zero($x->{value}); $x->round($a,$p,$r,$y); + +# print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n"; if (wantarray) { - $rem->round($a,$p,$r,$x,$y); - return ($x,$y-$rem) if $x->{sign} eq '-'; # was $x,$rem + if (! $CALC->_is_zero($rem->{value})) + { + $rem->{sign} = $y->{sign}; + $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-' + } + else + { + $rem->{sign} = '+'; # dont leave -0 + } + $rem->round($a,$p,$r,$x,$y); return ($x,$rem); } return $x; } +sub bmod + { + # modulus (or remainder) + # (BINT or num_str, BINT or num_str) return BINT + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x if $x->modify('bmod'); + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()) + { + my ($d,$r) = $self->_div_inf($x,$y); + return $r; + } + + if ($CALC->can('_mod')) + { + # calc new sign and in case $y == +/- 1, return $x + $x->{value} = $CALC->_mod($x->{value},$y->{value}); + my $xsign = $x->{sign}; + if (!$CALC->_is_zero($x->{value})) + { + $x->{sign} = $y->{sign}; + $x = $y-$x if $xsign ne $y->{sign}; # one of them '-' + } + else + { + $x->{sign} = '+'; # dont leave -0 + } + } + else + { + $x = (&bdiv($self,$x,$y))[1]; + } + $x->bround($a,$p,$r); + } + sub bpow { # (BINT or num_str, BINT or num_str) return BINT @@ -1115,18 +1196,20 @@ sub bpow my $pow2 = $self->__one(); my $y1 = $class->new($y); my ($res); + my $two = $self->new(2); while (!$y1->is_one()) { - #print "bpow: p2: $pow2 x: $x y: $y1 r: $res\n"; - #print "len ",$x->length(),"\n"; - ($y1,$res)=&bdiv($y1,2); - if (!$res->is_zero()) { &bmul($pow2,$x); } - if (!$y1->is_zero()) { &bmul($x,$x); } - #print "$x $y\n"; + # thats a tad (between 8 and 17%) faster for small results + # 7777 ** 7777 is not faster, but 2 ** 150, 3 ** 16, 3 ** 256 etc are + $pow2->bmul($x) if $y1->is_odd(); + $y1->bdiv($two); + $x->bmul($x) unless $y1->is_zero(); + + # ($y1,$res)=&bdiv($y1,2); + # if (!$res->is_zero()) { &bmul($pow2,$x); } + # if (!$y1->is_zero()) { &bmul($x,$x); } } - #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n"; - &bmul($x,$pow2) if (!$pow2->is_one()); - #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n"; + $x->bmul($pow2) unless $pow2->is_one(); return $x->round($a,$p,$r); } @@ -1249,7 +1332,6 @@ sub bior $x->badd( bmul( $class->new( abs($sx*int($xr->numify()) | $sy*int($yr->numify()))), $m)); -# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m)); $m->bmul($x10000); } $x->bneg() if $sign; @@ -1294,7 +1376,6 @@ sub bxor $x->badd( bmul( $class->new( abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))), $m)); -# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m)); $m->bmul($x10000); } $x->bneg() if $sign; @@ -1306,9 +1387,6 @@ sub length 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 - #my $es = "$x"; my $c = 0; $c = 1 if $es =~ /^[+-]/; # if lib returns '+123' - #my $e = CORE::length($es)-$c; return wantarray ? ($e,0) : $e; } @@ -1327,8 +1405,7 @@ sub _trailing_zeros my $x = shift; $x = $class->new($x) unless ref $x; - #return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; - return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/; + return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); @@ -1415,7 +1492,7 @@ sub bfround # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 || $n == 1 => round to integer my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_p($precision,$round_mode,@_); + my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_); return $x if !defined $scale; # no-op # no-op for BigInts if $n <= 0 @@ -1464,7 +1541,7 @@ 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,$round_mode,@_); + my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_); return $x if !defined $scale; # no-op # print "MBI round: $x to $scale $mode\n"; @@ -1605,7 +1682,7 @@ sub __one { # internal speedup, set argument to 1, or create a +/- 1 my $self = shift; - my $x = $self->bzero(); $x->{value} = $CALC->_one(); + my $x = $self->bone(); # $x->{value} = $CALC->_one(); $x->{sign} = shift || '+'; return $x; } @@ -1673,7 +1750,7 @@ sub objectify my $count = abs(shift || 0); - #print caller(),"\n"; +# print "MBI ",caller(),"\n"; my @a; # resulting array if (ref $_[0]) @@ -1715,7 +1792,7 @@ sub objectify #print "$count\n"; $count--; $k = shift; - # print "$k (",ref($k),") => \n"; +# print "$k (",ref($k),") => \n"; if (!ref($k)) { $k = $a[0]->new($k); @@ -1765,8 +1842,8 @@ sub import } # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance - #$self->SUPER::import(@a); # does not work - $self->export_to_level(1,$self,@a); # need this instead + $self->SUPER::import(@a); # need it for subclasses + $self->export_to_level(1,$self,@a); # need it for MBF # try to load core math lib my @c = split /\s*,\s*/,$CALC; @@ -1872,7 +1949,7 @@ sub _split { # (ref to num_str) return num_str # internal, take apart a string and return the pieces - # strip leading/trailing whitespace, leading zeros, underscore, reject + # strip leading/trailing whitespace, leading zeros, underscore and reject # invalid input my $x = shift; @@ -2005,28 +2082,7 @@ sub as_bin ############################################################################## # internal calculation routines (others are in Math::BigInt::Calc etc) -sub cmp - { - # post-normalized compare for internal use (honors signs) - # input: ref to value, ref to value, sign, sign - # output: <0, 0, >0 - my ($cx,$cy,$sx,$sy) = @_; - - if ($sx eq '+') - { - return 1 if $sy eq '-'; # 0 check handled above - return $CALC->_acmp($cx,$cy); - } - else - { - # $sx eq '-' - return -1 if $sy eq '+'; - return $CALC->_acmp($cy,$cx); - } - 0; # equal - } - -sub _lcm +sub __lcm { # (BINT or num_str, BINT or num_str) return BINT # does modify first argument @@ -2040,10 +2096,10 @@ sub _lcm sub __gcd { # (BINT or num_str, BINT or num_str) return BINT - # does modify first arg + # does modify both arguments # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296 - - my $x = shift; my $ty = $class->new(shift); # preserve y, but make class + my ($x,$ty) = @_; + return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/; while (!$ty->is_zero()) @@ -2142,8 +2198,8 @@ Math::BigInt - Arbitrary size integer math package # The following do not modify their arguments: - bgcd(@values); # greatest common divisor - blcm(@values); # lowest common multiplicator + bgcd(@values); # greatest common divisor (no OO style) + blcm(@values); # lowest common multiplicator (no OO style) $x->length(); # return number of digits in number ($x,$f) = $x->length(); # length of number and length of fraction part, @@ -2375,7 +2431,7 @@ versions <= 5.7.2) is like this: again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange assumption that 124 has 3 significant digits, while 120/7 will get you '17', not '17.1' since 120 is thought to have 2 significant digits. - The rounding after the division then uses the reminder and $y to determine + The rounding after the division then uses the remainder and $y to determine wether it must round up or down. ? I have no idea which is the right way. That's why I used a slightly more ? simple scheme and tweaked the few failing testcases to match it. @@ -2818,7 +2874,7 @@ This also works for other subclasses, like Math::String. It is yet unlcear whether overloaded int() should return a scalar or a BigInt. -=item bdiv +=item length The following will probably not do what you expect: @@ -2836,7 +2892,7 @@ The following will probably not do what you expect: print $c->bdiv(10000),"\n"; -It prints both quotient and reminder since print calls C in list +It prints both quotient and remainder since print calls C in list context. Also, C will modify $c, so be carefull. You probably want to use @@ -2850,10 +2906,12 @@ real-valued quotient of the two operands, and the remainder (when it is nonzero) always has the same sign as the second operand; so, for example, - 1 / 4 => ( 0, 1) - 1 / -4 => (-1,-3) - -3 / 4 => (-1, 1) - -3 / -4 => ( 0,-3) + 1 / 4 => ( 0, 1) + 1 / -4 => (-1,-3) + -3 / 4 => (-1, 1) + -3 / -4 => ( 0,-3) + -11 / 2 => (-5,1) + 11 /-2 => (-5,-1) As a consequence, the behavior of the operator % agrees with the behavior of Perl's built-in % operator (as documented in the perlop @@ -2862,7 +2920,9 @@ manpage), and the equation $x == ($x / $y) * $y + ($x % $y) holds true for any $x and $y, which justifies calling the two return -values of bdiv() the quotient and remainder. +values of bdiv() the quotient and remainder. The only exception to this rule +are when $y == 0 and $x is negative, then the remainder will also be +negative. See below under "infinity handling" for the reasoning behing this. Perl's 'use integer;' changes the behaviour of % and / for scalars, but will not change BigInt's way to do things. This is because under 'use integer' Perl @@ -2870,6 +2930,47 @@ will do what the underlying C thinks is right and this is different for each system. If you need BigInt's behaving exactly like Perl's 'use integer', bug the author to implement it ;) +=item infinity handling + +Here are some examples that explain the reasons why certain results occur while +handling infinity: + +The following table shows the result of the division and the remainder, so that +the equation above holds true. Some "ordinary" cases are strewn in to show more +clearly the reasoning: + + A / B = C, R so that C * B + R = A + ========================================================= + 5 / 8 = 0, 5 0 * 8 + 5 = 5 + 0 / 8 = 0, 0 0 * 8 + 0 = 0 + 0 / inf = 0, 0 0 * inf + 0 = 0 + 0 /-inf = 0, 0 0 * -inf + 0 = 0 + 5 / inf = 0, 5 0 * inf + 5 = 5 + 5 /-inf = 0, 5 0 * -inf + 5 = 5 + -5/ inf = 0, -5 0 * inf + -5 = -5 + -5/-inf = 0, -5 0 * -inf + -5 = -5 + inf/ 5 = inf, 0 inf * 5 + 0 = inf + -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf + inf/ -5 = -inf, 0 -inf * -5 + 0 = inf + -inf/ -5 = inf, 0 inf * -5 + 0 = -inf + 5/ 5 = 1, 0 1 * 5 + 0 = 5 + -5/ -5 = 1, 0 1 * -5 + 0 = -5 + inf/ inf = 1, 0 1 * inf + 0 = inf + -inf/-inf = 1, 0 1 * -inf + 0 = -inf + inf/-inf = -1, 0 -1 * -inf + 0 = inf + -inf/ inf = -1, 0 1 * -inf + 0 = -inf + 8/ 0 = inf, 8 inf * 0 + 8 = 8 + inf/ 0 = inf, inf inf * 0 + inf = inf + 0/ 0 = NaN + +These cases below violate the "remainder has the sign of the second of the two +arguments", since they wouldn't match up otherwise. + + A / B = C, R so that C * B + R = A + ======================================================== + -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf + -8/ 0 = -inf, -8 -inf * 0 + 8 = -8 + =item Modifying and = Beware of: diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index a2b73e0..e7754bd 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.12'; +$VERSION = '0.13'; # Package to store unsigned big integers in decimal and do math with them @@ -29,14 +29,16 @@ $VERSION = '0.12'; # constants for easier life my $nan = 'NaN'; - my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL); sub _base_len { + # set/get the BASE_LEN and assorted other, connected values + # used only be the testsuite, set is used only by the BEGIN block below my $b = shift; if (defined $b) { + $b = 8 if $b > 8; # cap, for VMS, OS/390 and other 64 bit $BASE_LEN = $b; $BASE = int("1e".$BASE_LEN); $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL @@ -46,36 +48,35 @@ sub _base_len 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; + $BASE_LEN; } BEGIN { # from Daniel Pfeiffer: determine largest group of digits that is precisely # multipliable with itself plus carry - my ($e, $num) = 4; + # Test now changed to expect the proper pattern, not a result off by 1 or 2 + my ($e, $num) = 3; # lowest value we will use is 3+1-1 = 3 do { $num = ('9' x ++$e) + 0; $num *= $num + 1; - } until ($num == $num - 1 or $num - 1 == $num - 2); + # print "$num $e\n"; + } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern + # last test failed, so retract one step: _base_len($e-1); } -# for quering and setting, to debug/benchmark things - ############################################################################## # create objects from various representations @@ -229,7 +230,7 @@ sub _mul_use_mul # 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? @@ -477,6 +478,58 @@ sub _div_use_div return $x; } +sub _mod + { + # if possible, use mod shortcut + my ($c,$x,$yo) = @_; + + # slow way since $y to big + if (scalar @$yo > 1) + { + my ($xo,$rem) = _div($c,$x,$yo); + return $rem; + } + my $y = $yo->[0]; + # both are single element + if (scalar @$x == 1) + { + $x->[0] %= $y; + return $x; + } + + my $b = $BASE % $y; + if ($b == 0) + { + # when BASE % Y == 0 then (B * BASE) % Y == 0 + # (B * BASE) % $y + A % Y => A % Y + # so need to consider only last element: O(1) + $x->[0] %= $y; + } + else + { + # else need to go trough all elemens: O(N) + # XXX not ready yet + my ($xo,$rem) = _div($c,$x,$yo); + return $rem; + +# my $i = 0; my $r = 1; +# print "Multi: "; +# foreach (@$x) +# { +# print "$_ $r $b $y\n"; +# print "\$_ % \$y = ",$_ % $y,"\n"; +# print "\$_ % \$y * \$b = ",($_ % $y) * $b,"\n"; +# $r += ($_ % $y) * $b; +# print "$r $b $y =>"; +# $r %= $y if $r > $y; +# print " $r\n"; +# } +# $x->[0] = $r; + } + splice (@$x,1); + return $x; + } + ############################################################################## # shifts @@ -494,7 +547,7 @@ sub _rsft # multiples of $BASE_LEN my $dst = 0; # destination my $src = _num($c,$y); # as normal int - my $rem = $src % $BASE_LEN; # reminder to shift + my $rem = $src % $BASE_LEN; # remainder to shift $src = int($src / $BASE_LEN); # source if ($rem == 0) { @@ -540,7 +593,7 @@ sub _lsft # multiples of $BASE_LEN: my $src = scalar @$x; # source my $len = _num($c,$y); # shift-len as normal int - my $rem = $len % $BASE_LEN; # reminder to shift + my $rem = $len % $BASE_LEN; # remainder to shift my $dst = $src + int($len/$BASE_LEN); # destination my $vd; # further speedup #print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n"; @@ -612,9 +665,9 @@ sub _acmp sub _len { - # computer number of digits in bigint, minus the sign + # compute number of digits in bigint, minus the sign # int() because add/sub sometimes leaves strings (like '00005') instead of - # int ('5') in this place, causing length to fail + # int ('5') in this place, thus causing length() to report wrong length my $cx = $_[1]; return (@$cx-1)*$BASE_LEN+length(int($cx->[-1])); @@ -729,6 +782,10 @@ sub _check $e = $x->[$i]; $e = 'undef' unless defined $e; $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)"; last if $e !~ /^[+]?[0-9]+$/; + $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)"; + last if "$e" !~ /^[+]?[0-9]+$/; + $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)"; + last if '' . "$e" !~ /^[+]?[0-9]+$/; $try = ' < 0 || >= $BASE; '."($x, $e)"; last if $e <0 || $e >= $BASE; # this test is disabled, since new/bnorm and certain ops (like early out @@ -820,13 +877,16 @@ slow, Perl way as fallback to emulate these: '0b' must be prepended. _rsft(obj,N,B) shift object in base B by N 'digits' right + For unsupported bases B, return undef to signal failure _lsft(obj,N,B) shift object in base B by N 'digits' left + For unsupported bases B, return undef to signal failure _xor(obj1,obj2) XOR (bit-wise) object 1 with object 2 - Mote: XOR, AND and OR pad with zeros if size mismatches + Note: XOR, AND and OR pad with zeros if size mismatches _and(obj1,obj2) AND (bit-wise) object 1 with object 2 _or(obj1,obj2) OR (bit-wise) object 1 with object 2 + _mod(obj,obj) Return remainder of div of the 1st by the 2nd object _sqrt(obj) return the square root of object _pow(obj,obj) return object 1 to the power of object 2 _gcd(obj,obj) return Greatest Common Divisor of two objects @@ -845,12 +905,13 @@ zero or similar cases. The first parameter can be modified, that includes the possibility that you return a reference to a completely different object instead. Although keeping -the reference is prefered over creating and returning a different one. +the reference and just changing it's contents is prefered over creating and +returning a different reference. Return values are always references to objects or strings. Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not shift the argument. This is used to delegate shifting of bases different than 10 back -to BigInt, which will use some generic code to calculate the result. +to Math::BigInt, which will use some generic code to calculate the result. =head1 WRAP YOUR OWN diff --git a/lib/Math/BigInt/t/Math/Subclass.pm b/lib/Math/BigInt/t/Math/BigFloat/Subclass.pm similarity index 77% rename from lib/Math/BigInt/t/Math/Subclass.pm rename to lib/Math/BigInt/t/Math/BigFloat/Subclass.pm index c78731c..7a1c279 100644 --- a/lib/Math/BigInt/t/Math/Subclass.pm +++ b/lib/Math/BigInt/t/Math/BigFloat/Subclass.pm @@ -1,25 +1,17 @@ #!/usr/bin/perl -w -package Math::Subclass; +package Math::BigFloat::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 +use vars qw($VERSION @ISA $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 diff --git a/lib/Math/BigInt/t/Math/BigInt/Subclass.pm b/lib/Math/BigInt/t/Math/BigInt/Subclass.pm new file mode 100644 index 0000000..79a4957 --- /dev/null +++ b/lib/Math/BigInt/t/Math/BigInt/Subclass.pm @@ -0,0 +1,56 @@ +#!/usr/bin/perl -w + +package Math::BigInt::Subclass; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigInt(1.45); +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigInt); +@EXPORT_OK = qw(bgcd); + +$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; # no || 0 here! + my $decimal = shift; + my $radix = 0; + + # Store the floating point value + my $self = bless Math::BigInt->new($value), $class; + $self->{'_custom'} = 1; # make sure this never goes away + return $self; +} + +sub bgcd + { + Math::BigInt::bgcd(@_); + } + +sub blcm + { + Math::BigInt::blcm(@_); + } + +sub import + { + my $self = shift; +# Math::BigInt->import(@_); + $self->SUPER::import(@_); # need it for subclasses + #$self->export_to_level(1,$self,@_); # need this ? + } + +1; diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index dd85adc..d02caa6 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -6,11 +6,11 @@ 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 => 1273; + plan tests => 1277; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t index 4559d43..be1dc46 100644 --- a/lib/Math/BigInt/t/calling.t +++ b/lib/Math/BigInt/t/calling.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -# test calling conventions +# test calling conventions, and :constant overloading use strict; use Test; @@ -10,7 +10,7 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 100; + plan tests => 141; } package Math::BigInt::Test; @@ -33,6 +33,7 @@ use Math::BigInt; use Math::BigFloat; my ($x,$y,$z,$u); +my $version = '1.45'; # adjust manually to match latest release ############################################################################### # check whether op's accept normal strings, even when inherited by subclasses @@ -55,7 +56,10 @@ while () foreach $class (qw/ Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/) { - $try = "$class\->$func('$args[0]');"; + $try = "'$args[0]'"; # quote it + $try = $args[0] if $args[0] =~ /'/; # already quoted + $try = '' if $args[0] eq ''; # undef, no argument + $try = "$class\->$func($try);"; $rc = eval $try; print "# Tried: '$try'\n" if !ok ($rc, $ans); } @@ -63,6 +67,43 @@ while () } +$class = 'Math::BigInt'; + +# test whether use Math::BigInt qw/version/ works +$try = "use $class ($version.'1');"; +$try .= ' $x = $class->new(123); $x = "$x";'; +eval $try; +ok_undef ( $_ ); # should result in error! + +# test whether fallback to calc works +$try = "use $class ($version,'lib','foo, bar , ');"; +$try .= "$class\->_core_lib();"; +$ans = eval $try; +ok ( $ans, "Math::BigInt::Calc"); + +# test whether constant works or not, also test for qw($version) +# bgcd() is present in subclass, too +$try = "use Math::BigInt ($version,'bgcd',':constant');"; +$try .= ' $x = 2**150; bgcd($x); $x = "$x";'; +$ans = eval $try; +ok ( $ans, "1427247692705959881058285969449495136382746624"); + +# test wether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) +$try = "use $class ($version,'lib','Scalar');"; +$try .= ' $x = 2**10; $x = "$x";'; +$ans = eval $try; ok ( $ans, "1024"); +$try = "use $class ($version,'LiB','$class\::Scalar');"; +$try .= ' $x = 2**10; $x = "$x";'; +$ans = eval $try; ok ( $ans, "1024"); + +# test wether calc => undef (array element not existing) works +# no longer supported +#$try = "use $class ($version,'LIB');"; +#$try = "require $class; $class\::import($version,'CALC');"; +#$try .= " \$x = $class\->new(2)**10; \$x = ".'"$x";'; +#print "$try\n"; +#$ans = eval $try; ok ( $ans, 1024); + # all done ############################################################################### @@ -99,8 +140,8 @@ inf:1 5:5 10:10 abc:NaN -+inf:inf --inf:-inf +'+inf':inf +'-inf':-inf &bsstr 1:1e+0 0:0e+1 @@ -112,3 +153,16 @@ abc:NaN &bnot -2:1 1:-2 +&bzero +:0 +&bnan +:NaN +abc:NaN +&bone +:1 +'+':1 +'-':-1 +&binf +:inf +'+':inf +'-':-inf diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index e5b6f36..c92eaa4 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -3,6 +3,9 @@ # test rounding, accuracy, precicion and fallback, round_mode and mixing # of classes +# Make sure you always quote any bare floating-point values, lest 123.46 will +# be stringified to 123.4599999999 due to limited float prevision. + use strict; use Test; @@ -11,7 +14,7 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 246; + plan tests => 254; } # for finding out whether round finds correct class @@ -74,21 +77,33 @@ 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_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->round_mode(),'even'); ok_undef ($Math::BigFloat::accuracy); ok_undef ($Math::BigFloat::precision); -ok_undef (Math::BigFloat->accuracy()); +ok_undef (Math::BigFloat::accuracy()); +ok_undef (Math::BigFloat::accuracy()); +ok_undef (Math::BigFloat->precision()); ok_undef (Math::BigFloat->precision()); ok ($Math::BigFloat::div_scale,40); ok (Math::BigFloat::div_scale(),40); ok ($Math::BigFloat::round_mode,'even'); ok (Math::BigFloat::round_mode(),'even'); +ok (Math::BigFloat->round_mode(),'even'); + +$x = eval 'Math::BigInt->round_mode("huhmbi");'; +ok ($@ =~ /^Unknown round mode huhmbi at/); + +$x = eval 'Math::BigFloat->round_mode("huhmbf");'; +ok ($@ =~ /^Unknown round mode huhmbf at/); # accessors foreach my $class (qw/Math::BigInt Math::BigFloat/) @@ -153,7 +168,7 @@ ok ($Math::BigInt::round_mode,'-inf'); # from above $Math::BigInt::accuracy = undef; $Math::BigInt::precision = undef; # local copies -$x = Math::BigFloat->new(123.456); +$x = Math::BigFloat->new('123.456'); ok_undef ($x->accuracy()); ok ($x->accuracy(5),5); ok_undef ($x->accuracy(undef),undef); @@ -181,35 +196,35 @@ $Math::BigFloat::accuracy = 4; $Math::BigFloat::precision = -1; $Math::BigInt::precision = undef; -ok (Math::BigFloat->new(123.456),123.5); # with A +ok (Math::BigFloat->new('123.456'),'123.5'); # with A $Math::BigFloat::accuracy = undef; -ok (Math::BigFloat->new(123.456),123.5); # with P from MBF, not MBI! +ok (Math::BigFloat->new('123.456'),'123.5'); # with P from MBF, not MBI! $Math::BigFloat::precision = undef; ############################################################################### # see if setting accuracy/precision actually rounds the number -$x = Math::BigFloat->new(123.456); $x->accuracy(4); ok ($x,123.5); -$x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46); +$x = Math::BigFloat->new('123.456'); $x->accuracy(4); ok ($x,'123.5'); +$x = Math::BigFloat->new('123.456'); $x->precision(-2); ok ($x,'123.46'); -$x = Math::BigInt->new(123456); $x->accuracy(4); ok ($x,123500); -$x = Math::BigInt->new(123456); $x->precision(2); ok ($x,123500); +$x = Math::BigInt->new('123456'); $x->accuracy(4); ok ($x,123500); +$x = Math::BigInt->new('123456'); $x->precision(2); ok ($x,123500); ############################################################################### # test actual rounding via round() -$x = Math::BigFloat->new(123.456); -ok ($x->copy()->round(5,2),123.46); -ok ($x->copy()->round(4,2),123.5); -ok ($x->copy()->round(undef,-2),123.46); +$x = Math::BigFloat->new('123.456'); +ok ($x->copy()->round(5,2),'123.46'); +ok ($x->copy()->round(4,2),'123.5'); +ok ($x->copy()->round(undef,-2),'123.46'); ok ($x->copy()->round(undef,2),100); -$x = Math::BigFloat->new(123.45000); -ok ($x->copy()->round(undef,-1,'odd'),123.5); +$x = Math::BigFloat->new('123.45000'); +ok ($x->copy()->round(undef,-1,'odd'),'123.5'); # see if rounding is 'sticky' -$x = Math::BigFloat->new(123.4567); +$x = Math::BigFloat->new('123.4567'); $y = $x->copy()->bround(); # no-op since nowhere A or P defined ok ($y,123.4567); @@ -221,14 +236,14 @@ 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); +$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); +$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()); @@ -242,18 +257,18 @@ $z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2); # These tests are not complete, since they do not excercise every "return" # statement in the op's. But heh, it's better than nothing... -$x = Math::BigFloat->new(123.456); -$y = Math::BigFloat->new(654.321); +$x = Math::BigFloat->new('123.456'); +$y = Math::BigFloat->new('654.321'); $x->{_a} = 5; # $x->accuracy(5) would round $x straightaway $y->{_a} = 4; # $y->accuracy(4) would round $x straightaway -$z = $x + $y; ok ($z,777.8); -$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); +$z = $x + $y; ok ($z,'777.8'); +$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); +# 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; $z = $x->copy; $z++; ok ($z,123500); @@ -442,12 +457,12 @@ $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; +$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); +$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}); @@ -474,9 +489,9 @@ $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 +$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 diff --git a/lib/Math/BigInt/t/subclass.t b/lib/Math/BigInt/t/sub_mbf.t old mode 100644 new mode 100755 similarity index 72% copy from lib/Math/BigInt/t/subclass.t copy to lib/Math/BigInt/t/sub_mbf.t index 332d0c8..946222c --- a/lib/Math/BigInt/t/subclass.t +++ b/lib/Math/BigInt/t/sub_mbf.t @@ -7,27 +7,26 @@ BEGIN { $| = 1; unshift @INC, '../lib'; # for running manually - my $location = $0; $location =~ s/subclass.t//; + my $location = $0; $location =~ s/sub_mbf.t//; unshift @INC, $location; # to locate the testing files - #chdir 't' if -d 't'; - plan tests => 1277; + chdir 't' if -d 't'; + plan tests => 1277 + 4; # + 4 own tests } -use Math::BigInt; -use Math::Subclass; +use Math::BigFloat::Subclass; use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); -$class = "Math::Subclass"; +$class = "Math::BigFloat::Subclass"; require 'bigfltpm.inc'; # perform same tests as bigfltpm # Now do custom tests for Subclass itself -my $ms = new Math::Subclass 23; +my $ms = $class->new(23); print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom}); use Math::BigFloat; -my $bf = new Math::BigFloat 23; # same as other +my $bf = Math::BigFloat->new(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}); diff --git a/lib/Math/BigInt/t/subclass.t b/lib/Math/BigInt/t/sub_mbi.t old mode 100644 new mode 100755 similarity index 54% rename from lib/Math/BigInt/t/subclass.t rename to lib/Math/BigInt/t/sub_mbi.t index 332d0c8..cb85a02 --- a/lib/Math/BigInt/t/subclass.t +++ b/lib/Math/BigInt/t/sub_mbi.t @@ -7,28 +7,29 @@ BEGIN { $| = 1; unshift @INC, '../lib'; # for running manually - my $location = $0; $location =~ s/subclass.t//; + my $location = $0; $location =~ s/sub_mbi.t//; unshift @INC, $location; # to locate the testing files - #chdir 't' if -d 't'; - plan tests => 1277; + chdir 't' if -d 't'; + plan tests => 1608 + 4; # +4 own tests } -use Math::BigInt; -use Math::Subclass; +use Math::BigInt::Subclass; use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup); -$class = "Math::Subclass"; +$class = "Math::BigInt::Subclass"; + +#my $version = '0.01'; # for $VERSION tests, match current release (by hand!) -require 'bigfltpm.inc'; # perform same tests as bigfltpm +require 'bigintpm.inc'; # perform same tests as bigfltpm # Now do custom tests for Subclass itself -my $ms = new Math::Subclass 23; +my $ms = $class->new(23); print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom}); -use Math::BigFloat; +use Math::BigInt; -my $bf = new Math::BigFloat 23; # same as other -$ms += $bf; -print "# Tried: \$ms += \$bf, got $ms" if !ok (46, $ms); +my $bi = Math::BigInt->new(23); # same as other +$ms += $bi; +print "# Tried: \$ms += \$bi, 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));