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