perl
view release on metacpan or search on metacpan
cpan/Math-BigInt/t/mbimbf.inc view on Meta::CPAN
${"$mbi\::accuracy"} = 4;
${"$mbi\::precision"} = undef;
is($mbi->new(123456), 123500, qq|$mbi->new(123456) = 123500|); # with A
${"$mbi\::accuracy"} = undef;
${"$mbi\::precision"} = 3;
is($mbi->new(123456), 123000, qq|$mbi->new(123456) = 123000|); # with P
${"$mbf\::accuracy"} = 4;
${"$mbf\::precision"} = undef;
${"$mbi\::precision"} = undef;
is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
${"$mbf\::accuracy"} = undef;
${"$mbf\::precision"} = -1;
is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
${"$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", qq|$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", qq|\$x = $mbf->new("123.456"); \$x->accuracy(4)|);
$x = $mbf->new("123.456");
$x->precision(-2);
is($x, "123.46", qq|\$x = $mbf->new("123.456"); \$x->precision(-2)|);
$x = $mbi->new(123456);
$x->accuracy(4);
is($x, 123500, qq|\$x = $mbi->new(123456); \$x->accuracy(4)|);
$x = $mbi->new(123456);
$x->precision(2);
is($x, 123500, qq|\$x = $mbi->new(123456); \$x->precision(2)|);
###############################################################################
# test actual rounding via round()
$x = $mbf->new("123.456");
is($x->copy()->round(5), "123.46",
qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5)|);
is($x->copy()->round(4), "123.5",
qq|\$x = $mbf->new("123.456"); \$x->copy()->round(4)|);
is($x->copy()->round(5, 2), "NaN",
qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5, 2)|);
is($x->copy()->round(undef, -2), "123.46",
qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, -2)|);
is($x->copy()->round(undef, 2), 120,
qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, 2)|);
$x = $mbi->new("123");
is($x->round(5, 2), "NaN",
qq|\$x = $mbi->new("123"); \$x->round(5, 2)|);
$x = $mbf->new("123.45000");
is($x->copy()->round(undef, -1, "odd"), "123.5",
qq|\$x = $mbf->new("123.45000"); \$x->copy()->round(undef, -1, "odd")|);
# 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,
qq|\$x = $mbf->new("123.4567"); \$y = \$x->copy()->bround()|);
$y = $x->copy()->round(5);
is($y->accuracy(), 5,
q|$y = $x->copy()->round(5); $y->accuracy()|);
is($y->precision(), undef, # A has precedence, so P still unset
q|$y = $x->copy()->round(5); $y->precision()|);
$y = $x->copy()->round(undef, 2);
is($y->precision(), 2,
q|$y = $x->copy()->round(undef, 2); $y->precision()|);
is($y->accuracy(), undef, # P has precedence, so A still unset
q|$y = $x->copy()->round(undef, 2); $y->accuracy()|);
# see if setting A clears P and vice versa
$x = $mbf->new("123.4567");
is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
is($x->accuracy(4), 4, q|$x->accuracy(4)|);
is($x->precision(-2), -2, q|$x->precision(-2)|); # clear A
is($x->accuracy(), undef, q|$x->accuracy()|);
$x = $mbf->new("123.4567");
is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
is($x->precision(-2), -2, q|$x->precision(-2)|);
is($x->accuracy(4), 4, q|$x->accuracy(4)|); # clear P
is($x->precision(), undef, q|$x->precision()|);
# does copy work?
$x = $mbf->new(123.456);
$x->accuracy(4);
$x->precision(2);
$z = $x->copy();
is($z->accuracy(), undef, q|$z = $x->copy(); $z->accuracy()|);
is($z->precision(), 2, q|$z = $x->copy(); $z->precision()|);
# 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) {
is(scalar $x->copy()->bdiv(3, $e), "0.002" . ("6" x ($e - 2)) . "7",
qq|\$x->copy()->bdiv(3, $e)|);
}
# does accuracy()/precision work on zeros?
foreach my $class ($mbi, $mbf) {
$x = $class->bzero();
$x->accuracy(5);
is($x->{accuracy}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{accuracy}|);
cpan/Math-BigInt/t/mbimbf.inc view on Meta::CPAN
###############################################################################
# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
$x = $mbi->new('123456')->bsqrt(2, undef);
is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351
$x = $mbi->new('3')->bsqrt(2, undef);
is($x->accuracy(), 2, q|$x->accuracy()|);
$mbi->round_mode('even');
$x = $mbi->new('126025')->bsqrt(2, undef, '+inf');
is($x, '360', q|$x = 360|); # not 355 nor 350
$x = $mbi->new('126025')->bsqrt(undef, 2);
is($x, '400', q|$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, q|$z = $x + $y;|);
is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
$z = $x / $y;
is($z, 5, q|$z = $x / $y;|);
is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
$z = $u * $y;
is($z, 5, q|$z = $u * $y;|);
is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
$y = $mbi->new(12345);
$z = $u->copy()->bmul($y, 2, undef, 'odd');
is($z, 31000, q|$z = 31000|);
$z = $u->copy()->bmul($y, 3, undef, 'odd');
is($z, 30900, q|$z = 30900|);
$z = $u->copy()->bmul($y, undef, 0, 'odd');
is($z, 30863, q|$z = 30863|);
$z = $u->copy()->bmul($y, undef, 1, 'odd');
is($z, 30863, q|$z = 30863|);
$z = $u->copy()->bmul($y, undef, 2, 'odd');
is($z, 30860, q|$z = 30860|);
$z = $u->copy()->bmul($y, undef, 3, 'odd');
is($z, 30900, q|$z = 30900|);
$z = $u->copy()->bmul($y, undef, -1, 'odd');
is($z, 30862.5, q|$z = 30862.5|);
my $warn = '';
$SIG{__WARN__} = sub { $warn = shift; };
# These should no longer warn, even though '3.17' is a NaN in Math::BigInt
# (>= returns now false, bug until v1.80).
$warn = '';
eval '$z = 3.17 <= $y';
is($z, '', q|$z = ""|);
unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/,
q|"$z = $y >= 3.17" gives warning as expected|);
$warn = '';
eval '$z = $y >= 3.17';
is($z, '', q|$z = ""|);
unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/,
q|"$z = $y >= 3.17" gives warning as expected|);
# XXX TODO breakage:
#
# $z = $y->copy()->bmul($u, 2, 0, 'odd');
# is($z, 31000);
#
# $z = $y * $u;
# is($z, 5);
# is(ref($z), $mbi, q|\$z is a $mbi object|);
#
# $z = $y + $x;
# is($z, 12);
# is(ref($z), $mbi, q|\$z is a $mbi object|);
#
# $z = $y / $x;
# is($z, 0);
# is(ref($z), $mbi, q|\$z is a $mbi object|);
###############################################################################
# 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->{accuracy} = 4;
is($x->bdiv(3), '3.333', q|$x->bdiv(3)|);
is($x->{accuracy}, 4, q|$x->{accuracy}|); # set's it since no fallback
$x = $mbf->new(10);
$x->{accuracy} = 4;
$y = $mbf->new(3);
is($x->bdiv($y), '3.333', q|$x->bdiv($y)|);
is($x->{accuracy}, 4, q|$x->{accuracy}|); # set's it since no fallback
# rounding to P of x
$x = $mbf->new(10);
$x->{precision} = -2;
is($x->bdiv(3), '3.33', q|$x->bdiv(3)|);
# round in div with requested P
$x = $mbf->new(10);
is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|);
cpan/Math-BigInt/t/mbimbf.inc view on Meta::CPAN
###############################################################################
# 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, q|scalar(@params) = 1|); # nothing to round
@params = $x->_find_round_parameters(1);
is(scalar(@params), 4, q|scalar(@params) = 4|); # a=1
is($params[0], $x, q|$params[0] = $x|); # self
is($params[1], 1, q|$params[1] = 1|); # a
is($params[2], undef, q|$params[2] = undef|); # p
is($params[3], "odd", q|$params[3] = "odd"|); # round_mode
@params = $x->_find_round_parameters(undef, 2);
is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2
is($params[0], $x, q|$params[0] = $x|); # self
is($params[1], undef, q|$params[1] = undef|); # a
is($params[2], 2, q|$params[2] = 2|); # p
is($params[3], "odd", q|$params[3] = "odd"|); # round_mode
eval { @params = $x->_find_round_parameters(undef, 2, "foo"); };
like($@, qr/^Unknown round mode 'foo'/,
q|round mode "foo" gives a warning as expected|);
@params = $x->_find_round_parameters(undef, 2, "+inf");
is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2
is($params[0], $x, q|$params[0] = $x|); # self
is($params[1], undef, q|$params[1] = undef|); # a
is($params[2], 2, q|$params[2] = 2|); # p
is($params[3], "+inf", q|$params[3] = "+inf"|); # round_mode
@params = $x->_find_round_parameters(2, -2, "+inf");
is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined
is($params[0], $x, q|$params[0] = $x|); # self
{
no strict 'refs';
${"$mbi\::accuracy"} = 1;
@params = $x->_find_round_parameters(undef, -2);
is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined
is($params[0], $x, q|$params[0] = $x|); # self
is($x->is_nan(), 1, q|$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, q|scalar(@params) = 1|); # error, A and P defined
is($params[0], $x, q|$params[0] = $x|); # self
is($x->is_nan(), 1, q|$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 $class ($mbi, $mbf) {
$x = $class->new(2)->bzero();
is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{accuracy}|);
is($x->{precision}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{precision}|);
$x = $class->new(2)->bone();
is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bone(); \$x->{accuracy}|);
is($x->{precision}, undef, qq|\$x = $class->new(2)->bone(); \$x->{precision}|);
$x = $class->new(2)->binf();
is($x->{accuracy}, undef, qq|\$x = $class->new(2)->binf(); \$x->{accuracy}|);
is($x->{precision}, undef, qq|\$x = $class->new(2)->binf(); \$x->{precision}|);
$x = $class->new(2)->bnan();
is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{accuracy}|);
is($x->{precision}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{precision}|);
note "Verify that bnan() does not delete/undefine accuracy and precision.";
$x = $class->new(2);
$x->{accuracy} = 1;
$x->bnan();
is($x->{accuracy}, 1, qq|\$x = $class->new(2); \$x->{accuracy} = 1; \$x->bnan(); \$x->{accuracy}|);
$x = $class->new(2);
$x->{precision} = 1;
$x->bnan();
is($x->{precision}, 1, qq|\$x = $class->new(2); \$x->{precision} = 1; \$x->bnan(); \$x->{precision}|);
note "Verify that binf() does not delete/undefine accuracy and precision.";
$x = $class->new(2);
$x->{accuracy} = 1;
$x->binf();
is($x->{accuracy}, 1, qq|\$x = $class->new(2); \$x->{accuracy} = 1; \$x->binf(); \$x->{accuracy}|);
$x = $class->new(2);
$x->{precision} = 1;
$x->binf();
is($x->{precision}, 1, qq|\$x = $class->new(2); \$x->{precision} = 1; \$x->binf(); \$x->{precision}|);
note "Verify that accuracy can be set as argument to new().";
$x = $class->new(2, 1);
is($x->{accuracy}, 1, qq|\$x = $class->new(2, 1); \$x->{accuracy}|);
is($x->{precision}, undef, qq|\$x = $class->new(2, 1); \$x->{precision}|);
note "Verify that precision can be set as argument to new().";
$x = $class->new(2, undef, 1);
is($x->{accuracy}, undef, qq|\$x = $class->new(2, undef, 1); \$x->{accuracy}|);
is($x->{precision}, 1, qq|\$x = $class->new(2, undef, 1); \$x->{precision}|);
cpan/Math-BigInt/t/mbimbf.inc view on Meta::CPAN
}
$x = $class->new(2, 5);
is($x->accuracy(), 5,
qq|$class->accuracy(2); \$x = $class->new(2, 5); \$x->accuracy()|);
SKIP: {
skip 1, "this won't work until we have a better OO implementation";
$x = $class->new(2, undef);
is($x->accuracy(), undef,
qq|$class->accuracy(2); \$x = $class->new(2, undef); \$x->accuracy()|);
}
$class->accuracy(undef); # reset
note "Verify that setting precision as method argument overrides class variable";
$class->precision(-2); # set
$x = $class->bzero(undef, -6);
is($x->precision(), -6,
qq|$class->precision(-2); \$x = $class->bzero(undef, -6); \$x->precision()|);
SKIP: {
skip 1, "this won't work until we have a better OO implementation";
$x = $class->bzero(undef, undef);
is($x->precision(), undef,
qq|$class->precision(-2); \$x = $class->bzero(undef, undef); \$x->precision()|);
}
$x = $class->bone("+", undef, -6);
is($x->precision(), -6,
qq|$class->precision(-2); \$x = $class->bone("+", undef, -6); \$x->precision()|);
SKIP: {
skip 1, "this won't work until we have a better OO implementation";
$x = $class->bone("+", undef, undef);
is($x->precision(), undef,
qq|$class->precision(-2); \$x = $class->bone("+", undef, undef); \$x->precision()|);
}
$x = $class->new(2, undef, -6);
is($x->precision(), -6,
qq|$class->precision(-2); \$x = $class->new(2, undef, -6); \$x->precision()|);
SKIP: {
skip 1, "this won't work until we have a better OO implementation";
$x = $class->new(2, undef, undef);
is($x->precision(), undef,
qq|$class->precision(-2); \$x = $class->new(2, undef, undef); \$x->precision()|);
}
$class->precision(undef); # reset
}
###############################################################################
# check whether mixing A and P creates a NaN
# new with set accuracy/precision and with parameters
{
no strict 'refs';
foreach my $class ($mbi, $mbf) {
is($class->new(123, 4, -3), 'NaN', # with parameters
"mixing A and P creates a NaN");
${"$class\::accuracy"} = 42;
${"$class\::precision"} = 2;
is($class->new(123), "NaN", # with globals
q|$class->new(123) = "NaN"|);
${"$class\::accuracy"} = undef;
${"$class\::precision"} = undef;
}
}
# binary ops
foreach my $class ($mbi, $mbf) {
#foreach (qw/add sub mul div pow mod/) {
foreach my $method (qw/add sub mul pow mod/) {
my $try = "my \$x = $class->new(1234); \$x->accuracy(5);";
$try .= " my \$y = $class->new(12); \$y->precision(-3);";
$try .= " \$x->b$method(\$y);";
$rc = eval $try;
is($rc, "NaN", $try);
}
}
# unary ops
foreach my $method (qw/new bsqrt/) {
my $try = "my \$x = $mbi->$method(1234, 5, -3);";
$rc = eval $try;
is($rc, "NaN", $try);
}
# 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, q|$x = 120|);
$class->accuracy(undef); # reset
$x = $class->new(123);
$class->accuracy(2);
$x->badd(0);
is($x, 120, q|$x = 120|);
$class->accuracy(undef); # reset
}
###############################################################################
# test whether shortcuts returning zero/one preserve A and P
my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args);
my $LIB = Math::BigInt->config('lib');
while (<DATA>) {
s/#.*$//; # remove comments
s/\s+$//; # remove trailing whitespace
next unless length; # skip empty lines
if (s/^&//) {
$f = $_; # function
next;
}
@args = split(/:/, $_);
my $want = pop(@args);
($x, $xa, $xp) = split (/,/, $args[0]);
$xa = $xa || '';
$xp = $xp || '';
$try = qq|\$x = $mbi->new("$x");|;
$try .= qq| \$x->accuracy($xa);| if $xa ne '';
$try .= qq| \$x->precision($xp);| if $xp ne '';
($y, $ya, $yp) = split (/,/, $args[1]);
$ya = $ya || '';
$yp = $yp || '';
$try .= qq| \$y = $mbi->new("$y");|;
$try .= qq| \$y->accuracy($ya);| if $ya ne '';
$try .= qq| \$y->precision($yp);| if $yp ne '';
$try .= ' $x->' . $f . '($y);';
# print "trying $try\n";
$rc = eval $try;
print "# Error: $@\n" if $@;
# convert hex/binary targets to decimal
if ($want =~ /^(0x0x|0b0b)/) {
$want =~ s/^0[xb]//;
$want = $mbi->new($want)->bstr();
}
is($rc, $want, $try);
# 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 '') {
unless (is($x->{accuracy}, $a, qq|\$x->{accuracy} == $a|) &&
is($x->{precision}, undef, qq|\$x->{precision} is undef|))
{
print "# Check: A = $a and P = undef\n";
print "# Tried: $try\n";
}
}
if ($p ne '') {
unless (is($x->{precision}, $p, qq|\$x->{precision} == $p|) &&
is($x->{accuracy}, undef, qq|\$x->{accuracy} is undef|))
{
print "# Check: A = undef and P = $p\n";
print "# Tried: $try\n";
}
}
}
# all done
1;
###############################################################################
# sub to check validity of a Math::BigInt object 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 = qq|Illegal sign $x->{sign}|
. q| (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 = $LIB->_check($x->{value}) if $e eq '0';
# test done, see if error did crop up
if ($e eq '0') {
pass('is a valid object');
return;
}
fail($e . qq| 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
( run in 0.272 second using v1.01-cache-2.11-cpan-ec4f86ec37b )