# 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; my ($x,$y,$z,$u,$rc); ############################################################################### # test defaults and set/get { no strict 'refs'; is (${"$mbi\::accuracy"}, undef); is (${"$mbi\::precision"}, undef); is ($mbi->accuracy(), undef); is ($mbi->precision(), undef); is (${"$mbi\::div_scale"},40); is (${"$mbi\::round_mode"},'even'); is ($mbi->round_mode(),'even'); is (${"$mbf\::accuracy"}, undef); is (${"$mbf\::precision"}, undef); is ($mbf->precision(), undef); is ($mbf->precision(), undef); is (${"$mbf\::div_scale"},40); is (${"$mbf\::round_mode"},'even'); is ($mbf->round_mode(),'even'); } # accessors foreach my $class ($mbi,$mbf) { is ($class->accuracy(), undef); is ($class->precision(), undef); is ($class->round_mode(),'even'); is ($class->div_scale(),40); is ($class->div_scale(20),20); $class->div_scale(40); is ($class->div_scale(),40); is ($class->round_mode('odd'),'odd'); $class->round_mode('even'); is ($class->round_mode(),'even'); is ($class->accuracy(2),2); $class->accuracy(3); is ($class->accuracy(),3); is ($class->accuracy(undef), undef); is ($class->precision(2),2); is ($class->precision(-2),-2); $class->precision(3); is ($class->precision(),3); is ($class->precision(undef), undef); } { no strict 'refs'; # accuracy foreach (qw/5 42 -1 0/) { is (${"$mbf\::accuracy"} = $_,$_); is (${"$mbi\::accuracy"} = $_,$_); } is (${"$mbf\::accuracy"} = undef, undef); is (${"$mbi\::accuracy"} = undef, undef); # precision foreach (qw/5 42 -1 0/) { is (${"$mbf\::precision"} = $_,$_); is (${"$mbi\::precision"} = $_,$_); } is (${"$mbf\::precision"} = undef, undef); is (${"$mbi\::precision"} = undef, undef); # fallback foreach (qw/5 42 1/) { is (${"$mbf\::div_scale"} = $_,$_); is (${"$mbi\::div_scale"} = $_,$_); } # illegal values are possible for fallback due to no accessor # round_mode foreach (qw/odd even zero trunc +inf -inf/) { is (${"$mbf\::round_mode"} = $_,$_); is (${"$mbi\::round_mode"} = $_,$_); } ${"$mbf\::round_mode"} = 'zero'; is (${"$mbf\::round_mode"},'zero'); is (${"$mbi\::round_mode"},'-inf'); # from above # reset for further tests ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = undef; ${"$mbf\::div_scale"} = 40; } # local copies $x = $mbf->new('123.456'); is ($x->accuracy(), undef); is ($x->accuracy(5),5); is ($x->accuracy(undef),undef, undef); is ($x->precision(), undef); is ($x->precision(5),5); is ($x->precision(undef),undef, undef); { no strict 'refs'; # see if MBF changes MBIs values is (${"$mbi\::accuracy"} = 42,42); is (${"$mbf\::accuracy"} = 64,64); is (${"$mbi\::accuracy"},42); # should be still 42 is (${"$mbf\::accuracy"},64); # should be now 64 } ############################################################################### # see if creating a number under set A or P will round it { no strict 'refs'; ${"$mbi\::accuracy"} = 4; ${"$mbi\::precision"} = undef; is ($mbi->new(123456),123500); # with A ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = 3; is ($mbi->new(123456),123000); # with P ${"$mbf\::accuracy"} = 4; ${"$mbf\::precision"} = undef; ${"$mbi\::precision"} = undef; is ($mbf->new('123.456'),'123.5'); # with A ${"$mbf\::accuracy"} = undef; ${"$mbf\::precision"} = -1; is ($mbf->new('123.456'),'123.5'); # with P from MBF, not MBI! ${"$mbf\::precision"} = undef; # reset } ############################################################################### # see if MBI leaves MBF's private parts alone { no strict 'refs'; ${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef; ${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef; is ($mbf->new('123.456'),'123.456'); ${"$mbi\::accuracy"} = undef; # reset } ############################################################################### # see if setting accuracy/precision actually rounds the number $x = $mbf->new('123.456'); $x->accuracy(4); is ($x,'123.5'); $x = $mbf->new('123.456'); $x->precision(-2); is ($x,'123.46'); $x = $mbi->new(123456); $x->accuracy(4); is ($x,123500); $x = $mbi->new(123456); $x->precision(2); is ($x,123500); ############################################################################### # test actual rounding via round() $x = $mbf->new('123.456'); is ($x->copy()->round(5),'123.46'); is ($x->copy()->round(4),'123.5'); is ($x->copy()->round(5,2),'NaN'); is ($x->copy()->round(undef,-2),'123.46'); is ($x->copy()->round(undef,2),120); $x = $mbi->new('123'); is ($x->round(5,2),'NaN'); $x = $mbf->new('123.45000'); is ($x->copy()->round(undef,-1,'odd'),'123.5'); # see if rounding is 'sticky' $x = $mbf->new('123.4567'); $y = $x->copy()->bround(); # no-op since nowhere A or P defined is ($y,123.4567); $y = $x->copy()->round(5); is ($y->accuracy(),5); is ($y->precision(), undef); # A has precedence, so P still unset $y = $x->copy()->round(undef,2); is ($y->precision(),2); is ($y->accuracy(), undef); # P has precedence, so A still unset # see if setting A clears P and vice versa $x = $mbf->new('123.4567'); is ($x,'123.4567'); is ($x->accuracy(4),4); is ($x->precision(-2),-2); # clear A is ($x->accuracy(), undef); $x = $mbf->new('123.4567'); is ($x,'123.4567'); is ($x->precision(-2),-2); is ($x->accuracy(4),4); # clear P is ($x->precision(), undef); # does copy work? $x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2); $z = $x->copy(); is ($z->accuracy(),undef); is ($z->precision(),2); # does $x->bdiv($y,d) work when $d > div_scale? $x = $mbf->new('0.008'); $x->accuracy(8); for my $e ( 4, 8, 16, 32 ) { print "# Tried: $x->bdiv(3,$e)\n" unless is (scalar $x->copy()->bdiv(3,$e), '0.002' . ('6' x ($e-2)) . '7'); } # does accuracy()/precision work on zeros? foreach my $c ($mbi,$mbf) { $x = $c->bzero(); $x->accuracy(5); is ($x->{_a},5); $x = $c->bzero(); $x->precision(5); is ($x->{_p},5); $x = $c->new(0); $x->accuracy(5); is ($x->{_a},5); $x = $c->new(0); $x->precision(5); is ($x->{_p},5); $x = $c->bzero(); $x->round(5); is ($x->{_a},5); $x = $c->bzero(); $x->round(undef,5); is ($x->{_p},5); $x = $c->new(0); $x->round(5); is ($x->{_a},5); $x = $c->new(0); $x->round(undef,5); is ($x->{_p},5); # see if trying to increasing A in bzero() doesn't do something $x = $c->bzero(); $x->{_a} = 3; $x->round(5); is ($x->{_a},3); } ############################################################################### # test whether an opp calls objectify properly or not (or at least does what # it should do given non-objects, w/ or w/o objectify()) foreach my $c ($mbi,$mbf) { # ${"$c\::precision"} = undef; # reset # ${"$c\::accuracy"} = undef; # reset is ($c->new(123)->badd(123),246); is ($c->badd(123,321),444); is ($c->badd(123,$c->new(321)),444); is ($c->new(123)->bsub(122),1); is ($c->bsub(321,123),198); is ($c->bsub(321,$c->new(123)),198); is ($c->new(123)->bmul(123),15129); is ($c->bmul(123,123),15129); is ($c->bmul(123,$c->new(123)),15129); # is ($c->new(15129)->bdiv(123),123); # is ($c->bdiv(15129,123),123); # is ($c->bdiv(15129,$c->new(123)),123); is ($c->new(15131)->bmod(123),2); is ($c->bmod(15131,123),2); is ($c->bmod(15131,$c->new(123)),2); is ($c->new(2)->bpow(16),65536); is ($c->bpow(2,16),65536); is ($c->bpow(2,$c->new(16)),65536); is ($c->new(2**15)->brsft(1),2**14); is ($c->brsft(2**15,1),2**14); is ($c->brsft(2**15,$c->new(1)),2**14); is ($c->new(2**13)->blsft(1),2**14); is ($c->blsft(2**13,1),2**14); is ($c->blsft(2**13,$c->new(1)),2**14); } ############################################################################### # test wether operations round properly afterwards # 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 = $mbf->new('123.456'); $y = $mbf->new('654.321'); $x->{_a} = 5; # $x->accuracy(5) would round $x straight away $y->{_a} = 4; # $y->accuracy(4) would round $x straight away $z = $x + $y; is ($z,'777.8'); $z = $y - $x; is ($z,'530.9'); $z = $y * $x; is ($z,'80780'); $z = $x ** 2; is ($z,'15241'); $z = $x * $x; is ($z,'15241'); # not: $z = -$x; is ($z,'-123.46'); is ($x,'123.456'); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is ($z,62); $x = $mbf->new(123456); $x->{_a} = 4; $z = $x->copy; $z++; is ($z,123500); $x = $mbi->new(123456); $y = $mbi->new(654321); $x->{_a} = 5; # $x->accuracy(5) would round $x straight away $y->{_a} = 4; # $y->accuracy(4) would round $x straight away $z = $x + $y; is ($z,777800); $z = $y - $x; is ($z,530900); $z = $y * $x; is ($z,80780000000); $z = $x ** 2; is ($z,15241000000); # not yet: $z = -$x; is ($z,-123460); is ($x,123456); $z = $x->copy; $z++; is ($z,123460); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is ($z,62000); $x = $mbi->new(123400); $x->{_a} = 4; is ($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) directly $x = $mbi->new(-123401); $x->{_a} = 4; is ($x->babs(),123401); $x = $mbi->new(-123401); $x->{_a} = 4; is ($x->bneg(),123401); # test fdiv rounding to A and R (bug in v1.48 and maybe earlier versions) $mbf->round_mode('even'); $x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); is ($x,'123.4'); $x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6; is ($x->bdiv($y),1); is ($x->{_a},6); # carried over $x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6; is ($x->bdiv($y),1); is ($x->{_a},6); # carried over $x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6; is ($x->bdiv($y),0); is ($x->{_a},6); # carried over $x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6; is ($x->bdiv($y),0); is ($x->{_a},6); # carried over ############################################################################### # test that bop(0) does the same than bop(undef) $x = $mbf->new('1234567890'); is ($x->copy()->bsqrt(0),$x->copy()->bsqrt(undef)); is ($x->copy->bsqrt(0),'35136.41828644462161665823116758077037159'); is ($x->{_a}, undef); # test that bsqrt() modifies $x and does not just return something else # (especially under BareCalc) $z = $x->bsqrt(); is ($z,$x); is ($x,'35136.41828644462161665823116758077037159'); $x = $mbf->new('1.234567890123456789'); is ($x->copy()->bpow('0.5',0),$x->copy()->bpow('0.5',undef)); is ($x->copy()->bpow('0.5',0),$x->copy()->bsqrt(undef)); is ($x->copy()->bpow('2',0),'1.524157875323883675019051998750190521'); ############################################################################### # test (also under Bare) that bfac() rounds at last step is ($mbi->new(12)->bfac(),'479001600'); is ($mbi->new(12)->bfac(2),'480000000'); $x = $mbi->new(12); $x->accuracy(2); is ($x->bfac(),'480000000'); $x = $mbi->new(13); $x->accuracy(2); is ($x->bfac(),'6200000000'); $x = $mbi->new(13); $x->accuracy(3); is ($x->bfac(),'6230000000'); $x = $mbi->new(13); $x->accuracy(4); is ($x->bfac(),'6227000000'); # this does 1,2,3...9,10,11,12...20 $x = $mbi->new(20); $x->accuracy(1); is ($x->bfac(),'2000000000000000000'); ############################################################################### # test bsqrt) rounding to given A/P/R (bug prior to v1.60) $x = $mbi->new('123456')->bsqrt(2,undef); is ($x,'350'); # not 351 $x = $mbi->new('3')->bsqrt(2,undef); is ($x->accuracy(),2); $mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf'); is ($x,'360'); # not 355 nor 350 $x = $mbi->new('126025')->bsqrt(undef,2); is ($x,'400'); # not 355 ############################################################################### # test mixed arguments $x = $mbf->new(10); $u = $mbf->new(2.5); $y = $mbi->new(2); $z = $x + $y; is ($z,12); is (ref($z),$mbf); $z = $x / $y; is ($z,5); is (ref($z),$mbf); $z = $u * $y; is ($z,5); is (ref($z),$mbf); $y = $mbi->new(12345); $z = $u->copy()->bmul($y,2,undef,'odd'); is ($z,31000); $z = $u->copy()->bmul($y,3,undef,'odd'); is ($z,30900); $z = $u->copy()->bmul($y,undef,0,'odd'); is ($z,30863); $z = $u->copy()->bmul($y,undef,1,'odd'); is ($z,30863); $z = $u->copy()->bmul($y,undef,2,'odd'); is ($z,30860); $z = $u->copy()->bmul($y,undef,3,'odd'); is ($z,30900); $z = $u->copy()->bmul($y,undef,-1,'odd'); is ($z,30862.5); my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; }; # these should no longer warn, even tho '3.17' is a NaN in BigInt (>= returns # now false, bug until v1.80) $warn = ''; eval "\$z = 3.17 <= \$y"; is ($z, ''); unlike ($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/); $warn = ''; eval "\$z = \$y >= 3.17"; is ($z, ''); unlike ($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/); # XXX TODO breakage: # $z = $y->copy()->bmul($u,2,0,'odd'); is ($z,31000); # $z = $y * $u; is ($z,5); is (ref($z),$mbi); # $z = $y + $x; is ($z,12); is (ref($z),$mbi); # $z = $y / $x; is ($z,0); is (ref($z),$mbi); ############################################################################### # rounding in bdiv with fallback and already set A or P { no strict 'refs'; ${"$mbf\::accuracy"} = undef; ${"$mbf\::precision"} = undef; ${"$mbf\::div_scale"} = 40; } $x = $mbf->new(10); $x->{_a} = 4; is ($x->bdiv(3),'3.333'); is ($x->{_a},4); # set's it since no fallback $x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3); is ($x->bdiv($y),'3.333'); is ($x->{_a},4); # set's it since no fallback # rounding to P of x $x = $mbf->new(10); $x->{_p} = -2; is ($x->bdiv(3),'3.33'); # round in div with requested P $x = $mbf->new(10); is ($x->bdiv(3,undef,-2),'3.33'); # round in div with requested P greater than fallback { no strict 'refs'; ${"$mbf\::div_scale"} = 5; $x = $mbf->new(10); is ($x->bdiv(3,undef,-8),'3.33333333'); ${"$mbf\::div_scale"} = 40; } $x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4; is ($x->bdiv($y),'3.333'); is ($x->{_a},4); is ($y->{_a},4); # set's it since no fallback is ($x->{_p}, undef); is ($y->{_p}, undef); # rounding to P of y $x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2; is ($x->bdiv($y),'3.33'); is ($x->{_p},-2); is ($y->{_p},-2); is ($x->{_a}, undef); is ($y->{_a}, undef); ############################################################################### # test whether bround(-n) fails in MBF (undocumented in MBI) eval { $x = $mbf->new(1); $x->bround(-2); }; like ($@, qr/^bround\(\) needs positive accuracy/); # test whether rounding to higher accuracy is no-op $x = $mbf->new(1); $x->{_a} = 4; is ($x,'1.000'); $x->bround(6); # must be no-op is ($x->{_a},4); is ($x,'1.000'); $x = $mbi->new(1230); $x->{_a} = 3; is ($x,'1230'); $x->bround(6); # must be no-op is ($x->{_a},3); is ($x,'1230'); # bround(n) should set _a $x->bround(2); # smaller works is ($x,'1200'); is ($x->{_a},2); # bround(-n) is undocumented and only used by MBF # bround(-n) should set _a $x = $mbi->new(12345); $x->bround(-1); is ($x,'12300'); is ($x->{_a},4); # bround(-n) should set _a $x = $mbi->new(12345); $x->bround(-2); is ($x,'12000'); is ($x->{_a},3); # bround(-n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(-3); is ($x,'10000'); is ($x->{_a},2); # bround(-n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(-4); is ($x,'0'); is ($x->{_a},1); # bround(-n) should be noop if n too big $x = $mbi->new(12345); $x->bround(-5); is ($x,'0'); # scale to "big" => 0 is ($x->{_a},0); # bround(-n) should be noop if n too big $x = $mbi->new(54321); $x->bround(-5); is ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000 is ($x->{_a},0); # bround(-n) should be noop if n too big $x = $mbi->new(54321); $x->{_a} = 5; $x->bround(-6); is ($x,'100000'); # no-op is ($x->{_a},0); # bround(n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(5); # must be no-op is ($x,'12345'); is ($x->{_a},5); # bround(n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(6); # must be no-op is ($x,'12345'); $x = $mbf->new('0.0061'); $x->bfround(-2); is ($x,'0.01'); $x = $mbf->new('0.004'); $x->bfround(-2); is ($x,'0.00'); $x = $mbf->new('0.005'); $x->bfround(-2); is ($x,'0.00'); $x = $mbf->new('12345'); $x->bfround(2); is ($x,'12340'); $x = $mbf->new('12340'); $x->bfround(2); is ($x,'12340'); # MBI::bfround should clear A for negative P $x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2); is ($x->{_a}, undef); # test that bfround() and bround() work with large numbers $x = $mbf->new(1)->bdiv(5678,undef,-63); is ($x, '0.000176118351532229658330398027474462839027826699542092286016203'); $x = $mbf->new(1)->bdiv(5678,undef,-90); is ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651'); $x = $mbf->new(1)->bdiv(5678,80); is ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662'); ############################################################################### # rounding with already set precision/accuracy $x = $mbf->new(1); $x->{_p} = -5; is ($x,'1.00000'); # further rounding donw is ($x->bfround(-2),'1.00'); is ($x->{_p},-2); $x = $mbf->new(12345); $x->{_a} = 5; is ($x->bround(2),'12000'); is ($x->{_a},2); $x = $mbf->new('1.2345'); $x->{_a} = 5; is ($x->bround(2),'1.2'); is ($x->{_a},2); # mantissa/exponent format and A/P $x = $mbf->new('12345.678'); $x->accuracy(4); is ($x,'12350'); is ($x->{_a},4); is ($x->{_p}, undef); #is ($x->{_m}->{_a}, undef); is ($x->{_e}->{_a}, undef); #is ($x->{_m}->{_p}, undef); is ($x->{_e}->{_p}, undef); # check for no A/P in case of fallback # result $x = $mbf->new(100) / 3; is ($x->{_a}, undef); is ($x->{_p}, undef); # result & reminder $x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3); is ($x->{_a}, undef); is ($x->{_p}, undef); is ($y->{_a}, undef); is ($y->{_p}, undef); ############################################################################### # math with two numbers with different A and P $x = $mbf->new(12345); $x->accuracy(4); # '12340' $y = $mbf->new(12345); $y->accuracy(2); # '12000' is ($x+$y,24000); # 12340+12000=> 24340 => 24000 $x = $mbf->new(54321); $x->accuracy(4); # '12340' $y = $mbf->new(12345); $y->accuracy(3); # '12000' is ($x-$y,42000); # 54320+12300=> 42020 => 42000 $x = $mbf->new('1.2345'); $x->precision(-2); # '1.23' $y = $mbf->new('1.2345'); $y->precision(-4); # '1.2345' is ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46 ############################################################################### # round should find and use proper class #$x = Foo->new(); #is ($x->round($Foo::accuracy),'a' x $Foo::accuracy); #is ($x->round(undef,$Foo::precision),'p' x $Foo::precision); #is ($x->bfround($Foo::precision),'p' x $Foo::precision); #is ($x->bround($Foo::accuracy),'a' x $Foo::accuracy); ############################################################################### # find out whether _find_round_parameters is doing what's it's supposed to do { no strict 'refs'; ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = undef; ${"$mbi\::div_scale"} = 40; ${"$mbi\::round_mode"} = 'odd'; } $x = $mbi->new(123); my @params = $x->_find_round_parameters(); is (scalar @params,1); # nothing to round @params = $x->_find_round_parameters(1); is (scalar @params,4); # a=1 is ($params[0],$x); # self is ($params[1],1); # a is ($params[2], undef); # p is ($params[3],'odd'); # round_mode @params = $x->_find_round_parameters(undef,2); is (scalar @params,4); # p=2 is ($params[0],$x); # self is ($params[1], undef); # a is ($params[2],2); # p is ($params[3],'odd'); # round_mode eval { @params = $x->_find_round_parameters(undef,2,'foo'); }; like ($@, qr/^Unknown round mode 'foo'/); @params = $x->_find_round_parameters(undef,2,'+inf'); is (scalar @params,4); # p=2 is ($params[0],$x); # self is ($params[1], undef); # a is ($params[2],2); # p is ($params[3],'+inf'); # round_mode @params = $x->_find_round_parameters(2,-2,'+inf'); is (scalar @params,1); # error, A and P defined is ($params[0],$x); # self { no strict 'refs'; ${"$mbi\::accuracy"} = 1; @params = $x->_find_round_parameters(undef,-2); is (scalar @params,1); # error, A and P defined is ($params[0],$x); # self is ($x->is_nan(),1); # and must be NaN ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = 1; @params = $x->_find_round_parameters(1,undef); is (scalar @params,1); # error, A and P defined is ($params[0],$x); # self is ($x->is_nan(),1); # and must be NaN ${"$mbi\::precision"} = undef; # reset } ############################################################################### # test whether bone/bzero take additional A & P, or reset it etc foreach my $c ($mbi,$mbf) { $x = $c->new(2)->bzero(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2)->bone(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2)->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2)->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef); $x = $c->new(2,1); is ($x->{_a},1); is ($x->{_p}, undef); $x = $c->new(2,undef,1); is ($x->{_a}, undef); is ($x->{_p},1); $x = $c->new(2,1)->bzero(); is ($x->{_a},1); is ($x->{_p}, undef); $x = $c->new(2,undef,1)->bzero(); is ($x->{_a}, undef); is ($x->{_p},1); $x = $c->new(2,1)->bone(); is ($x->{_a},1); is ($x->{_p}, undef); $x = $c->new(2,undef,1)->bone(); is ($x->{_a}, undef); is ($x->{_p},1); $x = $c->new(2); $x->bone('+',2,undef); is ($x->{_a},2); is ($x->{_p}, undef); $x = $c->new(2); $x->bone('+',undef,2); is ($x->{_a}, undef); is ($x->{_p},2); $x = $c->new(2); $x->bone('-',2,undef); is ($x->{_a},2); is ($x->{_p}, undef); $x = $c->new(2); $x->bone('-',undef,2); is ($x->{_a}, undef); is ($x->{_p},2); $x = $c->new(2); $x->bzero(2,undef); is ($x->{_a},2); is ($x->{_p}, undef); $x = $c->new(2); $x->bzero(undef,2); is ($x->{_a}, undef); is ($x->{_p},2); } ############################################################################### # test whether bone/bzero honour globals for my $c ($mbi,$mbf) { $c->accuracy(2); $x = $c->bone(); is ($x->accuracy(),2); $x = $c->bzero(); is ($x->accuracy(),2); $c->accuracy(undef); $c->precision(-2); $x = $c->bone(); is ($x->precision(),-2); $x = $c->bzero(); is ($x->precision(),-2); $c->precision(undef); } ############################################################################### # check whether mixing A and P creates a NaN # new with set accuracy/precision and with parameters { no strict 'refs'; foreach my $c ($mbi,$mbf) { is ($c->new(123,4,-3),'NaN'); # with parameters ${"$c\::accuracy"} = 42; ${"$c\::precision"} = 2; is ($c->new(123),'NaN'); # with globals ${"$c\::accuracy"} = undef; ${"$c\::precision"} = undef; } } # binary ops foreach my $class ($mbi,$mbf) { foreach (qw/add sub mul pow mod/) #foreach (qw/add sub mul div pow mod/) { my $try = "my \$x = $class->new(1234); \$x->accuracy(5); "; $try .= "my \$y = $class->new(12); \$y->precision(-3); "; $try .= "\$x->b$_(\$y);"; $rc = eval $try; print "# Tried: '$try'\n" if !is ($rc, 'NaN'); } } # unary ops foreach (qw/new bsqrt/) { my $try = 'my $x = $mbi->$_(1234,5,-3); '; $rc = eval $try; print "# Tried: '$try'\n" if !is ($rc, 'NaN'); } # see if $x->bsub(0) and $x->badd(0) really round foreach my $class ($mbi,$mbf) { $x = $class->new(123); $class->accuracy(2); $x->bsub(0); is ($x,120); $class->accuracy(undef); $x = $class->new(123); $class->accuracy(2); $x->badd(0); is ($x,120); $class->accuracy(undef); } ############################################################################### # test whether shortcuts returning zero/one preserve A and P my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args); my $CALC = Math::BigInt->config()->{lib}; while () { $_ =~ s/[\n\r]//g; # remove newlines next if /^\s*(#|$)/; # skip comments and empty lines if (s/^&//) { $f = $_; next; # function } @args = split(/:/,$_,99); my $ans = pop(@args); ($x,$xa,$xp) = split (/,/,$args[0]); $xa = $xa || ''; $xp = $xp || ''; $try = "\$x = $mbi->new('$x'); "; $try .= "\$x->accuracy($xa); " if $xa ne ''; $try .= "\$x->precision($xp); " if $xp ne ''; ($y,$ya,$yp) = split (/,/,$args[1]); $ya = $ya || ''; $yp = $yp || ''; $try .= "\$y = $mbi->new('$y'); "; $try .= "\$y->accuracy($ya); " if $ya ne ''; $try .= "\$y->precision($yp); " if $yp ne ''; $try .= "\$x->$f(\$y);"; # print "trying $try\n"; $rc = eval $try; # convert hex/binary targets to decimal if ($ans =~ /^(0x0x|0b0b)/) { $ans =~ s/^0[xb]//; $ans = $mbi->new($ans)->bstr(); } print "# Tried: '$try'\n" if !is ($rc, $ans); # check internal state of number objects is_valid($rc,$f) if ref $rc; # now check whether A and P are set correctly # only one of $a or $p will be set (no crossing here) $a = $xa || $ya; $p = $xp || $yp; # print "Check a=$a p=$p\n"; # print "# Tried: '$try'\n"; if ($a ne '') { if (!(is ($x->{_a}, $a) && is ($x->{_p}, undef))) { print "# Check: A=$a and P=undef\n"; print "# Tried: '$try'\n"; } } if ($p ne '') { if (!(is ($x->{_p}, $p) && is($x->{_a}, undef))) { print "# Check: A=undef and P=$p\n"; print "# Tried: '$try'\n"; } } } # all done 1; ############################################################################### # sub to check validity of a BigInt internally, to ensure that no op leaves a # number object in an invalid state (f.i. "-0") sub is_valid { my ($x,$f) = @_; my $e = 0; # error? # ok as reference? $e = 'Not a reference' if !ref($x); # has ok sign? $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'" if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; $e = $CALC->_check($x->{value}) if $e eq '0'; # test done, see if error did crop up is (1,1), return if ($e eq '0'); is (1,$e." after op '$f'"); } # format is: # x,A,P:x,A,P:result # 123,,3 means 123 with precision 3 (A is undef) # the A or P of the result is calculated automatically __DATA__ &badd 123,,:123,,:246 123,3,:0,,:123 123,,-3:0,,:123 123,,:0,3,:123 123,,:0,,-3:123 &bmul 123,,:1,,:123 123,3,:0,,:0 123,,-3:0,,:0 123,,:0,3,:0 123,,:0,,-3:0 123,3,:1,,:123 123,,-3:1,,:123 123,,:1,3,:123 123,,:1,,-3:123 1,3,:123,,:123 1,,-3:123,,:123 1,,:123,3,:123 1,,:123,,-3:123 &bdiv 123,,:1,,:123 123,4,:1,,:123 123,,:1,4,:123 123,,:1,,-4:123 123,,-4:1,,:123 1,4,:123,,:0 1,,:123,4,:0 1,,:123,,-4:0 1,,-4:123,,:0 &band 1,,:3,,:1 1234,1,:0,,:0 1234,,:0,1,:0 1234,,-1:0,,:0 1234,,:0,,-1:0 0xFF,,:0x10,,:0x0x10 0xFF,2,:0xFF,,:250 0xFF,,:0xFF,2,:250 0xFF,,1:0xFF,,:250 0xFF,,:0xFF,,1:250 &bxor 1,,:3,,:2 1234,1,:0,,:1000 1234,,:0,1,:1000 1234,,3:0,,:1000 1234,,:0,,3:1000 0xFF,,:0x10,,:239 # 250 ^ 255 => 5 0xFF,2,:0xFF,,:5 0xFF,,:0xFF,2,:5 0xFF,,1:0xFF,,:5 0xFF,,:0xFF,,1:5 # 250 ^ 4095 = 3845 => 3800 0xFF,2,:0xFFF,,:3800 # 255 ^ 4100 = 4347 => 4300 0xFF,,:0xFFF,2,:4300 0xFF,,2:0xFFF,,:3800 # 255 ^ 4100 = 10fb => 4347 => 4300 0xFF,,:0xFFF,,2:4300 &bior 1,,:3,,:3 1234,1,:0,,:1000 1234,,:0,1,:1000 1234,,3:0,,:1000 1234,,:0,,3:1000 0xFF,,:0x10,,:0x0xFF # FF | FA = FF => 250 250,2,:0xFF,,:250 0xFF,,:250,2,:250 0xFF,,1:0xFF,,:250 0xFF,,:0xFF,,1:250 &bpow 2,,:3,,:8 2,,:0,,:1 2,2,:0,,:1 2,,:0,2,:1