mbimbf.inc

source of perl for linux application,

# 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 no longer warn, even tho '3.17' is a NaN in BigInt (>= returns
# now false, bug until v1.80)
$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, '');
print "# Got: '$warn'\n" unless
ok ($warn !~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);	
$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, '');
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