dslinux/user/perl/lib/Math/BigInt/t _e_math.t alias.inc bare_mbf.t bare_mbi.t bare_mif.t bigfltpm.inc bigfltpm.t bigintc.t bigintpm.inc bigintpm.t bigints.t biglog.t bigroot.t calling.t config.t const_mbf.t constant.t downgrade.t fallback.t inf_nan.t isa.t lib_load.t mbf_ali.t mbi_ali.t mbi_rand.t mbimbf.inc mbimbf.t req_mbf0.t req_mbf1.t req_mbfa.t req_mbfi.t req_mbfn.t req_mbfw.t require.t sub_ali.t sub_mbf.t sub_mbi.t sub_mif.t trap.t upgrade.inc upgrade.t upgradef.t use.t use_lib1.t use_lib2.t use_lib3.t use_lib4.t use_mbfw.t with_sub.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:50 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Math/BigInt/t
In directory antilope:/tmp/cvs-serv17422/lib/Math/BigInt/t
Added Files:
_e_math.t alias.inc bare_mbf.t bare_mbi.t bare_mif.t
bigfltpm.inc bigfltpm.t bigintc.t bigintpm.inc bigintpm.t
bigints.t biglog.t bigroot.t calling.t config.t const_mbf.t
constant.t downgrade.t fallback.t inf_nan.t isa.t lib_load.t
mbf_ali.t mbi_ali.t mbi_rand.t mbimbf.inc mbimbf.t req_mbf0.t
req_mbf1.t req_mbfa.t req_mbfi.t req_mbfn.t req_mbfw.t
require.t sub_ali.t sub_mbf.t sub_mbi.t sub_mif.t trap.t
upgrade.inc upgrade.t upgradef.t use.t use_lib1.t use_lib2.t
use_lib3.t use_lib4.t use_mbfw.t with_sub.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: trap.t ---
#!/usr/bin/perl -w
# test that config ( trap_nan => 1, trap_inf => 1) really works/dies
use strict;
use Test::More;
BEGIN
{
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
plan tests => 43;
}
use Math::BigInt;
use Math::BigFloat;
my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
my ($cfg,$x);
foreach my $class ($mbi, $mbf)
{
# can do and defaults are okay?
ok ($class->can('config'), 'can config()');
is ($class->config()->{trap_nan}, 0, 'trap_nan defaults to 0');
is ($class->config()->{trap_inf}, 0, 'trap_inf defaults to 0');
# can set?
$cfg = $class->config( trap_nan => 1 );
is ($cfg->{trap_nan},1, 'trap_nan now true');
# also test that new() still works normally
eval ("\$x = \$class->new('42'); \$x->bnan();");
like ($@, qr/^Tried to set/, 'died');
is ($x,42,'$x after new() never modified');
# can reset?
$cfg = $class->config( trap_nan => 0 );
is ($cfg->{trap_nan}, 0, 'trap_nan disabled');
# can set?
$cfg = $class->config( trap_inf => 1 );
is ($cfg->{trap_inf}, 1, 'trap_inf enabled');
eval ("\$x = \$class->new('4711'); \$x->binf();");
like ($@, qr/^Tried to set/, 'died');
is ($x,4711,'$x after new() never modified');
eval ("\$x = \$class->new('inf');");
like ($@, qr/^Tried to set/, 'died');
is ($x,4711,'$x after new() never modified');
eval ("\$x = \$class->new('-inf');");
like ($@, qr/^Tried to set/, 'died');
is ($x,4711,'$x after new() never modified');
# +$x/0 => +inf
eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
like ($@, qr/^Tried to set/, 'died');
is ($x,4711,'$x after new() never modified');
# -$x/0 => -inf
eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
like ($@, qr/^Tried to set/, 'died');
is ($x,'-815', '$x after new not modified');
$cfg = $class->config( trap_nan => 1 );
# 0/0 => NaN
eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
like ($@, qr/^Tried to set/, 'died');
is ($x,'0', '$x after new not modified');
}
##############################################################################
# BigInt
$x = Math::BigInt->new(2);
eval ("\$x = \$mbi->new('0.1');");
is ($x,2,'never modified since it dies');
eval ("\$x = \$mbi->new('0a.1');");
is ($x,2,'never modified since it dies');
##############################################################################
# BigFloat
$x = Math::BigFloat->new(2);
eval ("\$x = \$mbf->new('0.1a');");
is ($x,2,'never modified since it dies');
# all tests done
--- NEW FILE: req_mbfw.t ---
#!/usr/bin/perl -w
# check that requiring BigFloat and then calling import() works
use strict;
use Test::More;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbfw.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 3;
}
# normal require that calls import automatically (we thus have MBI afterwards)
require Math::BigFloat;
my $x = Math::BigFloat->new(1); ++$x;
is ($x,2, '$x is 2');
like (Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, 'with ignored' );
# now override
Math::BigFloat->import ( with => 'Math::BigInt::Subclass' );
# the "with" argument is ignored
like (Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, 'with ignored' );
# all tests done
--- NEW FILE: mbi_rand.t ---
#!/usr/bin/perl -w
use Test;
use strict;
my $count;
BEGIN
{
$| = 1;
if ($^O eq 'os390') { print "1..0\n"; exit(0) } # test takes too long there
unshift @INC, '../lib'; # for running manually
my $location = $0; $location =~ s/mbi_rand.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
$count = 128;
plan tests => $count*4;
}
use Math::BigInt;
my $c = 'Math::BigInt';
my $length = 128;
# If you get a failure here, please re-run the test with the printed seed
# value as input "perl t/mbi_rand.t seed" and send me the output
my $seed = ($#ARGV == 0) ? $ARGV[0] : int(rand(1165537));
print "# seed: $seed\n"; srand($seed);
print "# lib: ", Math::BigInt->config()->{lib},"\n";
if (Math::BigInt->config()->{lib} =~ /::Calc/)
{
print "# base len: ", scalar Math::BigInt::Calc->_base_len(),"\n";
}
my ($A,$B,$As,$Bs,$ADB,$AMB,$la,$lb);
my $two = Math::BigInt->new(2);
for (my $i = 0; $i < $count; $i++)
{
# length of A and B
$la = int(rand($length)+1); $lb = int(rand($length)+1);
$As = ''; $Bs = '';
# we create the numbers from "patterns", e.g. get a random number and a
# random count and string them together. This means things like
# "100000999999999999911122222222" are much more likely. If we just strung
# together digits, we would end up with "1272398823211223" etc. It also means
# that we get more frequently equal numbers or other special cases.
while (length($As) < $la) { $As .= int(rand(100)) x int(rand(16)); }
while (length($Bs) < $lb) { $Bs .= int(rand(100)) x int(rand(16)); }
$As =~ s/^0+//; $Bs =~ s/^0+//;
$As = $As || '0'; $Bs = $Bs || '0';
# print "# As $As\n# Bs $Bs\n";
$A = $c->new($As); $B = $c->new($Bs);
print "# A $A\n# B $B\n";
if ($A->is_zero() || $B->is_zero())
{
for (1..4) { ok (1,1); } next;
}
# check that int(A/B)*B + A % B == A holds for all inputs
# $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B);
($ADB,$AMB) = $A->copy()->bdiv($B);
print "# ($A / $B, $A % $B ) = $ADB $AMB\n";
print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
"# tried $ADB * $B + $two*$AMB - $AMB\n"
unless ok ($ADB*$B+$two*$AMB-$AMB,$As);
if (ok ($ADB*$B/$B,$ADB))
{
print "# seed: $seed, \$ADB * \$B / \$B = ", $ADB * $B / $B, " != $ADB (\$B=$B)\n";
if (Math::BigInt->config()->{lib} =~ /::Calc/)
{
print "# ADB->[-1]: ", $ADB->{value}->[-1], " B->[-1]: ", $B->{value}->[-1],"\n";
}
}
# swap 'em and try this, too
# $X = ($B/$A)*$A + $B % $A;
($ADB,$AMB) = $B->copy()->bdiv($A);
# print "check: $ADB $AMB";
print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
"# tried $ADB * $A + $two*$AMB - $AMB\n"
unless ok ($ADB*$A+$two*$AMB-$AMB,$Bs);
print "# +$two * $AMB = ",$ADB * $A + $two * $AMB,"\n";
print "# -$AMB = ",$ADB * $A + $two * $AMB - $AMB,"\n";
print "# seed $seed, \$ADB * \$A / \$A = ", $ADB * $A / $A, " != $ADB (\$A=$A)\n"
unless ok ($ADB*$A/$A,$ADB);
}
--- NEW FILE: bigintc.t ---
#!/usr/bin/perl -w
use strict;
use Test;
BEGIN
{
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
plan tests => 308;
}
use Math::BigInt::Calc;
my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) =
Math::BigInt::Calc->_base_len();
print "# BASE_LEN = $BASE_LEN\n";
print "# MAX_VAL = $MAX_VAL\n";
print "# AND_BITS = $AND_BITS\n";
print "# XOR_BITS = $XOR_BITS\n";
print "# IOR_BITS = $OR_BITS\n";
# testing of Math::BigInt::Calc
my $C = 'Math::BigInt::Calc'; # pass classname to sub's
# _new and _str
my $x = $C->_new("123"); my $y = $C->_new("321");
ok (ref($x),'ARRAY'); ok ($C->_str($x),123); ok ($C->_str($y),321);
###############################################################################
# _add, _sub, _mul, _div
ok ($C->_str($C->_add($x,$y)),444);
ok ($C->_str($C->_sub($x,$y)),123);
ok ($C->_str($C->_mul($x,$y)),39483);
ok ($C->_str($C->_div($x,$y)),123);
###############################################################################
# check that mul/div doesn't change $y
# and returns the same reference, not something new
ok ($C->_str($C->_mul($x,$y)),39483);
ok ($C->_str($x),39483); ok ($C->_str($y),321);
ok ($C->_str($C->_div($x,$y)),123);
ok ($C->_str($x),123); ok ($C->_str($y),321);
$x = $C->_new("39483");
my ($x1,$r1) = $C->_div($x,$y);
ok ("$x1","$x");
$C->_inc($x1);
ok ("$x1","$x");
ok ($C->_str($r1),'0');
$x = $C->_new("39483"); # reset
###############################################################################
my $z = $C->_new("2");
ok ($C->_str($C->_add($x,$z)),39485);
my ($re,$rr) = $C->_div($x,$y);
ok ($C->_str($re),123); ok ($C->_str($rr),2);
# is_zero, _is_one, _one, _zero
ok ($C->_is_zero($x)||0,0);
ok ($C->_is_one($x)||0,0);
ok ($C->_str($C->_zero()),"0");
ok ($C->_str($C->_one()),"1");
# _two() and _ten()
ok ($C->_str($C->_two()),"2");
ok ($C->_str($C->_ten()),"10");
ok ($C->_is_ten($C->_two()),0);
ok ($C->_is_two($C->_two()),1);
ok ($C->_is_ten($C->_ten()),1);
ok ($C->_is_two($C->_ten()),0);
ok ($C->_is_one($C->_one()),1);
ok ($C->_is_one($C->_two()),0);
ok ($C->_is_one($C->_ten()),0);
ok ($C->_is_one($C->_zero()) || 0,0);
ok ($C->_is_zero($C->_zero()),1);
ok ($C->_is_zero($C->_one()) || 0,0);
# is_odd, is_even
ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero())||0,0);
ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1);
# _len
$x = $C->_new("1"); ok ($C->_len($x),1);
$x = $C->_new("12"); ok ($C->_len($x),2);
$x = $C->_new("123"); ok ($C->_len($x),3);
$x = $C->_new("1234"); ok ($C->_len($x),4);
$x = $C->_new("12345"); ok ($C->_len($x),5);
$x = $C->_new("123456"); ok ($C->_len($x),6);
$x = $C->_new("1234567"); ok ($C->_len($x),7);
$x = $C->_new("12345678"); ok ($C->_len($x),8);
$x = $C->_new("123456789"); ok ($C->_len($x),9);
$x = $C->_new("8"); ok ($C->_len($x),1);
$x = $C->_new("21"); ok ($C->_len($x),2);
$x = $C->_new("321"); ok ($C->_len($x),3);
$x = $C->_new("4321"); ok ($C->_len($x),4);
$x = $C->_new("54321"); ok ($C->_len($x),5);
$x = $C->_new("654321"); ok ($C->_len($x),6);
$x = $C->_new("7654321"); ok ($C->_len($x),7);
$x = $C->_new("87654321"); ok ($C->_len($x),8);
$x = $C->_new("987654321"); ok ($C->_len($x),9);
for (my $i = 1; $i < 9; $i++)
{
my $a = "$i" . '0' x ($i-1);
$x = $C->_new($a);
print "# Tried len '$a'\n" unless ok ($C->_len($x),$i);
}
# _digit
$x = $C->_new("123456789");
ok ($C->_digit($x,0),9);
ok ($C->_digit($x,1),8);
ok ($C->_digit($x,2),7);
ok ($C->_digit($x,-1),1);
ok ($C->_digit($x,-2),2);
ok ($C->_digit($x,-3),3);
# _copy
foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/)
{
$x = $C->_new("$_");
ok ($C->_str($C->_copy($x)),"$_");
ok ($C->_str($x),"$_"); # did _copy destroy original x?
}
# _zeros
$x = $C->_new("1256000000"); ok ($C->_zeros($x),6);
$x = $C->_new("152"); ok ($C->_zeros($x),0);
$x = $C->_new("123000"); ok ($C->_zeros($x),3);
$x = $C->_new("0"); ok ($C->_zeros($x),0);
# _lsft, _rsft
$x = $C->_new("10"); $y = $C->_new("3");
ok ($C->_str($C->_lsft($x,$y,10)),10000);
$x = $C->_new("20"); $y = $C->_new("3");
ok ($C->_str($C->_lsft($x,$y,10)),20000);
$x = $C->_new("128"); $y = $C->_new("4");
ok ($C->_str($C->_lsft($x,$y,2)), 128 << 4);
$x = $C->_new("1000"); $y = $C->_new("3");
ok ($C->_str($C->_rsft($x,$y,10)),1);
$x = $C->_new("20000"); $y = $C->_new("3");
ok ($C->_str($C->_rsft($x,$y,10)),20);
$x = $C->_new("256"); $y = $C->_new("4");
ok ($C->_str($C->_rsft($x,$y,2)),256 >> 4);
$x = $C->_new("6411906467305339182857313397200584952398");
$y = $C->_new("45");
ok ($C->_str($C->_rsft($x,$y,10)),0);
# _acmp
$x = $C->_new("123456789");
$y = $C->_new("987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
$x = $C->_new("12");
$y = $C->_new("12");
ok ($C->_acmp($x,$y),0);
$x = $C->_new("21");
ok ($C->_acmp($x,$y),1);
ok ($C->_acmp($y,$x),-1);
$x = $C->_new("123456789");
$y = $C->_new("1987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),+1);
$x = $C->_new("1234567890123456789");
$y = $C->_new("987654321012345678");
ok ($C->_acmp($x,$y),1);
ok ($C->_acmp($y,$x),-1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
$x = $C->_new("1234");
$y = $C->_new("987654321012345678");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
# _modinv
$x = $C->_new("8");
$y = $C->_new("5033");
my ($xmod,$sign) = $C->_modinv($x,$y);
ok ($C->_str($xmod),'629'); # -629 % 5033 == 4404
ok ($sign, '-');
# _div
$x = $C->_new("3333"); $y = $C->_new("1111");
ok ($C->_str(scalar $C->_div($x,$y)),3);
$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
ok ($C->_str($x),30); ok ($C->_str($y),3);
$x = $C->_new("123"); $y = $C->_new("1111");
($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123);
# _num
foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/)
{
$x = $C->_new("$_");
ok (ref($x)||'','ARRAY'); ok ($C->_str($x),"$_");
$x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_);
}
# _sqrt
$x = $C->_new("144"); ok ($C->_str($C->_sqrt($x)),'12');
$x = $C->_new("144000000000000"); ok ($C->_str($C->_sqrt($x)),'12000000');
# _root
$x = $C->_new("81"); my $n = $C->_new("3"); # 4*4*4 = 64, 5*5*5 = 125
ok ($C->_str($C->_root($x,$n)),'4'); # 4.xx => 4.0
$x = $C->_new("81"); $n = $C->_new("4"); # 3*3*3*3 == 81
ok ($C->_str($C->_root($x,$n)),'3');
# _pow (and _root)
$x = $C->_new("0"); $n = $C->_new("3"); # 0 ** y => 0
ok ($C->_str($C->_pow($x,$n)), 0);
$x = $C->_new("3"); $n = $C->_new("0"); # x ** 0 => 1
ok ($C->_str($C->_pow($x,$n)), 1);
$x = $C->_new("1"); $n = $C->_new("3"); # 1 ** y => 1
ok ($C->_str($C->_pow($x,$n)), 1);
$x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x
ok ($C->_str($C->_pow($x,$n)), 5);
$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441
ok ($C->_str($C->_pow($x,$n)),81 ** 3);
ok ($C->_str($C->_root($x,$n)),81);
$x = $C->_new("81");
ok ($C->_str($C->_pow($x,$n)),81 ** 3);
ok ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 ==
ok ($C->_str($C->_root($x,$n)),'531441');
ok ($C->_str($C->_root($x,$n)),'81');
$x = $C->_new("81"); $n = $C->_new("14");
ok ($C->_str($C->_pow($x,$n)),'523347633027360537213511521');
ok ($C->_str($C->_root($x,$n)),'81');
$x = $C->_new("523347633027360537213511520");
ok ($C->_str($C->_root($x,$n)),'80');
$x = $C->_new("523347633027360537213511522");
ok ($C->_str($C->_root($x,$n)),'81');
my $res = [ qw/ 9 31 99 316 999 3162 9999/ ];
# 99 ** 2 = 9801, 999 ** 2 = 998001 etc
for my $i (2 .. 9)
{
$x = '9' x $i; $x = $C->_new($x);
$n = $C->_new("2");
my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1';
print "# _pow( ", '9' x $i, ", 2) \n" unless
ok ($C->_str($C->_pow($x,$n)),$rc);
if ($i <= 7)
{
$x = '9' x $i; $x = $C->_new($x);
$n = '9' x $i; $n = $C->_new($n);
print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
ok ($C->_str($C->_root($x,$n)),'1');
$x = '9' x $i; $x = $C->_new($x);
$n = $C->_new("2");
print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
ok ($C->_str($C->_root($x,$n)), $res->[$i-2]);
}
}
##############################################################################
# _fac
$x = $C->_new("0"); ok ($C->_str($C->_fac($x)),'1');
$x = $C->_new("1"); ok ($C->_str($C->_fac($x)),'1');
$x = $C->_new("2"); ok ($C->_str($C->_fac($x)),'2');
$x = $C->_new("3"); ok ($C->_str($C->_fac($x)),'6');
$x = $C->_new("4"); ok ($C->_str($C->_fac($x)),'24');
$x = $C->_new("5"); ok ($C->_str($C->_fac($x)),'120');
$x = $C->_new("10"); ok ($C->_str($C->_fac($x)),'3628800');
$x = $C->_new("11"); ok ($C->_str($C->_fac($x)),'39916800');
$x = $C->_new("12"); ok ($C->_str($C->_fac($x)),'479001600');
$x = $C->_new("13"); ok ($C->_str($C->_fac($x)),'6227020800');
# test that _fac modifes $x in place for small arguments
$x = $C->_new("3"); $C->_fac($x); ok ($C->_str($x),'6');
$x = $C->_new("13"); $C->_fac($x); ok ($C->_str($x),'6227020800');
##############################################################################
# _inc and _dec
foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/)
{
$x = $C->_new("$_"); $C->_inc($x);
print "# \$x = ",$C->_str($x),"\n"
unless ok ($C->_str($x),substr($_,0,length($_)-1) . '2');
$C->_dec($x); ok ($C->_str($x),$_);
}
foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/)
{
$x = $C->_new("$_"); $C->_inc($x);
print "# \$x = ",$C->_str($x),"\n"
unless ok ($C->_str($x),substr($_,0,length($_)-2) . '20');
$C->_dec($x); ok ($C->_str($x),$_);
}
foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/)
{
$x = $C->_new("$_"); $C->_inc($x);
print "# \$x = ",$C->_str($x),"\n"
unless ok ($C->_str($x), '1' . '0' x (length($_)));
$C->_dec($x); ok ($C->_str($x),$_);
}
$x = $C->_new("1000"); $C->_inc($x); ok ($C->_str($x),'1001');
$C->_dec($x); ok ($C->_str($x),'1000');
my $BL;
{
no strict 'refs';
$BL = &{"$C"."::_base_len"}();
}
$x = '1' . '0' x $BL;
$z = '1' . '0' x ($BL-1); $z .= '1';
$x = $C->_new($x); $C->_inc($x); ok ($C->_str($x),$z);
$x = '1' . '0' x $BL; $z = '9' x $BL;
$x = $C->_new($x); $C->_dec($x); ok ($C->_str($x),$z);
# should not happen:
# $x = $C->_new("-2"); $y = $C->_new("4"); ok ($C->_acmp($x,$y),-1);
###############################################################################
# _mod
$x = $C->_new("1000"); $y = $C->_new("3");
ok ($C->_str(scalar $C->_mod($x,$y)),1);
$x = $C->_new("1000"); $y = $C->_new("2");
ok ($C->_str(scalar $C->_mod($x,$y)),0);
# _and, _or, _xor
$x = $C->_new("5"); $y = $C->_new("2");
ok ($C->_str(scalar $C->_xor($x,$y)),7);
$x = $C->_new("5"); $y = $C->_new("2");
ok ($C->_str(scalar $C->_or($x,$y)),7);
$x = $C->_new("5"); $y = $C->_new("3");
ok ($C->_str(scalar $C->_and($x,$y)),1);
# _from_hex, _from_bin
ok ($C->_str( $C->_from_hex("0xFf")),255);
ok ($C->_str( $C->_from_bin("0b10101011")),160+11);
# _as_hex, _as_bin
ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("128")))), 128);
ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("128")))), 128);
ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("0")))), 0);
ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("0")))), 0);
ok ($C->_as_hex( $C->_new("0")), '0x0');
ok ($C->_as_bin( $C->_new("0")), '0b0');
ok ($C->_as_hex( $C->_new("12")), '0xc');
ok ($C->_as_bin( $C->_new("12")), '0b1100');
# _check
$x = $C->_new("123456789");
ok ($C->_check($x),0);
ok ($C->_check(123),'123 is not a reference');
###############################################################################
# __strip_zeros
{
no strict 'refs';
# correct empty arrays
$x = &{$C."::__strip_zeros"}([]); ok (@$x,1); ok ($x->[0],0);
# don't strip single elements
$x = &{$C."::__strip_zeros"}([0]); ok (@$x,1); ok ($x->[0],0);
$x = &{$C."::__strip_zeros"}([1]); ok (@$x,1); ok ($x->[0],1);
# don't strip non-zero elements
$x = &{$C."::__strip_zeros"}([0,1]);
ok (@$x,2); ok ($x->[0],0); ok ($x->[1],1);
$x = &{$C."::__strip_zeros"}([0,1,2]);
ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
# but strip leading zeros
$x = &{$C."::__strip_zeros"}([0,1,2,0]);
ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
$x = &{$C."::__strip_zeros"}([0,1,2,0,0]);
ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
$x = &{$C."::__strip_zeros"}([0,1,2,0,0,0]);
ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
# collapse multiple zeros
$x = &{$C."::__strip_zeros"}([0,0,0,0]);
ok (@$x,1); ok ($x->[0],0);
}
# done
1;
--- NEW FILE: const_mbf.t ---
#!/usr/bin/perl -w
# test BigFloat constants alone (w/o BigInt loading)
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/const_mbf.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
if ($] < 5.006)
{
for (1..2) { skip (1,'Not supported on older Perls'); }
exit;
}
}
use Math::BigFloat ':constant';
ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333');
# BigInt was not loadede with ':constant', so only floats are handled
ok (ref(2 ** 2),'');
--- NEW FILE: use.t ---
#!/usr/bin/perl -w
# use Module(); doesn't call import() - thanx for cpan testers David. M. Town
# and Andreas Marcel Riechert for spotting it. It is fixed by the same code
# that fixes require Math::BigInt, but we make a test to be sure it really
# works.
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
my ($try,$ans,$x);
use Math::BigInt(); $x = Math::BigInt->new(1); ++$x;
ok ($x||'undef',2);
# all tests done
1;
--- NEW FILE: bare_mbi.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bare_mbi.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 3015;
}
use Math::BigInt lib => 'BareCalc';
print "# ",Math::BigInt->config()->{lib},"\n";
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt";
$CL = "Math::BigInt::BareCalc";
my $version = '1.61'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
--- NEW FILE: bigfltpm.inc ---
#include this file into another test for subclass testing...
ok ($class->config()->{lib},$CL);
use strict;
my $z;
while (<DATA>)
{
chomp;
$_ =~ s/#.*$//; # remove comments
$_ =~ s/\s+$//; # trailing spaces
next if /^$/; # skip empty lines & comments
if (s/^&//)
{
$f = $_;
}
elsif (/^\$/)
[...1601 lines suppressed...]
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-52
12.2:12
0.12345:0
0.123456:0
0.1234567:0
0.12345678:0
0.123456789:0
&fceil
0:0
abc:NaN
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-51
12.2:13
--- NEW FILE: mbimbf.t ---
#!/usr/bin/perl -w
# test rounding, accuracy, precicion and fallback, round_mode and mixing
# of classes
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/mbimbf.t//i;
if ($ENV{PERL_CORE})
{
@INC = qw(../lib); # testing with the core distribution
}
else
{
unshift @INC, '../lib'; # for testing manually
}
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 684
+ 23; # own tests
}
use Math::BigInt 1.70;
use Math::BigFloat 1.43;
use vars qw/$mbi $mbf/;
$mbi = 'Math::BigInt';
$mbf = 'Math::BigFloat';
require 'mbimbf.inc';
# some tests that won't work with subclasses, since the things are only
# garantied in the Math::BigInt/BigFloat (unless subclass chooses to support
# this)
Math::BigInt->round_mode('even'); # reset for tests
Math::BigFloat->round_mode('even'); # reset for tests
ok ($Math::BigInt::rnd_mode,'even');
ok ($Math::BigFloat::rnd_mode,'even');
my $x = eval '$mbi->round_mode("huhmbi");';
print "# Got '$@'\n" unless
ok ($@ =~ /^Unknown round mode 'huhmbi' at/);
$x = eval '$mbf->round_mode("huhmbf");';
print "# Got '$@'\n" unless
ok ($@ =~ /^Unknown round mode 'huhmbf' at/);
# old way (now with test for validity)
$x = eval '$Math::BigInt::rnd_mode = "huhmbi";';
print "# Got '$@'\n" unless
ok ($@ =~ /^Unknown round mode 'huhmbi' at/);
$x = eval '$Math::BigFloat::rnd_mode = "huhmbf";';
print "# Got '$@'\n" unless
ok ($@ =~ /^Unknown round mode 'huhmbf' at/);
# see if accessor also changes old variable
$mbi->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
$mbf->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
foreach my $class (qw/Math::BigInt Math::BigFloat/)
{
ok ($class->accuracy(5),5); # set A
ok_undef ($class->precision()); # and now P must be cleared
ok ($class->precision(5),5); # set P
ok_undef ($class->accuracy()); # and now A must be cleared
}
foreach my $class (qw/Math::BigInt Math::BigFloat/)
{
$class->accuracy(42);
my $x = $class->new(123); # $x gets A of 42, too!
ok ($x->accuracy(),42); # really?
ok ($x->accuracy(undef),42); # $x has no A, but the
# global is still in effect for $x
# so the return value of that operation should
# be 42, not undef
ok ($x->accuracy(),42); # so $x should still have A = 42
$class->accuracy(undef); # reset for further tests
$class->precision(undef);
}
# bug with flog(Math::BigFloat,Math::BigInt)
$x = Math::BigFloat->new(100);
$x = $x->blog(Math::BigInt->new(10));
ok ($x,2);
--- NEW FILE: biglog.t ---
#!/usr/bin/perl -w
# Test blog function (and bpow, since it uses blog).
# It is too slow to be simple included in bigfltpm.inc, where it would get
# executed 3 times. One time would be under BareCalc, which shouldn't make any
# difference since there is no CALC->_log() function, and one time under a
# subclass, which *should* work.
# But it is better to test the numerical functionality, instead of not testing
# it at all (which did lead to wrong answers for 0 < $x < 1 in blog() in
# versions up to v1.63, and for bsqrt($x) when $x << 1 for instance).
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/biglog.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 53;
}
use Math::BigFloat;
use Math::BigInt;
my $cl = "Math::BigFloat";
# These tests are now really fast, since they collapse to blog(10), basically
# Don't attempt to run them with older versions. You are warned.
# $x < 0 => NaN
ok ($cl->new(-2)->blog(), 'NaN');
ok ($cl->new(-1)->blog(), 'NaN');
ok ($cl->new(-10)->blog(), 'NaN');
ok ($cl->new(-2,2)->blog(), 'NaN');
my $ten = $cl->new(10)->blog();
# 10 is cached (up to 75 digits)
ok ($cl->new(10)->blog(), '2.302585092994045684017991454684364207601');
# 0.1 is using the cached value for log(10), too
ok ($cl->new(0.1)->blog(), -$ten);
ok ($cl->new(0.01)->blog(), -$ten * 2);
ok ($cl->new(0.001)->blog(), -$ten * 3);
ok ($cl->new(0.0001)->blog(), -$ten * 4);
# also cached
ok ($cl->new(2)->blog(), '0.6931471805599453094172321214581765680755');
ok ($cl->new(4)->blog(), $cl->new(2)->blog * 2);
# These are still slow, so do them only to 10 digits
ok ($cl->new('0.2')->blog(undef,10), '-1.609437912');
ok ($cl->new('0.3')->blog(undef,10), '-1.203972804');
ok ($cl->new('0.4')->blog(undef,10), '-0.9162907319');
ok ($cl->new('0.5')->blog(undef,10), '-0.6931471806');
ok ($cl->new('0.6')->blog(undef,10), '-0.5108256238');
ok ($cl->new('0.7')->blog(undef,10), '-0.3566749439');
ok ($cl->new('0.8')->blog(undef,10), '-0.2231435513');
ok ($cl->new('0.9')->blog(undef,10), '-0.1053605157');
ok ($cl->new('9')->blog(undef,10), '2.197224577');
ok ($cl->new('10')->blog(10,10), '1.000000000');
ok ($cl->new('20')->blog(20,10), '1.000000000');
ok ($cl->new('100')->blog(100,10), '1.000000000');
ok ($cl->new('100')->blog(10,10), '2.000000000'); # 10 ** 2 == 100
ok ($cl->new('400')->blog(20,10), '2.000000000'); # 20 ** 2 == 400
ok ($cl->new('4')->blog(2,10), '2.000000000'); # 2 ** 2 == 4
ok ($cl->new('16')->blog(2,10), '4.000000000'); # 2 ** 4 == 16
ok ($cl->new('1.2')->bpow('0.3',10), '1.056219968');
ok ($cl->new('10')->bpow('0.6',10), '3.981071706');
# blog should handle bigint input
ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 2);
# some integer results
ok ($cl->new(2)->bpow(32)->blog(2), '32'); # 2 ** 32
ok ($cl->new(3)->bpow(32)->blog(3), '32'); # 3 ** 32
ok ($cl->new(2)->bpow(65)->blog(2), '65'); # 2 ** 65
# test for bug in bsqrt() not taking negative _e into account
test_bpow ('200','0.5',10, '14.14213562');
test_bpow ('20','0.5',10, '4.472135955');
test_bpow ('2','0.5',10, '1.414213562');
test_bpow ('0.2','0.5',10, '0.4472135955');
test_bpow ('0.02','0.5',10, '0.1414213562');
test_bpow ('0.49','0.5',undef , '0.7');
test_bpow ('0.49','0.5',10 , '0.7000000000');
test_bpow ('0.002','0.5',10, '0.04472135955');
test_bpow ('0.0002','0.5',10, '0.01414213562');
test_bpow ('0.0049','0.5',undef,'0.07');
test_bpow ('0.0049','0.5',10 , '0.07000000000');
test_bpow ('0.000002','0.5',10, '0.001414213562');
test_bpow ('0.021','0.5',10, '0.1449137675');
test_bpow ('1.2','0.5',10, '1.095445115');
test_bpow ('1.23','0.5',10, '1.109053651');
test_bpow ('12.3','0.5',10, '3.507135583');
test_bpow ('9.9','0.5',10, '3.146426545');
test_bpow ('9.86902225','0.5',10, '3.141500000');
test_bpow ('9.86902225','0.5',undef, '3.1415');
test_bpow ('0.2','0.41',10, '0.5169187652');
sub test_bpow
{
my ($x,$y,$scale,$result) = @_;
print "# Tried: $x->bpow($y,$scale);\n"
unless ok ($cl->new($x)->bpow($y,$scale),$result);
}
--- NEW FILE: lib_load.t ---
#!/usr/bin/perl -w
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_mbf.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
# first load BigInt with Calc
use Math::BigInt lib => 'Calc';
# BigFloat will remember that we loaded Calc
require Math::BigFloat;
is (Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', 'BigFloat got Calc');
# now load BigInt again with a different lib
Math::BigInt->import( lib => 'BareCalc' );
# and finally test that BigFloat knows about BareCalc
is (Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', 'BigFloat was notified');
--- NEW FILE: req_mbfn.t ---
#!/usr/bin/perl -w
# check that simple requiring BigFloat and then new() works
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbfn.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; ok ($x,2);
# all tests done
--- NEW FILE: _e_math.t ---
#!/usr/bin/perl -w
# test the helper math routines in Math::BigFloat
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/_e_math.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 26;
}
use Math::BigFloat lib => 'Calc';
#############################################################################
# add
my $a = Math::BigInt::Calc->_new("123");
my $b = Math::BigInt::Calc->_new("321");
my ($x, $xs) = Math::BigFloat::_e_add($a,$b,'+','+');
is (_str($x,$xs), '+444', 'add two positive numbers');
is (_str($a,''), '444', 'a modified');
($x,$xs) = _add (123,321,'+','+');
is (_str($x,$xs), '+444', 'add two positive numbers');
($x,$xs) = _add (123,321,'+','-');
is (_str($x,$xs), '-198', 'add +x + -y');
($x,$xs) = _add (123,321,'-','+');
is (_str($x,$xs), '+198', 'add -x + +y');
($x,$xs) = _add (321,123,'-','+');
is (_str($x,$xs), '-198', 'add -x + +y');
($x,$xs) = _add (321,123,'+','-');
is (_str($x,$xs), '+198', 'add +x + -y');
($x,$xs) = _add (10,1,'+','-');
is (_str($x,$xs), '+9', 'add 10 + -1');
($x,$xs) = _add (10,1,'-','+');
is (_str($x,$xs), '-9', 'add -10 + +1');
($x,$xs) = _add (1,10,'-','+');
is (_str($x,$xs), '+9', 'add -1 + 10');
($x,$xs) = _add (1,10,'+','-');
is (_str($x,$xs), '-9', 'add 1 + -10');
#############################################################################
# sub
$a = Math::BigInt::Calc->_new("123");
$b = Math::BigInt::Calc->_new("321");
($x, $xs) = Math::BigFloat::_e_sub($b,$a,'+','+');
is (_str($x,$xs), '+198', 'sub two positive numbers');
is (_str($b,''), '198', 'a modified');
($x,$xs) = _sub (123,321,'+','-');
is (_str($x,$xs), '+444', 'sub +x + -y');
($x,$xs) = _sub (123,321,'-','+');
is (_str($x,$xs), '-444', 'sub -x + +y');
sub _add
{
my ($a,$b,$as,$bs) = @_;
my $aa = Math::BigInt::Calc->_new($a);
my $bb = Math::BigInt::Calc->_new($b);
my ($x, $xs) = Math::BigFloat::_e_add($aa,$bb,$as,$bs);
is (Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa),
'param0 modified');
($x,$xs);
}
sub _sub
{
my ($a,$b,$as,$bs) = @_;
my $aa = Math::BigInt::Calc->_new($a);
my $bb = Math::BigInt::Calc->_new($b);
my ($x, $xs) = Math::BigFloat::_e_sub($aa,$bb,$as,$bs);
is (Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa),
'param0 modified');
($x,$xs);
}
sub _str
{
my ($x,$s) = @_;
$s . Math::BigInt::Calc->_str($x);
}
--- NEW FILE: downgrade.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
unshift @INC, '../lib'; # for running manually
my $location = $0; $location =~ s/downgrade.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
plan tests => 15;
}
use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat downgrade => 'Math::BigInt', upgrade => 'Math::BigInt';
use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup
$ECL $CL);
$class = "Math::BigInt";
$CL = "Math::BigInt::Calc";
$ECL = "Math::BigFloat";
# simplistic test for now
ok (Math::BigFloat->downgrade(),'Math::BigInt');
ok (Math::BigFloat->upgrade(),'Math::BigInt');
# these downgrade
ok (ref(Math::BigFloat->new('inf')),'Math::BigInt');
ok (ref(Math::BigFloat->new('-inf')),'Math::BigInt');
ok (ref(Math::BigFloat->new('NaN')),'Math::BigInt');
ok (ref(Math::BigFloat->new('0')),'Math::BigInt');
ok (ref(Math::BigFloat->new('1')),'Math::BigInt');
ok (ref(Math::BigFloat->new('10')),'Math::BigInt');
ok (ref(Math::BigFloat->new('-10')),'Math::BigInt');
ok (ref(Math::BigFloat->new('-10.0E1')),'Math::BigInt');
# bug until v1.67:
ok (Math::BigFloat->new('0.2E0'), '0.2');
ok (Math::BigFloat->new('0.2E1'), '2');
# until v1.67 resulted in 200:
ok (Math::BigFloat->new('0.2E2'), '20');
# disable, otherwise it screws calculations
Math::BigFloat->upgrade(undef);
ok (Math::BigFloat->upgrade()||'','');
Math::BigFloat->div_scale(20); # make it a bit faster
my $x = Math::BigFloat->new(2); # downgrades
# the following test upgrade for bsqrt() and also makes new() NOT downgrade
# for the bpow() side
ok (Math::BigFloat->bpow('2','0.5'),$x->bsqrt());
#require 'upgrade.inc'; # all tests here for sharing
--- NEW FILE: sub_mbi.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_mbi.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 3015
+ 5; # +5 own tests
}
use Math::BigInt::Subclass;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt::Subclass";
$CL = "Math::BigInt::Calc";
my $version = '0.02'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
###############################################################################
# Now do custom tests for Subclass itself
my $ms = $class->new(23);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
# Check that a subclass is still considered a BigInt
ok ($ms->isa('Math::BigInt'),1);
use Math::BigInt;
my $bi = Math::BigInt->new(23); # same as other
$ms += $bi;
print "# Tried: \$ms += \$bi, got $ms" if !ok (46, $ms);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));
--- NEW FILE: bigintpm.inc ---
#include this file into another for subclass testing
my $version = ${"$class\::VERSION"};
use strict;
##############################################################################
# for testing inheritance of _swap
package Math::Foo;
use Math::BigInt lib => $main::CL;
use vars qw/@ISA/;
@ISA = (qw/Math::BigInt/);
use overload
# customized overload for sub, since original does not use swap there
'-' => sub { my @a = ref($_[0])->_swap(@_);
$a[0]->bsub($a[1])};
[...2321 lines suppressed...]
128:0x80
-128:-0x80
0:0x0
-0:0x0
1:0x1
0x123456789123456789:0x123456789123456789
+inf:inf
-inf:-inf
NaNas_hex:NaN
&as_bin
128:0b10000000
-128:-0b10000000
0:0b0
-0:0b0
1:0b1
0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101
0x123456789123456789:0b100100011010001010110011110001001000100100011010001010110011110001001
+inf:inf
-inf:-inf
NaNas_bin:NaN
--- NEW FILE: upgrade.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/upgrade.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2100
+ 2; # our own tests
}
use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat;
use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup
$ECL $CL);
$class = "Math::BigInt";
$CL = "Math::BigInt::Calc";
$ECL = "Math::BigFloat";
ok (Math::BigInt->upgrade(),'Math::BigFloat');
ok (Math::BigInt->downgrade()||'','');
require 'upgrade.inc'; # all tests here for sharing
--- NEW FILE: isa.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/isa.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 7;
}
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
use Math::BigInt;
use Math::BigFloat;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt::Subclass";
$CL = "Math::BigInt::Calc";
# Check that a subclass is still considered a BigInt
ok ($class->new(123)->isa('Math::BigInt'),1);
# ditto for plain Math::BigInt
ok (Math::BigInt->new(123)->isa('Math::BigInt'),1);
# But Math::BigFloats aren't
ok (Math::BigFloat->new(123)->isa('Math::BigInt') || 0,0);
# see what happens if we feed a Math::BigFloat into new()
$x = Math::BigInt->new(Math::BigFloat->new(123));
ok (ref($x),'Math::BigInt');
ok ($x->isa('Math::BigInt'),1);
# ditto for subclass
$x = Math::BigInt->new(Math::BigFloat->new(123));
ok (ref($x),'Math::BigInt');
ok ($x->isa('Math::BigInt'),1);
--- NEW FILE: mbimbf.inc ---
# 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';
ok_undef (${"$mbi\::accuracy"});
ok_undef (${"$mbi\::precision"});
ok_undef ($mbi->accuracy());
ok_undef ($mbi->precision());
ok (${"$mbi\::div_scale"},40);
ok (${"$mbi\::round_mode"},'even');
ok ($mbi->round_mode(),'even');
ok_undef (${"$mbf\::accuracy"});
ok_undef (${"$mbf\::precision"});
ok_undef ($mbf->precision());
ok_undef ($mbf->precision());
ok (${"$mbf\::div_scale"},40);
ok (${"$mbf\::round_mode"},'even');
ok ($mbf->round_mode(),'even');
}
# accessors
foreach my $class ($mbi,$mbf)
{
ok_undef ($class->accuracy());
ok_undef ($class->precision());
ok ($class->round_mode(),'even');
ok ($class->div_scale(),40);
ok ($class->div_scale(20),20);
$class->div_scale(40); ok ($class->div_scale(),40);
ok ($class->round_mode('odd'),'odd');
$class->round_mode('even'); ok ($class->round_mode(),'even');
ok ($class->accuracy(2),2);
$class->accuracy(3); ok ($class->accuracy(),3);
ok_undef ($class->accuracy(undef));
ok ($class->precision(2),2);
ok ($class->precision(-2),-2);
$class->precision(3); ok ($class->precision(),3);
ok_undef ($class->precision(undef));
}
{
no strict 'refs';
# accuracy
foreach (qw/5 42 -1 0/)
{
ok (${"$mbf\::accuracy"} = $_,$_);
ok (${"$mbi\::accuracy"} = $_,$_);
}
ok_undef (${"$mbf\::accuracy"} = undef);
ok_undef (${"$mbi\::accuracy"} = undef);
# precision
foreach (qw/5 42 -1 0/)
{
ok (${"$mbf\::precision"} = $_,$_);
ok (${"$mbi\::precision"} = $_,$_);
}
ok_undef (${"$mbf\::precision"} = undef);
ok_undef (${"$mbi\::precision"} = undef);
# fallback
foreach (qw/5 42 1/)
{
ok (${"$mbf\::div_scale"} = $_,$_);
ok (${"$mbi\::div_scale"} = $_,$_);
}
# illegal values are possible for fallback due to no accessor
# round_mode
foreach (qw/odd even zero trunc +inf -inf/)
{
ok (${"$mbf\::round_mode"} = $_,$_);
ok (${"$mbi\::round_mode"} = $_,$_);
}
${"$mbf\::round_mode"} = 'zero';
ok (${"$mbf\::round_mode"},'zero');
ok (${"$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');
ok_undef ($x->accuracy());
ok ($x->accuracy(5),5);
ok_undef ($x->accuracy(undef),undef);
ok_undef ($x->precision());
ok ($x->precision(5),5);
ok_undef ($x->precision(undef),undef);
{
no strict 'refs';
# see if MBF changes MBIs values
ok (${"$mbi\::accuracy"} = 42,42);
ok (${"$mbf\::accuracy"} = 64,64);
ok (${"$mbi\::accuracy"},42); # should be still 42
ok (${"$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;
ok ($mbi->new(123456),123500); # with A
${"$mbi\::accuracy"} = undef;
${"$mbi\::precision"} = 3;
ok ($mbi->new(123456),123000); # with P
${"$mbf\::accuracy"} = 4;
${"$mbf\::precision"} = undef;
${"$mbi\::precision"} = undef;
ok ($mbf->new('123.456'),'123.5'); # with A
${"$mbf\::accuracy"} = undef;
${"$mbf\::precision"} = -1;
ok ($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;
ok ($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); ok ($x,'123.5');
$x = $mbf->new('123.456'); $x->precision(-2); ok ($x,'123.46');
$x = $mbi->new(123456); $x->accuracy(4); ok ($x,123500);
$x = $mbi->new(123456); $x->precision(2); ok ($x,123500);
###############################################################################
# test actual rounding via round()
$x = $mbf->new('123.456');
ok ($x->copy()->round(5),'123.46');
ok ($x->copy()->round(4),'123.5');
ok ($x->copy()->round(5,2),'NaN');
ok ($x->copy()->round(undef,-2),'123.46');
ok ($x->copy()->round(undef,2),120);
$x = $mbi->new('123');
ok ($x->round(5,2),'NaN');
$x = $mbf->new('123.45000');
ok ($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
ok ($y,123.4567);
$y = $x->copy()->round(5);
ok ($y->accuracy(),5);
ok_undef ($y->precision()); # A has precedence, so P still unset
$y = $x->copy()->round(undef,2);
ok ($y->precision(),2);
ok_undef ($y->accuracy()); # P has precedence, so A still unset
# see if setting A clears P and vice versa
$x = $mbf->new('123.4567');
ok ($x,'123.4567');
ok ($x->accuracy(4),4);
ok ($x->precision(-2),-2); # clear A
ok_undef ($x->accuracy());
$x = $mbf->new('123.4567');
ok ($x,'123.4567');
ok ($x->precision(-2),-2);
ok ($x->accuracy(4),4); # clear P
ok_undef ($x->precision());
# does copy work?
$x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2);
$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($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 ok (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); ok ($x->{_a},5);
$x = $c->bzero(); $x->precision(5); ok ($x->{_p},5);
$x = $c->new(0); $x->accuracy(5); ok ($x->{_a},5);
$x = $c->new(0); $x->precision(5); ok ($x->{_p},5);
$x = $c->bzero(); $x->round(5); ok ($x->{_a},5);
$x = $c->bzero(); $x->round(undef,5); ok ($x->{_p},5);
$x = $c->new(0); $x->round(5); ok ($x->{_a},5);
$x = $c->new(0); $x->round(undef,5); ok ($x->{_p},5);
# see if trying to increasing A in bzero() doesn't do something
$x = $c->bzero(); $x->{_a} = 3; $x->round(5); ok ($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
ok ($c->new(123)->badd(123),246);
ok ($c->badd(123,321),444);
ok ($c->badd(123,$c->new(321)),444);
ok ($c->new(123)->bsub(122),1);
ok ($c->bsub(321,123),198);
ok ($c->bsub(321,$c->new(123)),198);
ok ($c->new(123)->bmul(123),15129);
ok ($c->bmul(123,123),15129);
ok ($c->bmul(123,$c->new(123)),15129);
# ok ($c->new(15129)->bdiv(123),123);
# ok ($c->bdiv(15129,123),123);
# ok ($c->bdiv(15129,$c->new(123)),123);
ok ($c->new(15131)->bmod(123),2);
ok ($c->bmod(15131,123),2);
ok ($c->bmod(15131,$c->new(123)),2);
ok ($c->new(2)->bpow(16),65536);
ok ($c->bpow(2,16),65536);
ok ($c->bpow(2,$c->new(16)),65536);
ok ($c->new(2**15)->brsft(1),2**14);
ok ($c->brsft(2**15,1),2**14);
ok ($c->brsft(2**15,$c->new(1)),2**14);
ok ($c->new(2**13)->blsft(1),2**14);
ok ($c->blsft(2**13,1),2**14);
ok ($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 straightaway
$y->{_a} = 4; # $y->accuracy(4) would round $x straightaway
$z = $x + $y; ok ($z,'777.8');
$z = $y - $x; ok ($z,'530.9');
$z = $y * $x; ok ($z,'80780');
$z = $x ** 2; ok ($z,'15241');
$z = $x * $x; ok ($z,'15241');
# not: $z = -$x; ok ($z,'-123.46'); ok ($x,'123.456');
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
$x = $mbf->new(123456); $x->{_a} = 4;
$z = $x->copy; $z++; ok ($z,123500);
$x = $mbi->new(123456);
$y = $mbi->new(654321);
$x->{_a} = 5; # $x->accuracy(5) would round $x straightaway
$y->{_a} = 4; # $y->accuracy(4) would round $x straightaway
$z = $x + $y; ok ($z,777800);
$z = $y - $x; ok ($z,530900);
$z = $y * $x; ok ($z,80780000000);
$z = $x ** 2; ok ($z,15241000000);
# not yet: $z = -$x; ok ($z,-123460); ok ($x,123456);
$z = $x->copy; $z++; ok ($z,123460);
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
$x = $mbi->new(123400); $x->{_a} = 4;
ok ($x->bnot(),-123400); # not -1234001
# both babs() and bneg() don't need to round, since the input will already
# be rounded (either as $x or via new($string)), and they don't change the
# value. The two tests below peek at this by using _a (illegally) directly
$x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->babs(),123401);
$x = $mbi->new(-123401); $x->{_a} = 4; ok ($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'); ok ($x,'123.4');
$x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6;
ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over
$x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6;
ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over
$x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6;
ok ($x->bdiv($y),0); ok ($x->{_a},6); # carried over
$x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6;
ok ($x->bdiv($y),0); ok ($x->{_a},6); # carried over
###############################################################################
# test that bop(0) does the same than bop(undef)
$x = $mbf->new('1234567890');
ok ($x->copy()->bsqrt(0),$x->copy()->bsqrt(undef));
ok ($x->copy->bsqrt(0),'35136.41828644462161665823116758077037159');
ok_undef ($x->{_a});
# test that bsqrt() modifies $x and does not just return something else
# (especially under BareCalc)
$z = $x->bsqrt();
ok ($z,$x); ok ($x,'35136.41828644462161665823116758077037159');
$x = $mbf->new('1.234567890123456789');
ok ($x->copy()->bpow('0.5',0),$x->copy()->bpow('0.5',undef));
ok ($x->copy()->bpow('0.5',0),$x->copy()->bsqrt(undef));
ok ($x->copy()->bpow('2',0),'1.524157875323883675019051998750190521');
###############################################################################
# test (also under Bare) that bfac() rounds at last step
ok ($mbi->new(12)->bfac(),'479001600');
ok ($mbi->new(12)->bfac(2),'480000000');
$x = $mbi->new(12); $x->accuracy(2); ok ($x->bfac(),'480000000');
$x = $mbi->new(13); $x->accuracy(2); ok ($x->bfac(),'6200000000');
$x = $mbi->new(13); $x->accuracy(3); ok ($x->bfac(),'6230000000');
$x = $mbi->new(13); $x->accuracy(4); ok ($x->bfac(),'6227000000');
# this does 1,2,3...9,10,11,12...20
$x = $mbi->new(20); $x->accuracy(1); ok ($x->bfac(),'2000000000000000000');
###############################################################################
# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
$x = $mbi->new('123456')->bsqrt(2,undef); ok ($x,'350'); # not 351
$x = $mbi->new('3')->bsqrt(2,undef); ok ($x->accuracy(),2);
$mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf');
ok ($x,'360'); # not 355 nor 350
$x = $mbi->new('126025')->bsqrt(undef,2); ok ($x,'400'); # not 355
###############################################################################
# test mixed arguments
$x = $mbf->new(10);
$u = $mbf->new(2.5);
$y = $mbi->new(2);
$z = $x + $y; ok ($z,12); ok (ref($z),$mbf);
$z = $x / $y; ok ($z,5); ok (ref($z),$mbf);
$z = $u * $y; ok ($z,5); ok (ref($z),$mbf);
$y = $mbi->new(12345);
$z = $u->copy()->bmul($y,2,undef,'odd'); ok ($z,31000);
$z = $u->copy()->bmul($y,3,undef,'odd'); ok ($z,30900);
$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30863);
$z = $u->copy()->bmul($y,undef,2,'odd'); ok ($z,30860);
$z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900);
$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
# these should warn, since '3.17' is a NaN in BigInt and thus >= returns undef
$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1);
print "# Got: '$warn'\n" unless
ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);
$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1);
print "# Got: '$warn'\n" unless
ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);
# XXX TODO breakage:
# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
# $z = $y * $u; ok ($z,5); ok (ref($z),$mbi);
# $z = $y + $x; ok ($z,12); ok (ref($z),$mbi);
# $z = $y / $x; ok ($z,0); ok (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;
ok ($x->bdiv(3),'3.333');
ok ($x->{_a},4); # set's it since no fallback
$x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
ok ($x->bdiv($y),'3.333');
ok ($x->{_a},4); # set's it since no fallback
# rounding to P of x
$x = $mbf->new(10); $x->{_p} = -2;
ok ($x->bdiv(3),'3.33');
# round in div with requested P
$x = $mbf->new(10);
ok ($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);
ok ($x->bdiv(3,undef,-8),'3.33333333');
${"$mbf\::div_scale"} = 40;
}
$x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4;
ok ($x->bdiv($y),'3.333');
ok ($x->{_a},4); ok ($y->{_a},4); # set's it since no fallback
ok_undef ($x->{_p}); ok_undef ($y->{_p});
# rounding to P of y
$x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2;
ok ($x->bdiv($y),'3.33');
ok ($x->{_p},-2);
ok ($y->{_p},-2);
ok_undef ($x->{_a}); ok_undef ($y->{_a});
###############################################################################
# test whether bround(-n) fails in MBF (undocumented in MBI)
eval { $x = $mbf->new(1); $x->bround(-2); };
ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
# test whether rounding to higher accuracy is no-op
$x = $mbf->new(1); $x->{_a} = 4;
ok ($x,'1.000');
$x->bround(6); # must be no-op
ok ($x->{_a},4);
ok ($x,'1.000');
$x = $mbi->new(1230); $x->{_a} = 3;
ok ($x,'1230');
$x->bround(6); # must be no-op
ok ($x->{_a},3);
ok ($x,'1230');
# bround(n) should set _a
$x->bround(2); # smaller works
ok ($x,'1200');
ok ($x->{_a},2);
# bround(-n) is undocumented and only used by MBF
# bround(-n) should set _a
$x = $mbi->new(12345);
$x->bround(-1);
ok ($x,'12300');
ok ($x->{_a},4);
# bround(-n) should set _a
$x = $mbi->new(12345);
$x->bround(-2);
ok ($x,'12000');
ok ($x->{_a},3);
# bround(-n) should set _a
$x = $mbi->new(12345); $x->{_a} = 5;
$x->bround(-3);
ok ($x,'10000');
ok ($x->{_a},2);
# bround(-n) should set _a
$x = $mbi->new(12345); $x->{_a} = 5;
$x->bround(-4);
ok ($x,'0');
ok ($x->{_a},1);
# bround(-n) should be noop if n too big
$x = $mbi->new(12345);
$x->bround(-5);
ok ($x,'0'); # scale to "big" => 0
ok ($x->{_a},0);
# bround(-n) should be noop if n too big
$x = $mbi->new(54321);
$x->bround(-5);
ok ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000
ok ($x->{_a},0);
# bround(-n) should be noop if n too big
$x = $mbi->new(54321); $x->{_a} = 5;
$x->bround(-6);
ok ($x,'100000'); # no-op
ok ($x->{_a},0);
# bround(n) should set _a
$x = $mbi->new(12345); $x->{_a} = 5;
$x->bround(5); # must be no-op
ok ($x,'12345');
ok ($x->{_a},5);
# bround(n) should set _a
$x = $mbi->new(12345); $x->{_a} = 5;
$x->bround(6); # must be no-op
ok ($x,'12345');
$x = $mbf->new('0.0061'); $x->bfround(-2); ok ($x,'0.01');
$x = $mbf->new('0.004'); $x->bfround(-2); ok ($x,'0.00');
$x = $mbf->new('0.005'); $x->bfround(-2); ok ($x,'0.00');
$x = $mbf->new('12345'); $x->bfround(2); ok ($x,'12340');
$x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340');
# MBI::bfround should clear A for negative P
$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
ok_undef ($x->{_a});
# test that bfround() and bround() work with large numbers
$x = $mbf->new(1)->bdiv(5678,undef,-63);
ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203');
$x = $mbf->new(1)->bdiv(5678,undef,-90);
ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651');
$x = $mbf->new(1)->bdiv(5678,80);
ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662');
###############################################################################
# rounding with already set precision/accuracy
$x = $mbf->new(1); $x->{_p} = -5;
ok ($x,'1.00000');
# further rounding donw
ok ($x->bfround(-2),'1.00');
ok ($x->{_p},-2);
$x = $mbf->new(12345); $x->{_a} = 5;
ok ($x->bround(2),'12000');
ok ($x->{_a},2);
$x = $mbf->new('1.2345'); $x->{_a} = 5;
ok ($x->bround(2),'1.2');
ok ($x->{_a},2);
# mantissa/exponent format and A/P
$x = $mbf->new('12345.678'); $x->accuracy(4);
ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
#ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
#ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
# check for no A/P in case of fallback
# result
$x = $mbf->new(100) / 3;
ok_undef ($x->{_a}); ok_undef ($x->{_p});
# result & reminder
$x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3);
ok_undef ($x->{_a}); ok_undef ($x->{_p});
ok_undef ($y->{_a}); ok_undef ($y->{_p});
###############################################################################
# math with two numbers with differen A and P
$x = $mbf->new(12345); $x->accuracy(4); # '12340'
$y = $mbf->new(12345); $y->accuracy(2); # '12000'
ok ($x+$y,24000); # 12340+12000=> 24340 => 24000
$x = $mbf->new(54321); $x->accuracy(4); # '12340'
$y = $mbf->new(12345); $y->accuracy(3); # '12000'
ok ($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'
ok ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46
###############################################################################
# round should find and use proper class
#$x = Foo->new();
#ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
#ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
#ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
#ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
###############################################################################
# find out whether _find_round_parameters is doing what's it's supposed to do
{
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();
ok (scalar @params,1); # nothing to round
@params = $x->_find_round_parameters(1);
ok (scalar @params,4); # a=1
ok ($params[0],$x); # self
ok ($params[1],1); # a
ok_undef ($params[2]); # p
ok ($params[3],'odd'); # round_mode
@params = $x->_find_round_parameters(undef,2);
ok (scalar @params,4); # p=2
ok ($params[0],$x); # self
ok_undef ($params[1]); # a
ok ($params[2],2); # p
ok ($params[3],'odd'); # round_mode
eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
ok ($@ =~ /^Unknown round mode 'foo'/,1);
@params = $x->_find_round_parameters(undef,2,'+inf');
ok (scalar @params,4); # p=2
ok ($params[0],$x); # self
ok_undef ($params[1]); # a
ok ($params[2],2); # p
ok ($params[3],'+inf'); # round_mode
@params = $x->_find_round_parameters(2,-2,'+inf');
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
{
no strict 'refs';
${"$mbi\::accuracy"} = 1;
@params = $x->_find_round_parameters(undef,-2);
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
ok ($x->is_nan(),1); # and must be NaN
${"$mbi\::accuracy"} = undef;
${"$mbi\::precision"} = 1;
@params = $x->_find_round_parameters(1,undef);
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
ok ($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(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $c->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
$x = $c->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
$x = $c->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
$x = $c->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
$x = $c->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
$x = $c->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
$x = $c->new(2); $x->bone('+',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
$x = $c->new(2); $x->bone('+',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
$x = $c->new(2); $x->bone('-',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
$x = $c->new(2); $x->bone('-',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
$x = $c->new(2); $x->bzero(2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
$x = $c->new(2); $x->bzero(undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
}
###############################################################################
# test whether bone/bzero honour globals
for my $c ($mbi,$mbf)
{
$c->accuracy(2);
$x = $c->bone(); ok ($x->accuracy(),2);
$x = $c->bzero(); ok ($x->accuracy(),2);
$c->accuracy(undef);
$c->precision(-2);
$x = $c->bone(); ok ($x->precision(),-2);
$x = $c->bzero(); ok ($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)
{
ok ($c->new(123,4,-3),'NaN'); # with parameters
${"$c\::accuracy"} = 42;
${"$c\::precision"} = 2;
ok ($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 !ok ($rc, 'NaN');
}
}
# unary ops
foreach (qw/new bsqrt/)
{
my $try = 'my $x = $mbi->$_(1234,5,-3); ';
$rc = eval $try;
print "# Tried: '$try'\n" if !ok ($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);
ok ($x,120);
$class->accuracy(undef);
$x = $class->new(123); $class->accuracy(2); $x->badd(0);
ok ($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, at args);
my $CALC = Math::BigInt->config()->{lib};
while (<DATA>)
{
chomp;
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 !ok ($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 (!(ok ($x->{_a}, $a) && ok_undef ($x->{_p})))
{
print "# Check: A=$a and P=undef\n";
print "# Tried: '$try'\n";
}
}
if ($p ne '')
{
if (!(ok ($x->{_p}, $p) && ok_undef ($x->{_a})))
{
print "# Check: A=undef and P=$p\n";
print "# Tried: '$try'\n";
}
}
}
# all done
1;
###############################################################################
###############################################################################
# Perl 5.005 does not like ok ($x,undef)
sub ok_undef
{
my $x = shift;
ok (1,1) and return 1 if !defined $x;
ok ($x,'undef');
print "# Called from ",join(' ',caller()),"\n";
return 0;
}
###############################################################################
# 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
ok (1,1), return if ($e eq '0');
ok (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
--- NEW FILE: upgrade.inc ---
# include this file into another for subclass testing
# This file is nearly identical to bigintpm.t, except that certain results
# are _requird_ to be different due to "upgrading" or "promoting" to BigFloat.
# The reverse is not true, any unmarked results can be either BigInt or
# BigFloat, depending on how good the internal optimization is (e.g. it
# is usually desirable to have 2 ** 2 return a BigInt, not a BigFloat).
# Results that are required to be BigFloat are marked with C<^> at the end.
# Please note that the testcount goes up by two for each extra result marked
# with ^, since then we test whether it has the proper class and that it left
# the upgrade variable alone.
my $version = ${"$class\::VERSION"};
##############################################################################
# for testing inheritance of _swap
[...1458 lines suppressed...]
&as_hex
128:0x80
-128:-0x80
0:0x0
-0:0x0
1:0x1
0x123456789123456789:0x123456789123456789
+inf:inf
-inf:-inf
NaNas_hex:NaN
&as_bin
128:0b10000000
-128:-0b10000000
0:0b0
-0:0b0
1:0b1
0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101
+inf:inf
-inf:-inf
NaNas_bin:NaN
--- NEW FILE: use_lib3.t ---
#!/usr/bin/perl -w
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use_lib3.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
use Math::BigInt lib => 'BareCalc';
use Math::BigFloat;
ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
ok (Math::BigFloat->new(123)->badd(123),246);
--- NEW FILE: require.t ---
#!/usr/bin/perl -w
# check that simple requiring BigInt works
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/require.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
my ($x);
require Math::BigInt; $x = Math::BigInt->new(1); ++$x;
ok ($x||'undef',2);
# all tests done
--- NEW FILE: use_lib2.t ---
#!/usr/bin/perl -w
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use_lib2.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
use Math::BigInt;
use Math::BigFloat lib => 'BareCalc';
ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
ok (Math::BigFloat->new(123)->badd(123),246);
--- NEW FILE: req_mbfa.t ---
#!/usr/bin/perl -w
# check that simple requiring BigFloat and then bnan() works
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbfa.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
require Math::BigFloat; my $x = Math::BigFloat->bnan(1); ok ($x,'NaN');
# all tests done
--- NEW FILE: use_mbfw.t ---
#!/usr/bin/perl -w
# check that using BigFloat with "with" and "lib" at the same time works
# broken in versions up to v1.63
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use_mbfw.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
# the replacement lib can handle the lib statement, but it could also ignore
# it completely, for instance, when it is a 100% replacement for BigInt, but
# doesn't know the concept of alternative libs. But it still needs to cope
# with "lib => ". SubClass does record it, so we test here essential if
# BigFloat hands the lib properly down, any more is outside out testing reach.
use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc';
ok (Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc' );
# ok ($Math::BigInt::Subclass::lib, 'BareCalc' );
# it never arrives here, but that is a design decision in SubClass
ok (Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc' );
# all tests done
--- NEW FILE: sub_mbf.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_mbf.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2012
+ 6; # + our own tests
}
use Math::BigFloat::Subclass;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat::Subclass";
$CL = Math::BigFloat->config()->{lib}; # "Math::BigInt::Calc"; or FastCalc
require 'bigfltpm.inc'; # perform same tests as bigfltpm
###############################################################################
# Now do custom tests for Subclass itself
my $ms = $class->new(23);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
# Check that subclass is a Math::BigFloat, but not a Math::Bigint
ok ($ms->isa('Math::BigFloat'),1);
ok ($ms->isa('Math::BigInt') || 0,0);
use Math::BigFloat;
my $bf = Math::BigFloat->new(23); # same as other
$ms += $bf;
print "# Tried: \$ms += \$bf, got $ms" if !ok (46, $ms);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));
--- NEW FILE: use_lib1.t ---
#!/usr/bin/perl -w
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use_lib1.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
use Math::BigFloat lib => 'BareCalc';
ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
ok (Math::BigFloat->new(123)->badd(123),246);
--- NEW FILE: sub_ali.t ---
#!/usr/bin/perl -w
# test that the new alias names work
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_ali.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 6;
}
use Math::BigInt::Subclass;
use vars qw/$CL $x/;
$CL = 'Math::BigInt::Subclass';
require 'alias.inc';
--- NEW FILE: req_mbfi.t ---
#!/usr/bin/perl -w
# check that simple requiring BigFloat and then binf() works
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbfi.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
require Math::BigFloat; my $x = Math::BigFloat->binf(); ok ($x,'inf');
# all tests done
--- NEW FILE: calling.t ---
#!/usr/bin/perl -w
# test calling conventions, and :constant overloading
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/calling.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../lib);
}
else
{
unshift @INC, '../lib';
}
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
my $tests = 160;
plan tests => $tests;
if ($] < 5.006)
{
for (1..$tests) { skip (1,'Not supported on older Perls'); }
exit;
}
}
package Math::BigInt::Test;
use Math::BigInt;
use vars qw/@ISA/;
@ISA = qw/Math::BigInt/; # child of MBI
use overload;
package Math::BigFloat::Test;
use Math::BigFloat;
use vars qw/@ISA/;
@ISA = qw/Math::BigFloat/; # child of MBI
use overload;
package main;
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
my ($x,$y,$z,$u);
my $version = '1.76'; # adjust manually to match latest release
###############################################################################
# check whether op's accept normal strings, even when inherited by subclasses
# do one positive and one negative test to avoid false positives by "accident"
my ($func, at args,$ans,$rc,$class,$try);
while (<DATA>)
{
chomp;
next if /^#/; # skip comments
if (s/^&//)
{
$func = $_;
}
else
{
@args = split(/:/,$_,99);
$ans = pop @args;
foreach $class (qw/
Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
{
$try = "'$args[0]'"; # quote it
$try = $args[0] if $args[0] =~ /'/; # already quoted
$try = '' if $args[0] eq ''; # undef, no argument
$try = "$class\->$func($try);";
$rc = eval $try;
print "# Tried: '$try'\n" if !ok ($rc, $ans);
}
}
}
$class = 'Math::BigInt';
# XXX TODO this test does not work/fail.
# test whether use Math::BigInt qw/version/ works
#$try = "use $class ($version.'1');";
#$try .= ' $x = $class->new(123); $x = "$x";';
#eval $try;
#ok_undef ( $x ); # should result in error!
# test whether fallback to calc works
$try = "use $class ($version,'lib','foo, bar , ');";
$try .= "$class\->config()->{lib};";
$ans = eval $try;
ok ( $ans =~ /^Math::BigInt::(Fast)?Calc\z/, 1);
# test whether constant works or not, also test for qw($version)
# bgcd() is present in subclass, too
$try = "use Math::BigInt ($version,'bgcd',':constant');";
$try .= ' $x = 2**150; bgcd($x); $x = "$x";';
$ans = eval $try;
ok ( $ans, "1427247692705959881058285969449495136382746624");
# test wether Math::BigInt::Scalar via use works (w/ dff. spellings of calc)
$try = "use $class ($version,'lib','Scalar');";
$try .= ' $x = 2**10; $x = "$x";';
$ans = eval $try; ok ( $ans, "1024");
$try = "use $class ($version,'LiB','$class\::Scalar');";
$try .= ' $x = 2**10; $x = "$x";';
$ans = eval $try; ok ( $ans, "1024");
# all done
__END__
&is_zero
1:0
0:1
&is_one
1:1
0:0
&is_positive
1:1
-1:0
&is_negative
1:0
-1:1
&is_nan
abc:1
1:0
&is_inf
inf:1
0:0
&bstr
5:5
10:10
-10:-10
abc:NaN
'+inf':inf
'-inf':-inf
&bsstr
1:1e+0
0:0e+1
2:2e+0
200:2e+2
-5:-5e+0
-100:-1e+2
abc:NaN
'+inf':inf
&babs
-1:1
1:1
&bnot
-2:1
1:-2
&bzero
:0
&bnan
:NaN
abc:NaN
&bone
:1
'+':1
'-':-1
&binf
:inf
'+':inf
'-':-inf
--- NEW FILE: use_lib4.t ---
#!/usr/bin/perl -w
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent, except this, since the later overrides
# the former lib statement
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/use_lib4.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2;
}
use Math::BigInt lib => 'BareCalc';
use Math::BigFloat lib => 'Calc';
ok (Math::BigInt->config()->{lib},'Math::BigInt::Calc');
ok (Math::BigFloat->new(123)->badd(123),246);
--- NEW FILE: constant.t ---
#!/usr/bin/perl -w
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/constant.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 7;
if ($] < 5.006)
{
for (1..7) { skip (1,'Not supported on older Perls'); }
exit;
}
}
use Math::BigInt ':constant';
ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968');
{
no warnings 'portable'; # protect against "non-portable" warnings
# hexadecimal constants
ok (0x123456789012345678901234567890,
Math::BigInt->new('0x123456789012345678901234567890'));
# binary constants
ok (0b01010100011001010110110001110011010010010110000101101101,
Math::BigInt->new(
'0b01010100011001010110110001110011010010010110000101101101'));
}
use Math::BigFloat ':constant';
ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333');
# stress-test Math::BigFloat->import()
Math::BigFloat->import( qw/:constant/ );
ok (1,1);
Math::BigFloat->import( qw/:constant upgrade Math::BigRat/ );
ok (1,1);
Math::BigFloat->import( qw/upgrade Math::BigRat :constant/ );
ok (1,1);
# all tests done
--- NEW FILE: fallback.t ---
#!/usr/bin/perl -w
# test 'fallback' for overload cos/sin/atan2/exp
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/fallback.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 12;
}
# The tests below test that cos(BigInt) = cos(Scalar) which is DWIM, but not
# exactly right, ideally cos(BigInt) should truncate to int() and cos(BigFloat)
# should calculate the result to X digits accuracy. For now, this is better
# than die()ing...
use Math::BigInt;
use Math::BigFloat;
my $bi = Math::BigInt->new(1);
ok (cos($bi), cos(1));
ok (sin($bi), sin(1));
ok (exp($bi), exp(1));
ok (atan2($bi,$bi), atan2(1,1));
my $bf = Math::BigInt->new(0);
ok (cos($bf), cos(0));
ok (sin($bf), sin(0));
ok (exp($bf), exp(0));
ok (atan2($bi,$bf), atan2(1,0));
ok (atan2($bf,$bi), atan2(0,1));
my $bone = Math::BigInt->new(1);
ok (cos($bone), cos(1));
ok (sin($bone), sin(1));
ok (exp($bone), exp(1));
--- NEW FILE: bigints.t ---
#!/usr/bin/perl -w
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bigints.t//i;
if ($ENV{PERL_CORE})
{
@INC = qw(../t/lib); # testing with the core distribution
}
unshift @INC, '../lib'; # for testing manually
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 51;
}
# testing of Math::BigInt:Scalar (used by the testsuite),
# primarily for interface/api and not for the math functionality
use Math::BigInt::Scalar;
my $C = 'Math::BigInt::Scalar'; # pass classname to sub's
# _new and _str
my $x = $C->_new("123"); my $y = $C->_new("321");
ok (ref($x),'SCALAR'); ok ($C->_str($x),123); ok ($C->_str($y),321);
# _add, _sub, _mul, _div
ok ($C->_str($C->_add($x,$y)),444);
ok ($C->_str($C->_sub($x,$y)),123);
ok ($C->_str($C->_mul($x,$y)),39483);
ok ($C->_str($C->_div($x,$y)),123);
ok ($C->_str($C->_mul($x,$y)),39483);
ok ($C->_str($x),39483);
ok ($C->_str($y),321);
my $z = $C->_new("2");
ok ($C->_str($C->_add($x,$z)),39485);
my ($re,$rr) = $C->_div($x,$y);
ok ($C->_str($re),123); ok ($C->_str($rr),2);
# is_zero, _is_one, _one, _zero
ok ($C->_is_zero($x),0);
ok ($C->_is_one($x),0);
ok ($C->_is_one($C->_one()),1); ok ($C->_is_one($C->_zero()),0);
ok ($C->_is_zero($C->_zero()),1); ok ($C->_is_zero($C->_one()),0);
# is_odd, is_even
ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0);
ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1);
# _digit
$x = $C->_new("123456789");
ok ($C->_digit($x,0),9);
ok ($C->_digit($x,1),8);
ok ($C->_digit($x,2),7);
ok ($C->_digit($x,-1),1);
ok ($C->_digit($x,-2),2);
ok ($C->_digit($x,-3),3);
# _copy
$x = $C->_new("12356");
ok ($C->_str($C->_copy($x)),12356);
# _acmp
$x = $C->_new("123456789");
$y = $C->_new("987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
# _div
$x = $C->_new("3333"); $y = $C->_new("1111");
ok ($C->_str( scalar $C->_div($x,$y)),3);
$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
ok ($C->_str($x),30); ok ($C->_str($y),3);
$x = $C->_new("123"); $y = $C->_new("1111");
($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123);
# _num
$x = $C->_new("12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
# _len
$x = $C->_new("12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5);
# _and, _or, _xor
$x = $C->_new("3"); $y = $C->_new("4"); ok ($C->_str( $C->_or($x,$y)),7);
$x = $C->_new("1"); $y = $C->_new("4"); ok ($C->_str( $C->_xor($x,$y)),5);
$x = $C->_new("7"); $y = $C->_new("3"); ok ($C->_str( $C->_and($x,$y)),3);
# _pow
$x = $C->_new("2"); $y = $C->_new("4"); ok ($C->_str( $C->_pow($x,$y)),16);
$x = $C->_new("2"); $y = $C->_new("5"); ok ($C->_str( $C->_pow($x,$y)),32);
$x = $C->_new("3"); $y = $C->_new("3"); ok ($C->_str( $C->_pow($x,$y)),27);
# _check
$x = $C->_new("123456789");
ok ($C->_check($x),0);
ok ($C->_check(123),'123 is not a reference');
# done
1;
--- NEW FILE: sub_mif.t ---
#!/usr/bin/perl -w
# test rounding, accuracy, precicion and fallback, round_mode and mixing
# of classes
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/sub_mif.t//i;
if ($ENV{PERL_CORE})
{
@INC = qw(../t/lib); # testing with the core distribution
}
unshift @INC, '../lib'; # for testing manually
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 684;
}
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
use vars qw/$mbi $mbf/;
$mbi = 'Math::BigInt::Subclass';
$mbf = 'Math::BigFloat::Subclass';
require 'mbimbf.inc';
--- NEW FILE: req_mbf0.t ---
#!/usr/bin/perl -w
# check that simple requiring BigFloat and then bzero() works
use strict;
use Test::More;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbf0.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
require Math::BigFloat;
my $x = Math::BigFloat->bzero(); $x++;
is ($x,1, '$x is 1');
# all tests done
--- NEW FILE: upgradef.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/upgradef.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 0
+ 6; # our own tests
}
###############################################################################
package Math::BigFloat::Test;
use Math::BigFloat;
require Exporter;
use vars qw/@ISA/;
@ISA = qw/Exporter Math::BigFloat/;
use overload;
sub isa
{
my ($self,$class) = @_;
return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these
UNIVERSAL::isa($self,$class);
}
sub bmul
{
return __PACKAGE__->new(123);
}
sub badd
{
return __PACKAGE__->new(321);
}
###############################################################################
package main;
# use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat upgrade => 'Math::BigFloat::Test';
use vars qw ($scale $class $try $x $y $z $f @args $ans $ans1 $ans1_str $setup
$ECL $CL);
$class = "Math::BigFloat";
$CL = "Math::BigInt::Calc";
$ECL = "Math::BigFloat::Test";
ok (Math::BigFloat->upgrade(),$ECL);
ok (Math::BigFloat->downgrade()||'','');
$x = $class->new(123); $y = $ECL->new(123); $z = $x->bmul($y);
ok (ref($z),$ECL); ok ($z,123);
$x = $class->new(123); $y = $ECL->new(123); $z = $x->badd($y);
ok (ref($z),$ECL); ok ($z,321);
# not yet:
# require 'upgrade.inc'; # all tests here for sharing
--- NEW FILE: with_sub.t ---
#!/usr/bin/perl -w
# Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass';
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/with_sub.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2012
+ 1;
}
use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'Calc';
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat";
$CL = "Math::BigInt::Calc";
# the with argument is ignored
ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc');
require 'bigfltpm.inc'; # all tests here for sharing
--- NEW FILE: inf_nan.t ---
#!/usr/bin/perl -w
# test inf/NaN handling all in one place
# Thanx to Jarkko for the excellent explanations and the tables
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/inf_nan.t//i;
if ($ENV{PERL_CORE})
{
@INC = qw(../t/lib); # testing with the core distribution
}
unshift @INC, '../lib'; # for testing manually
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
# values groups operators classes tests
plan tests => 7 * 6 * 5 * 4 * 2 +
7 * 6 * 2 * 4 * 1 # bmod
;
# see bottom: + 4 * 10; # 4 classes * 10 NaN == NaN tests
}
use Math::BigInt;
use Math::BigFloat;
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
my @classes =
qw/Math::BigInt Math::BigFloat
Math::BigInt::Subclass Math::BigFloat::Subclass
/;
my (@args,$x,$y,$z);
# +
foreach (qw/
-inf:-inf:-inf
-1:-inf:-inf
-0:-inf:-inf
0:-inf:-inf
1:-inf:-inf
inf:-inf:NaN
NaN:-inf:NaN
-inf:-1:-inf
-1:-1:-2
-0:-1:-1
0:-1:-1
1:-1:0
inf:-1:inf
NaN:-1:NaN
-inf:0:-inf
-1:0:-1
-0:0:0
0:0:0
1:0:1
inf:0:inf
NaN:0:NaN
-inf:1:-inf
-1:1:0
-0:1:1
0:1:1
1:1:2
inf:1:inf
NaN:1:NaN
-inf:inf:NaN
-1:inf:inf
-0:inf:inf
0:inf:inf
1:inf:inf
inf:inf:inf
NaN:inf:NaN
-inf:NaN:NaN
-1:NaN:NaN
-0:NaN:NaN
0:NaN:NaN
1:NaN:NaN
inf:NaN:NaN
NaN:NaN:NaN
/)
{
@args = split /:/,$_;
for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
my $r = $x->badd($y);
is($x->bstr(),$args[2],"x $class $args[0] + $args[1]");
is($x->bstr(),$args[2],"r $class $args[0] + $args[1]");
}
}
# -
foreach (qw/
-inf:-inf:NaN
-1:-inf:inf
-0:-inf:inf
0:-inf:inf
1:-inf:inf
inf:-inf:inf
NaN:-inf:NaN
-inf:-1:-inf
-1:-1:0
-0:-1:1
0:-1:1
1:-1:2
inf:-1:inf
NaN:-1:NaN
-inf:0:-inf
-1:0:-1
-0:0:-0
0:0:0
1:0:1
inf:0:inf
NaN:0:NaN
-inf:1:-inf
-1:1:-2
-0:1:-1
0:1:-1
1:1:0
inf:1:inf
NaN:1:NaN
-inf:inf:-inf
-1:inf:-inf
-0:inf:-inf
0:inf:-inf
1:inf:-inf
inf:inf:NaN
NaN:inf:NaN
-inf:NaN:NaN
-1:NaN:NaN
-0:NaN:NaN
0:NaN:NaN
1:NaN:NaN
inf:NaN:NaN
NaN:NaN:NaN
/)
{
@args = split /:/,$_;
for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
my $r = $x->bsub($y);
is($x->bstr(),$args[2],"x $class $args[0] - $args[1]");
is($r->bstr(),$args[2],"r $class $args[0] - $args[1]");
}
}
# *
foreach (qw/
-inf:-inf:inf
-1:-inf:inf
-0:-inf:NaN
0:-inf:NaN
1:-inf:-inf
inf:-inf:-inf
NaN:-inf:NaN
-inf:-1:inf
-1:-1:1
-0:-1:0
0:-1:-0
1:-1:-1
inf:-1:-inf
NaN:-1:NaN
-inf:0:NaN
-1:0:-0
-0:0:-0
0:0:0
1:0:0
inf:0:NaN
NaN:0:NaN
-inf:1:-inf
-1:1:-1
-0:1:-0
0:1:0
1:1:1
inf:1:inf
NaN:1:NaN
-inf:inf:-inf
-1:inf:-inf
-0:inf:NaN
0:inf:NaN
1:inf:inf
inf:inf:inf
NaN:inf:NaN
-inf:NaN:NaN
-1:NaN:NaN
-0:NaN:NaN
0:NaN:NaN
1:NaN:NaN
inf:NaN:NaN
NaN:NaN:NaN
/)
{
@args = split /:/,$_;
for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
$args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
my $r = $x->bmul($y);
is($x->bstr(),$args[2],"x $class $args[0] * $args[1]");
is($r->bstr(),$args[2],"r $class $args[0] * $args[1]");
}
}
# /
foreach (qw/
-inf:-inf:NaN
-1:-inf:0
-0:-inf:0
0:-inf:-0
1:-inf:-0
inf:-inf:NaN
NaN:-inf:NaN
-inf:-1:inf
-1:-1:1
-0:-1:0
0:-1:-0
1:-1:-1
inf:-1:-inf
NaN:-1:NaN
-inf:0:-inf
-1:0:-inf
-0:0:NaN
0:0:NaN
1:0:inf
inf:0:inf
NaN:0:NaN
-inf:1:-inf
-1:1:-1
-0:1:-0
0:1:0
1:1:1
inf:1:inf
NaN:1:NaN
-inf:inf:NaN
-1:inf:-0
-0:inf:-0
0:inf:0
1:inf:0
inf:inf:NaN
NaN:inf:NaN
-inf:NaN:NaN
-1:NaN:NaN
-0:NaN:NaN
0:NaN:NaN
1:NaN:NaN
inf:NaN:NaN
NaN:NaN:NaN
/)
{
@args = split /:/,$_;
for my $class (@classes)
{
$x = $class->new($args[0]);
$y = $class->new($args[1]);
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
my $t = $x->copy();
my $tmod = $t->copy();
# bdiv in scalar context
my $r = $x->bdiv($y);
is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");
# bmod and bdiv in list context
my ($d,$rem) = $t->bdiv($y);
# bdiv in list context
is($t->bstr(),$args[2],"t $class $args[0] / $args[1]");
is($d->bstr(),$args[2],"d $class $args[0] / $args[1]");
# bmod
my $m = $tmod->bmod($y);
# bmod() agrees with bdiv?
is($m->bstr(),$rem->bstr(),"m $class $args[0] % $args[1]");
# bmod() return agrees with set value?
is($tmod->bstr(),$m->bstr(),"o $class $args[0] % $args[1]");
}
}
#############################################################################
# overloaded comparisations
# these are disabled for now, since Perl itself can't seem to make up it's
# mind what NaN actually is, see [perl #33106].
#
#foreach my $c (@classes)
# {
# my $x = $c->bnan();
# my $y = $c->bnan(); # test with two different objects, too
# my $a = $c->bzero();
#
# is ($x == $y, undef, 'NaN == NaN: undef');
# is ($x != $y, 1, 'NaN != NaN: 1');
#
# is ($x == $x, undef, 'NaN == NaN: undef');
# is ($x != $x, 1, 'NaN != NaN: 1');
#
# is ($a != $x, 1, '0 != NaN: 1');
# is ($a == $x, undef, '0 == NaN: undef');
#
# is ($a < $x, undef, '0 < NaN: undef');
# is ($a <= $x, undef, '0 <= NaN: undef');
# is ($a >= $x, undef, '0 >= NaN: undef');
# is ($a > $x, undef, '0 > NaN: undef');
# }
# All done.
--- NEW FILE: req_mbf1.t ---
#!/usr/bin/perl -w
# check that simple requiring BigFloat and then bone() works
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/req_mbf1.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib); # to locate the modules
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 1;
}
require Math::BigFloat; my $x = Math::BigFloat->bone(); ok ($x,1);
# all tests done
--- NEW FILE: alias.inc ---
# alias subroutine testing, included by sub_ali.t and mbi_ali.t
my $x = $CL->new(123);
is ($x->is_pos(), 1, '123 is positive');
is ($x->is_neg(), 0, '123 is not negative');
is ($x->as_int(), 123, '123 is 123 as int');
is (ref($x->as_int()), $CL, "as_int(123) is of class '$CL'");
$x->bneg();
is ($x->is_pos(), 0, '-123 is not positive');
is ($x->is_neg(), 1, '-123 is negative');
--- NEW FILE: bigintpm.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
unshift @INC, '../lib'; # for running manually
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
plan tests => 3015;
}
use Math::BigInt lib => 'Calc';
use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt";
$CL = "Math::BigInt::Calc";
require 'bigintpm.inc'; # all tests here for sharing
--- NEW FILE: bare_mif.t ---
#!/usr/bin/perl -w
# test rounding, accuracy, precicion and fallback, round_mode and mixing
# of classes under BareCalc
use strict;
use Test;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bare_mif.t//i;
if ($ENV{PERL_CORE})
{
@INC = qw(../t/lib); # testing with the core distribution
}
unshift @INC, '../lib'; # for testing manually
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 684
+ 1; # our own tests
}
print "# ",Math::BigInt->config()->{lib},"\n";
use Math::BigInt lib => 'BareCalc';
use Math::BigFloat lib => 'BareCalc';
use vars qw/$mbi $mbf/;
$mbi = 'Math::BigInt';
$mbf = 'Math::BigFloat';
ok (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
require 'mbimbf.inc';
--- NEW FILE: bigroot.t ---
#!/usr/bin/perl -w
# Test broot function (and bsqrt() function, since it is used by broot()).
# It is too slow to be simple included in bigfltpm.inc, where it would get
# executed 3 times.
# But it is better to test the numerical functionality, instead of not testing
# it at all.
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bigroot.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 4 * 2;
}
use Math::BigFloat;
use Math::BigInt;
my $cl = "Math::BigFloat";
my $c = "Math::BigInt";
# 2 ** 240 =
# 1766847064778384329583297500742918515827483896875618958121606201292619776
# takes way too long
#test_broot ('2','240', 8, undef, '1073741824');
#test_broot ('2','240', 9, undef, '106528681.3099908308759836475139583940127');
#test_broot ('2','120', 9, undef, '10321.27324073880096577298929482324664787');
#test_broot ('2','120', 17, undef, '133.3268493632747279600707813049418888729');
test_broot ('2','120', 8, undef, '32768');
test_broot ('2','60', 8, undef, '181.0193359837561662466161566988413540569');
test_broot ('2','60', 9, undef, '101.5936673259647663841091609134277286651');
test_broot ('2','60', 17, undef, '11.54672461623965153271017217302844672562');
sub test_broot
{
my ($x,$n,$y,$scale,$result) = @_;
my $s = $scale || 'undef';
print "# Try: $cl $x->bpow($n)->broot($y,$s) == $result:\n";
ok ($cl->new($x)->bpow($n)->broot($y,$scale),$result);
$result =~ s/\..*//;
print "# Try: $c $x->bpow($n)->broot($y,$s) == $result:\n";
ok ($c->new($x)->bpow($n)->broot($y,$scale),$result);
}
--- NEW FILE: mbi_ali.t ---
#!/usr/bin/perl -w
# test that the new alias names work
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/mbi_ali.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 6;
}
use Math::BigInt;
use vars qw/$x $CL/;
$CL = 'Math::BigInt';
require 'alias.inc';
--- NEW FILE: bare_mbf.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bare_mbf.t//i;
print "#$0\n";
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2012;
}
use Math::BigFloat lib => 'BareCalc';
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat";
$CL = "Math::BigInt::BareCalc";
require 'bigfltpm.inc'; # all tests here for sharing
--- NEW FILE: mbf_ali.t ---
#!/usr/bin/perl -w
# test that the new alias names work
use Test::More;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/mbf_ali.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../t/lib);
}
unshift @INC, qw(../lib);
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 6;
}
use Math::BigFloat;
use vars qw/$x $CL/;
$CL = 'Math::BigFloat';
require 'alias.inc';
--- NEW FILE: config.t ---
#!/usr/bin/perl -w
use strict;
use Test;
BEGIN
{
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
plan tests => 51;
}
# test whether Math::BigInt->config() and Math::BigFloat->config() works
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
##############################################################################
# BigInt
ok ($mbi->can('config'));
my $cfg = $mbi->config();
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
ok ($cfg->{class},$mbi);
ok ($cfg->{upgrade}||'','');
ok ($cfg->{div_scale},40);
ok ($cfg->{precision}||0,0); # should test for undef
ok ($cfg->{accuracy}||0,0);
ok ($cfg->{round_mode},'even');
ok ($cfg->{trap_nan},0);
ok ($cfg->{trap_inf},0);
##############################################################################
# BigFloat
ok ($mbf->can('config'));
$cfg = $mbf->config();
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
ok ($cfg->{with},'Math::BigInt::Calc');
ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
ok ($cfg->{class},$mbf);
ok ($cfg->{upgrade}||'','');
ok ($cfg->{div_scale},40);
ok ($cfg->{precision}||0,0); # should test for undef
ok ($cfg->{accuracy}||0,0);
ok ($cfg->{round_mode},'even');
ok ($cfg->{trap_nan},0);
ok ($cfg->{trap_inf},0);
##############################################################################
# test setting values
my $test = {
trap_nan => 1,
trap_inf => 1,
accuracy => 2,
precision => 3,
round_mode => 'zero',
div_scale => '100',
upgrade => 'Math::BigInt::SomeClass',
downgrade => 'Math::BigInt::SomeClass',
};
my $c;
foreach my $key (keys %$test)
{
# see if setting in MBI works
eval ( "$mbi\->config( $key => '$test->{$key}' );" );
$c = $mbi->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
$c = $mbf->config();
# see if setting it in MBI leaves MBF alone
if (($c->{$key}||0) ne $test->{$key})
{
ok (1,1);
}
else
{
ok ("$key eq $c->{$key}","$key ne $test->{$key}");
}
# see if setting in MBF works
eval ( "$mbf\->config( $key => '$test->{$key}' );" );
$c = $mbf->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
}
##############################################################################
# test setting illegal keys (should croak)
$@ = ""; my $never_reached = 0;
eval ("$mbi\->config( 'some_garbage' => 1 ); $never_reached = 1;");
ok ($never_reached,0);
$@ = ""; $never_reached = 0;
eval ("$mbf\->config( 'some_garbage' => 1 ); $never_reached = 1;");
ok ($never_reached,0);
# this does not work. Why?
#ok ($@ eq "Illegal keys 'some_garbage' passed to Math::BigInt->config() at ./config.t line 104", 1);
# all tests done
--- NEW FILE: bigfltpm.t ---
#!/usr/bin/perl -w
use Test;
use strict;
BEGIN
{
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/bigfltpm.t//i;
if ($ENV{PERL_CORE})
{
# testing with the core distribution
@INC = qw(../lib);
}
unshift @INC, '../lib';
if (-d 't')
{
chdir 't';
require File::Spec;
unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
}
else
{
unshift @INC, $location;
}
print "# INC = @INC\n";
plan tests => 2012
+ 2; # own tests
}
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat";
$CL = "Math::BigInt::Calc";
ok ($class->config()->{class},$class);
ok ($class->config()->{with}, $CL);
require 'bigfltpm.inc'; # all tests here for sharing
More information about the dslinux-commit
mailing list