cpan/Math-BigInt/t/mbimbf.inc

   1 # test rounding, accuracy, precicion and fallback, round_mode and mixing
   2 # of classes
   3
   4 # Make sure you always quote any bare floating-point values, lest 123.46 will
   5 # be stringified to 123.4599999999 due to limited float prevision.
   6
   7 use strict;
   8 my ($x,$y,$z,$u,$rc);
   9
  10 ###############################################################################
  11 # test defaults and set/get
  12
  13 {
  14   no strict 'refs';
  15   ok_undef (${"$mbi\::accuracy"});
  16   ok_undef (${"$mbi\::precision"});
  17   ok_undef ($mbi->accuracy());
  18   ok_undef ($mbi->precision());
  19   ok (${"$mbi\::div_scale"},40);
  20   ok (${"$mbi\::round_mode"},'even');
  21   ok ($mbi->round_mode(),'even');
  22
  23   ok_undef (${"$mbf\::accuracy"});
  24   ok_undef (${"$mbf\::precision"});
  25   ok_undef ($mbf->precision());
  26   ok_undef ($mbf->precision());
  27   ok (${"$mbf\::div_scale"},40);
  28   ok (${"$mbf\::round_mode"},'even');
  29   ok ($mbf->round_mode(),'even');
  30 }
  31
  32 # accessors
  33 foreach my $class ($mbi,$mbf)
  34   {
  35   ok_undef ($class->accuracy());
  36   ok_undef ($class->precision());
  37   ok ($class->round_mode(),'even');
  38   ok ($class->div_scale(),40);
  39
  40   ok ($class->div_scale(20),20);
  41   $class->div_scale(40); ok ($class->div_scale(),40);
  42
  43   ok ($class->round_mode('odd'),'odd');
  44   $class->round_mode('even'); ok ($class->round_mode(),'even');
  45
  46   ok ($class->accuracy(2),2);
  47   $class->accuracy(3); ok ($class->accuracy(),3);
  48   ok_undef ($class->accuracy(undef));
  49
  50   ok ($class->precision(2),2);
  51   ok ($class->precision(-2),-2);
  52   $class->precision(3); ok ($class->precision(),3);
  53   ok_undef ($class->precision(undef));
  54   }
  55
  56 {
  57   no strict 'refs';
  58   # accuracy
  59   foreach (qw/5 42 -1 0/)
  60     {
  61     ok (${"$mbf\::accuracy"} = $_,$_);
  62     ok (${"$mbi\::accuracy"} = $_,$_);
  63     }
  64   ok_undef (${"$mbf\::accuracy"} = undef);
  65   ok_undef (${"$mbi\::accuracy"} = undef);
  66
  67   # precision
  68   foreach (qw/5 42 -1 0/)
  69     {
  70     ok (${"$mbf\::precision"} = $_,$_);
  71     ok (${"$mbi\::precision"} = $_,$_);
  72     }
  73   ok_undef (${"$mbf\::precision"} = undef);
  74   ok_undef (${"$mbi\::precision"} = undef);
  75
  76   # fallback
  77   foreach (qw/5 42 1/)
  78     {
  79     ok (${"$mbf\::div_scale"} = $_,$_);
  80     ok (${"$mbi\::div_scale"} = $_,$_);
  81     }
  82   # illegal values are possible for fallback due to no accessor
  83
  84   # round_mode
  85   foreach (qw/odd even zero trunc +inf -inf/)
  86     {
  87     ok (${"$mbf\::round_mode"} = $_,$_);
  88     ok (${"$mbi\::round_mode"} = $_,$_);
  89     }
  90   ${"$mbf\::round_mode"} = 'zero';
  91   ok (${"$mbf\::round_mode"},'zero');
  92   ok (${"$mbi\::round_mode"},'-inf');   # from above
  93
  94   # reset for further tests
  95   ${"$mbi\::accuracy"} = undef;
  96   ${"$mbi\::precision"} = undef;
  97   ${"$mbf\::div_scale"} = 40;
  98 }
  99
 100 # local copies
 101 $x = $mbf->new('123.456');
 102 ok_undef ($x->accuracy());
 103 ok ($x->accuracy(5),5);
 104 ok_undef ($x->accuracy(undef),undef);
 105 ok_undef ($x->precision());
 106 ok ($x->precision(5),5);
 107 ok_undef ($x->precision(undef),undef);
 108
 109 {
 110   no strict 'refs';
 111   # see if MBF changes MBIs values
 112   ok (${"$mbi\::accuracy"} = 42,42);
 113   ok (${"$mbf\::accuracy"} = 64,64);
 114   ok (${"$mbi\::accuracy"},42);         # should be still 42
 115   ok (${"$mbf\::accuracy"},64);         # should be now 64
 116 }
 117
 118 ###############################################################################
 119 # see if creating a number under set A or P will round it
 120
 121 {
 122   no strict 'refs';
 123   ${"$mbi\::accuracy"} = 4;
 124   ${"$mbi\::precision"} = undef;
 125
 126   ok ($mbi->new(123456),123500);                # with A
 127   ${"$mbi\::accuracy"} = undef;
 128   ${"$mbi\::precision"} = 3;
 129   ok ($mbi->new(123456),123000);                # with P
 130
 131   ${"$mbf\::accuracy"} = 4;
 132   ${"$mbf\::precision"} = undef;
 133   ${"$mbi\::precision"} = undef;
 134
 135   ok ($mbf->new('123.456'),'123.5');    # with A
 136   ${"$mbf\::accuracy"} = undef;
 137   ${"$mbf\::precision"} = -1;
 138   ok ($mbf->new('123.456'),'123.5');    # with P from MBF, not MBI!
 139
 140   ${"$mbf\::precision"} = undef;                # reset
 141 }
 142
 143 ###############################################################################
 144 # see if MBI leaves MBF's private parts alone
 145
 146 {
 147   no strict 'refs';
 148   ${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
 149   ${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
 150   ok ($mbf->new('123.456'),'123.456');
 151   ${"$mbi\::accuracy"} = undef;                 # reset
 152 }
 153
 154 ###############################################################################
 155 # see if setting accuracy/precision actually rounds the number
 156
 157 $x = $mbf->new('123.456'); $x->accuracy(4);   ok ($x,'123.5');
 158 $x = $mbf->new('123.456'); $x->precision(-2); ok ($x,'123.46');
 159
 160 $x = $mbi->new(123456);    $x->accuracy(4);   ok ($x,123500);
 161 $x = $mbi->new(123456);    $x->precision(2);  ok ($x,123500);
 162
 163 ###############################################################################
 164 # test actual rounding via round()
 165
 166 $x = $mbf->new('123.456');
 167 ok ($x->copy()->round(5),'123.46');
 168 ok ($x->copy()->round(4),'123.5');
 169 ok ($x->copy()->round(5,2),'NaN');
 170 ok ($x->copy()->round(undef,-2),'123.46');
 171 ok ($x->copy()->round(undef,2),120);
 172
 173 $x = $mbi->new('123');
 174 ok ($x->round(5,2),'NaN');
 175
 176 $x = $mbf->new('123.45000');
 177 ok ($x->copy()->round(undef,-1,'odd'),'123.5');
 178
 179 # see if rounding is 'sticky'
 180 $x = $mbf->new('123.4567');
 181 $y = $x->copy()->bround();              # no-op since nowhere A or P defined
 182
 183 ok ($y,123.4567);
 184 $y = $x->copy()->round(5);
 185 ok ($y->accuracy(),5);
 186 ok_undef ($y->precision());             # A has precedence, so P still unset
 187 $y = $x->copy()->round(undef,2);
 188 ok ($y->precision(),2);
 189 ok_undef ($y->accuracy());              # P has precedence, so A still unset
 190
 191 # see if setting A clears P and vice versa
 192 $x = $mbf->new('123.4567');
 193 ok ($x,'123.4567');
 194 ok ($x->accuracy(4),4);
 195 ok ($x->precision(-2),-2);              # clear A
 196 ok_undef ($x->accuracy());
 197
 198 $x = $mbf->new('123.4567');
 199 ok ($x,'123.4567');
 200 ok ($x->precision(-2),-2);
 201 ok ($x->accuracy(4),4);                 # clear P
 202 ok_undef ($x->precision());
 203
 204 # does copy work?
 205 $x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2);
 206 $z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
 207
 208 # does $x->bdiv($y,d) work when $d > div_scale?
 209 $x = $mbf->new('0.008'); $x->accuracy(8);
 210
 211 for my $e ( 4, 8, 16, 32 )
 212   {
 213   print "# Tried: $x->bdiv(3,$e)\n"
 214     unless ok (scalar $x->copy()->bdiv(3,$e), '0.002' . ('6' x ($e-2)) . '7');
 215   }
 216
 217 # does accuracy()/precision work on zeros?
 218 foreach my $c ($mbi,$mbf)
 219   {
 220   $x = $c->bzero(); $x->accuracy(5); ok ($x->{_a},5);
 221   $x = $c->bzero(); $x->precision(5); ok ($x->{_p},5);
 222   $x = $c->new(0); $x->accuracy(5); ok ($x->{_a},5);
 223   $x = $c->new(0); $x->precision(5); ok ($x->{_p},5);
 224
 225   $x = $c->bzero(); $x->round(5); ok ($x->{_a},5);
 226   $x = $c->bzero(); $x->round(undef,5); ok ($x->{_p},5);
 227   $x = $c->new(0); $x->round(5); ok ($x->{_a},5);
 228   $x = $c->new(0); $x->round(undef,5); ok ($x->{_p},5);
 229
 230   # see if trying to increasing A in bzero() doesn't do something
 231   $x = $c->bzero(); $x->{_a} = 3; $x->round(5); ok ($x->{_a},3);
 232   }
 233
 234 ###############################################################################
 235 # test whether an opp calls objectify properly or not (or at least does what
 236 # it should do given non-objects, w/ or w/o objectify())
 237
 238 foreach my $c ($mbi,$mbf)
 239   {
 240 #  ${"$c\::precision"} = undef;         # reset
 241 #  ${"$c\::accuracy"} = undef;          # reset
 242
 243   ok ($c->new(123)->badd(123),246);
 244   ok ($c->badd(123,321),444);
 245   ok ($c->badd(123,$c->new(321)),444);
 246
 247   ok ($c->new(123)->bsub(122),1);
 248   ok ($c->bsub(321,123),198);
 249   ok ($c->bsub(321,$c->new(123)),198);
 250
 251   ok ($c->new(123)->bmul(123),15129);
 252   ok ($c->bmul(123,123),15129);
 253   ok ($c->bmul(123,$c->new(123)),15129);
 254
 255 # ok ($c->new(15129)->bdiv(123),123);
 256 # ok ($c->bdiv(15129,123),123);
 257 # ok ($c->bdiv(15129,$c->new(123)),123);
 258
 259   ok ($c->new(15131)->bmod(123),2);
 260   ok ($c->bmod(15131,123),2);
 261   ok ($c->bmod(15131,$c->new(123)),2);
 262
 263   ok ($c->new(2)->bpow(16),65536);
 264   ok ($c->bpow(2,16),65536);
 265   ok ($c->bpow(2,$c->new(16)),65536);
 266
 267   ok ($c->new(2**15)->brsft(1),2**14);
 268   ok ($c->brsft(2**15,1),2**14);
 269   ok ($c->brsft(2**15,$c->new(1)),2**14);
 270
 271   ok ($c->new(2**13)->blsft(1),2**14);
 272   ok ($c->blsft(2**13,1),2**14);
 273   ok ($c->blsft(2**13,$c->new(1)),2**14);
 274   }
 275
 276 ###############################################################################
 277 # test wether operations round properly afterwards
 278 # These tests are not complete, since they do not excercise every "return"
 279 # statement in the op's. But heh, it's better than nothing...
 280
 281 $x = $mbf->new('123.456');
 282 $y = $mbf->new('654.321');
 283 $x->{_a} = 5;           # $x->accuracy(5) would round $x straightaway
 284 $y->{_a} = 4;           # $y->accuracy(4) would round $x straightaway
 285
 286 $z = $x + $y;           ok ($z,'777.8');
 287 $z = $y - $x;           ok ($z,'530.9');
 288 $z = $y * $x;           ok ($z,'80780');
 289 $z = $x ** 2;           ok ($z,'15241');
 290 $z = $x * $x;           ok ($z,'15241');
 291
 292 # not: $z = -$x;                ok ($z,'-123.46'); ok ($x,'123.456');
 293 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
 294 $x = $mbf->new(123456); $x->{_a} = 4;
 295 $z = $x->copy; $z++;    ok ($z,123500);
 296
 297 $x = $mbi->new(123456);
 298 $y = $mbi->new(654321);
 299 $x->{_a} = 5;           # $x->accuracy(5) would round $x straightaway
 300 $y->{_a} = 4;           # $y->accuracy(4) would round $x straightaway
 301
 302 $z = $x + $y;           ok ($z,777800);
 303 $z = $y - $x;           ok ($z,530900);
 304 $z = $y * $x;           ok ($z,80780000000);
 305 $z = $x ** 2;           ok ($z,15241000000);
 306 # not yet: $z = -$x;            ok ($z,-123460); ok ($x,123456);
 307 $z = $x->copy; $z++;    ok ($z,123460);
 308 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
 309
 310 $x = $mbi->new(123400); $x->{_a} = 4;
 311 ok ($x->bnot(),-123400);                        # not -1234001
 312
 313 # both babs() and bneg() don't need to round, since the input will already
 314 # be rounded (either as $x or via new($string)), and they don't change the
 315 # value. The two tests below peek at this by using _a (illegally) directly
 316 $x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->babs(),123401);
 317 $x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->bneg(),123401);
 318
 319 # test fdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
 320 $mbf->round_mode('even');
 321 $x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); ok ($x,'123.4');
 322
 323 $x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6;
 324 ok ($x->bdiv($y),1); ok ($x->{_a},6);                   # carried over
 325
 326 $x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6;
 327 ok ($x->bdiv($y),1); ok ($x->{_a},6);                   # carried over
 328
 329 $x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6;
 330 ok ($x->bdiv($y),0); ok ($x->{_a},6);                   # carried over
 331
 332 $x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6;
 333 ok ($x->bdiv($y),0); ok ($x->{_a},6);                   # carried over
 334
 335 ###############################################################################
 336 # test that bop(0) does the same than bop(undef)
 337
 338 $x = $mbf->new('1234567890');
 339 ok ($x->copy()->bsqrt(0),$x->copy()->bsqrt(undef));
 340 ok ($x->copy->bsqrt(0),'35136.41828644462161665823116758077037159');
 341
 342 ok_undef ($x->{_a});
 343
 344 # test that bsqrt() modifies $x and does not just return something else
 345 # (especially under BareCalc)
 346 $z = $x->bsqrt();
 347 ok ($z,$x); ok ($x,'35136.41828644462161665823116758077037159');
 348
 349 $x = $mbf->new('1.234567890123456789');
 350 ok ($x->copy()->bpow('0.5',0),$x->copy()->bpow('0.5',undef));
 351 ok ($x->copy()->bpow('0.5',0),$x->copy()->bsqrt(undef));
 352 ok ($x->copy()->bpow('2',0),'1.524157875323883675019051998750190521');
 353
 354 ###############################################################################
 355 # test (also under Bare) that bfac() rounds at last step
 356
 357 ok ($mbi->new(12)->bfac(),'479001600');
 358 ok ($mbi->new(12)->bfac(2),'480000000');
 359 $x = $mbi->new(12); $x->accuracy(2); ok ($x->bfac(),'480000000');
 360 $x = $mbi->new(13); $x->accuracy(2); ok ($x->bfac(),'6200000000');
 361 $x = $mbi->new(13); $x->accuracy(3); ok ($x->bfac(),'6230000000');
 362 $x = $mbi->new(13); $x->accuracy(4); ok ($x->bfac(),'6227000000');
 363 # this does 1,2,3...9,10,11,12...20
 364 $x = $mbi->new(20); $x->accuracy(1); ok ($x->bfac(),'2000000000000000000');
 365
 366 ###############################################################################
 367 # test bsqrt) rounding to given A/P/R (bug prior to v1.60)
 368 $x = $mbi->new('123456')->bsqrt(2,undef); ok ($x,'350');        # not 351
 369 $x = $mbi->new('3')->bsqrt(2,undef); ok ($x->accuracy(),2);
 370
 371 $mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf');
 372 ok ($x,'360');  # not 355 nor 350
 373
 374 $x = $mbi->new('126025')->bsqrt(undef,2); ok ($x,'400');         # not 355
 375
 376
 377 ###############################################################################
 378 # test mixed arguments
 379
 380 $x = $mbf->new(10);
 381 $u = $mbf->new(2.5);
 382 $y = $mbi->new(2);
 383
 384 $z = $x + $y; ok ($z,12); ok (ref($z),$mbf);
 385 $z = $x / $y; ok ($z,5); ok (ref($z),$mbf);
 386 $z = $u * $y; ok ($z,5); ok (ref($z),$mbf);
 387
 388 $y = $mbi->new(12345);
 389 $z = $u->copy()->bmul($y,2,undef,'odd'); ok ($z,31000);
 390 $z = $u->copy()->bmul($y,3,undef,'odd'); ok ($z,30900);
 391 $z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
 392 $z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30863);
 393 $z = $u->copy()->bmul($y,undef,2,'odd'); ok ($z,30860);
 394 $z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900);
 395 $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
 396
 397 my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
 398 # these should no longer warn, even tho '3.17' is a NaN in BigInt (>= returns
 399 # now false, bug until v1.80)
 400 $warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, '');
 401 print "# Got: '$warn'\n" unless
 402 ok ($warn !~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);
 403 $warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, '');
 404 print "# Got: '$warn'\n" unless
 405 ok ($warn !~ /^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);
 406
 407 # XXX TODO breakage:
 408 # $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
 409 # $z = $y * $u; ok ($z,5); ok (ref($z),$mbi);
 410 # $z = $y + $x; ok ($z,12); ok (ref($z),$mbi);
 411 # $z = $y / $x; ok ($z,0); ok (ref($z),$mbi);
 412
 413 ###############################################################################
 414 # rounding in bdiv with fallback and already set A or P
 415
 416 {
 417   no strict 'refs';
 418   ${"$mbf\::accuracy"} = undef;
 419   ${"$mbf\::precision"} = undef;
 420   ${"$mbf\::div_scale"} = 40;
 421 }
 422
 423   $x = $mbf->new(10); $x->{_a} = 4;
 424   ok ($x->bdiv(3),'3.333');
 425   ok ($x->{_a},4);                      # set's it since no fallback
 426
 427 $x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
 428 ok ($x->bdiv($y),'3.333');
 429 ok ($x->{_a},4);                        # set's it since no fallback
 430
 431 # rounding to P of x
 432 $x = $mbf->new(10); $x->{_p} = -2;
 433 ok ($x->bdiv(3),'3.33');
 434
 435 # round in div with requested P
 436 $x = $mbf->new(10);
 437 ok ($x->bdiv(3,undef,-2),'3.33');
 438
 439 # round in div with requested P greater than fallback
 440 {
 441   no strict 'refs';
 442   ${"$mbf\::div_scale"} = 5;
 443   $x = $mbf->new(10);
 444   ok ($x->bdiv(3,undef,-8),'3.33333333');
 445   ${"$mbf\::div_scale"} = 40;
 446 }
 447
 448 $x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4;
 449 ok ($x->bdiv($y),'3.333');
 450 ok ($x->{_a},4); ok ($y->{_a},4);       # set's it since no fallback
 451 ok_undef ($x->{_p}); ok_undef ($y->{_p});
 452
 453 # rounding to P of y
 454 $x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2;
 455 ok ($x->bdiv($y),'3.33');
 456 ok ($x->{_p},-2);
 457  ok ($y->{_p},-2);
 458 ok_undef ($x->{_a}); ok_undef ($y->{_a});
 459
 460 ###############################################################################
 461 # test whether bround(-n) fails in MBF (undocumented in MBI)
 462 eval { $x = $mbf->new(1); $x->bround(-2); };
 463 ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
 464
 465 # test whether rounding to higher accuracy is no-op
 466 $x = $mbf->new(1); $x->{_a} = 4;
 467 ok ($x,'1.000');
 468 $x->bround(6);                  # must be no-op
 469 ok ($x->{_a},4);
 470 ok ($x,'1.000');
 471
 472 $x = $mbi->new(1230); $x->{_a} = 3;
 473 ok ($x,'1230');
 474 $x->bround(6);                  # must be no-op
 475 ok ($x->{_a},3);
 476 ok ($x,'1230');
 477
 478 # bround(n) should set _a
 479 $x->bround(2);                  # smaller works
 480 ok ($x,'1200');
 481 ok ($x->{_a},2);
 482
 483 # bround(-n) is undocumented and only used by MBF
 484 # bround(-n) should set _a
 485 $x = $mbi->new(12345);
 486 $x->bround(-1);
 487 ok ($x,'12300');
 488 ok ($x->{_a},4);
 489
 490 # bround(-n) should set _a
 491 $x = $mbi->new(12345);
 492 $x->bround(-2);
 493 ok ($x,'12000');
 494 ok ($x->{_a},3);
 495
 496 # bround(-n) should set _a
 497 $x = $mbi->new(12345); $x->{_a} = 5;
 498 $x->bround(-3);
 499 ok ($x,'10000');
 500 ok ($x->{_a},2);
 501
 502 # bround(-n) should set _a
 503 $x = $mbi->new(12345); $x->{_a} = 5;
 504 $x->bround(-4);
 505 ok ($x,'0');
 506 ok ($x->{_a},1);
 507
 508 # bround(-n) should be noop if n too big
 509 $x = $mbi->new(12345);
 510 $x->bround(-5);
 511 ok ($x,'0');                    # scale to "big" => 0
 512 ok ($x->{_a},0);
 513
 514 # bround(-n) should be noop if n too big
 515 $x = $mbi->new(54321);
 516 $x->bround(-5);
 517 ok ($x,'100000');               # used by MBF to round 0.0054321 at 0.0_6_00000
 518 ok ($x->{_a},0);
 519
 520 # bround(-n) should be noop if n too big
 521 $x = $mbi->new(54321); $x->{_a} = 5;
 522 $x->bround(-6);
 523 ok ($x,'100000');               # no-op
 524 ok ($x->{_a},0);
 525
 526 # bround(n) should set _a
 527 $x = $mbi->new(12345); $x->{_a} = 5;
 528 $x->bround(5);                  # must be no-op
 529 ok ($x,'12345');
 530 ok ($x->{_a},5);
 531
 532 # bround(n) should set _a
 533 $x = $mbi->new(12345); $x->{_a} = 5;
 534 $x->bround(6);                  # must be no-op
 535 ok ($x,'12345');
 536
 537 $x = $mbf->new('0.0061'); $x->bfround(-2); ok ($x,'0.01');
 538 $x = $mbf->new('0.004'); $x->bfround(-2);  ok ($x,'0.00');
 539 $x = $mbf->new('0.005'); $x->bfround(-2);  ok ($x,'0.00');
 540
 541 $x = $mbf->new('12345'); $x->bfround(2); ok ($x,'12340');
 542 $x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340');
 543
 544 # MBI::bfround should clear A for negative P
 545 $x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
 546 ok_undef ($x->{_a});
 547
 548 # test that bfround() and bround() work with large numbers
 549
 550 $x = $mbf->new(1)->bdiv(5678,undef,-63);
 551 ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203');
 552
 553 $x = $mbf->new(1)->bdiv(5678,undef,-90);
 554 ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651');
 555
 556 $x = $mbf->new(1)->bdiv(5678,80);
 557 ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662');
 558
 559 ###############################################################################
 560 # rounding with already set precision/accuracy
 561
 562 $x = $mbf->new(1); $x->{_p} = -5;
 563 ok ($x,'1.00000');
 564
 565 # further rounding donw
 566 ok ($x->bfround(-2),'1.00');
 567 ok ($x->{_p},-2);
 568
 569 $x = $mbf->new(12345); $x->{_a} = 5;
 570 ok ($x->bround(2),'12000');
 571 ok ($x->{_a},2);
 572
 573 $x = $mbf->new('1.2345'); $x->{_a} = 5;
 574 ok ($x->bround(2),'1.2');
 575 ok ($x->{_a},2);
 576
 577 # mantissa/exponent format and A/P
 578 $x = $mbf->new('12345.678'); $x->accuracy(4);
 579 ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
 580
 581 #ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
 582 #ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
 583
 584 # check for no A/P in case of fallback
 585 # result
 586 $x = $mbf->new(100) / 3;
 587 ok_undef ($x->{_a}); ok_undef ($x->{_p});
 588
 589 # result & reminder
 590 $x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3);
 591 ok_undef ($x->{_a}); ok_undef ($x->{_p});
 592 ok_undef ($y->{_a}); ok_undef ($y->{_p});
 593
 594 ###############################################################################
 595 # math with two numbers with differen A and P
 596
 597 $x = $mbf->new(12345); $x->accuracy(4);         # '12340'
 598 $y = $mbf->new(12345); $y->accuracy(2);         # '12000'
 599 ok ($x+$y,24000);                               # 12340+12000=> 24340 => 24000
 600
 601 $x = $mbf->new(54321); $x->accuracy(4);         # '12340'
 602 $y = $mbf->new(12345); $y->accuracy(3);         # '12000'
 603 ok ($x-$y,42000);                               # 54320+12300=> 42020 => 42000
 604
 605 $x = $mbf->new('1.2345'); $x->precision(-2);    # '1.23'
 606 $y = $mbf->new('1.2345'); $y->precision(-4);    # '1.2345'
 607 ok ($x+$y,'2.46');                              # 1.2345+1.2300=> 2.4645 => 2.46
 608
 609 ###############################################################################
 610 # round should find and use proper class
 611
 612 #$x = Foo->new();
 613 #ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
 614 #ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
 615 #ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
 616 #ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
 617
 618 ###############################################################################
 619 # find out whether _find_round_parameters is doing what's it's supposed to do
 620
 621 {
 622   no strict 'refs';
 623   ${"$mbi\::accuracy"} = undef;
 624   ${"$mbi\::precision"} = undef;
 625   ${"$mbi\::div_scale"} = 40;
 626   ${"$mbi\::round_mode"} = 'odd';
 627 }
 628
 629 $x = $mbi->new(123);
 630 my @params = $x->_find_round_parameters();
 631 ok (scalar @params,1);                          # nothing to round
 632
 633 @params = $x->_find_round_parameters(1);
 634 ok (scalar @params,4);                          # a=1
 635 ok ($params[0],$x);                             # self
 636 ok ($params[1],1);                              # a
 637 ok_undef ($params[2]);                          # p
 638 ok ($params[3],'odd');                          # round_mode
 639
 640 @params = $x->_find_round_parameters(undef,2);
 641 ok (scalar @params,4);                          # p=2
 642 ok ($params[0],$x);                             # self
 643 ok_undef ($params[1]);                          # a
 644 ok ($params[2],2);                              # p
 645 ok ($params[3],'odd');                          # round_mode
 646
 647 eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
 648 ok ($@ =~ /^Unknown round mode 'foo'/,1);
 649
 650 @params = $x->_find_round_parameters(undef,2,'+inf');
 651 ok (scalar @params,4);                          # p=2
 652 ok ($params[0],$x);                             # self
 653 ok_undef ($params[1]);                          # a
 654 ok ($params[2],2);                              # p
 655 ok ($params[3],'+inf');                         # round_mode
 656
 657 @params = $x->_find_round_parameters(2,-2,'+inf');
 658 ok (scalar @params,1);                          # error, A and P defined
 659 ok ($params[0],$x);                             # self
 660
 661 {
 662   no strict 'refs';
 663   ${"$mbi\::accuracy"} = 1;
 664   @params = $x->_find_round_parameters(undef,-2);
 665   ok (scalar @params,1);                        # error, A and P defined
 666   ok ($params[0],$x);                           # self
 667   ok ($x->is_nan(),1);                          # and must be NaN
 668
 669   ${"$mbi\::accuracy"} = undef;
 670   ${"$mbi\::precision"} = 1;
 671   @params = $x->_find_round_parameters(1,undef);
 672   ok (scalar @params,1);                        # error, A and P defined
 673   ok ($params[0],$x);                           # self
 674   ok ($x->is_nan(),1);                          # and must be NaN
 675
 676   ${"$mbi\::precision"} = undef;                # reset
 677 }
 678
 679 ###############################################################################
 680 # test whether bone/bzero take additional A & P, or reset it etc
 681
 682 foreach my $c ($mbi,$mbf)
 683   {
 684   $x = $c->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
 685   $x = $c->new(2)->bone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
 686   $x = $c->new(2)->binf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
 687   $x = $c->new(2)->bnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
 688
 689   $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
 690   ok_undef ($x->{_a}); ok_undef ($x->{_p});
 691   $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
 692   ok_undef ($x->{_a}); ok_undef ($x->{_p});
 693
 694   $x = $c->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
 695   $x = $c->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
 696
 697   $x = $c->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
 698   $x = $c->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
 699
 700   $x = $c->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
 701   $x = $c->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
 702
 703   $x = $c->new(2); $x->bone('+',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
 704   $x = $c->new(2); $x->bone('+',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
 705   $x = $c->new(2); $x->bone('-',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
 706   $x = $c->new(2); $x->bone('-',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
 707
 708   $x = $c->new(2); $x->bzero(2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
 709   $x = $c->new(2); $x->bzero(undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
 710   }
 711
 712 ###############################################################################
 713 # test whether bone/bzero honour globals
 714
 715 for my $c ($mbi,$mbf)
 716   {
 717   $c->accuracy(2);
 718   $x = $c->bone(); ok ($x->accuracy(),2);
 719   $x = $c->bzero(); ok ($x->accuracy(),2);
 720   $c->accuracy(undef);
 721
 722   $c->precision(-2);
 723   $x = $c->bone(); ok ($x->precision(),-2);
 724   $x = $c->bzero(); ok ($x->precision(),-2);
 725   $c->precision(undef);
 726   }
 727
 728 ###############################################################################
 729 # check whether mixing A and P creates a NaN
 730
 731 # new with set accuracy/precision and with parameters
 732 {
 733   no strict 'refs';
 734   foreach my $c ($mbi,$mbf)
 735     {
 736     ok ($c->new(123,4,-3),'NaN');                       # with parameters
 737     ${"$c\::accuracy"} = 42;
 738     ${"$c\::precision"} = 2;
 739     ok ($c->new(123),'NaN');                    # with globals
 740     ${"$c\::accuracy"} = undef;
 741     ${"$c\::precision"} = undef;
 742     }
 743 }
 744
 745 # binary ops
 746 foreach my $class ($mbi,$mbf)
 747   {
 748   foreach (qw/add sub mul pow mod/)
 749   #foreach (qw/add sub mul div pow mod/)
 750     {
 751     my $try = "my \$x = $class->new(1234); \$x->accuracy(5); ";
 752       $try .= "my \$y = $class->new(12); \$y->precision(-3); ";
 753       $try .= "\$x->b$_(\$y);";
 754     $rc = eval $try;
 755     print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
 756     }
 757   }
 758
 759 # unary ops
 760 foreach (qw/new bsqrt/)
 761   {
 762   my $try = 'my $x = $mbi->$_(1234,5,-3); ';
 763   $rc = eval $try;
 764   print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
 765   }
 766
 767 # see if $x->bsub(0) and $x->badd(0) really round
 768 foreach my $class ($mbi,$mbf)
 769   {
 770   $x = $class->new(123); $class->accuracy(2); $x->bsub(0);
 771   ok ($x,120);
 772   $class->accuracy(undef);
 773   $x = $class->new(123); $class->accuracy(2); $x->badd(0);
 774   ok ($x,120);
 775   $class->accuracy(undef);
 776   }
 777
 778 ###############################################################################
 779 # test whether shortcuts returning zero/one preserve A and P
 780
 781 my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args);
 782 my $CALC = Math::BigInt->config()->{lib};
 783 while (<DATA>)
 784   {
 785   $_ =~ s/[\n\r]//g;    # remove newlines
 786   next if /^\s*(#|$)/;  # skip comments and empty lines
 787   if (s/^&//)
 788     {
 789     $f = $_; next;      # function
 790     }
 791   @args = split(/:/,$_,99);
 792   my $ans = pop(@args);
 793
 794   ($x,$xa,$xp) = split (/,/,$args[0]);
 795   $xa = $xa || ''; $xp = $xp || '';
 796   $try  = "\$x = $mbi->new('$x'); ";
 797   $try .= "\$x->accuracy($xa); " if $xa ne '';
 798   $try .= "\$x->precision($xp); " if $xp ne '';
 799
 800   ($y,$ya,$yp) = split (/,/,$args[1]);
 801   $ya = $ya || ''; $yp = $yp || '';
 802   $try .= "\$y = $mbi->new('$y'); ";
 803   $try .= "\$y->accuracy($ya); " if $ya ne '';
 804   $try .= "\$y->precision($yp); " if $yp ne '';
 805
 806   $try .= "\$x->$f(\$y);";
 807
 808   # print "trying $try\n";
 809   $rc = eval $try;
 810   # convert hex/binary targets to decimal
 811   if ($ans =~ /^(0x0x|0b0b)/)
 812     {
 813     $ans =~ s/^0[xb]//;
 814     $ans = $mbi->new($ans)->bstr();
 815     }
 816   print "# Tried: '$try'\n" if !ok ($rc, $ans);
 817   # check internal state of number objects
 818   is_valid($rc,$f) if ref $rc;
 819
 820   # now check whether A and P are set correctly
 821   # only one of $a or $p will be set (no crossing here)
 822   $a = $xa || $ya; $p = $xp || $yp;
 823
 824   # print "Check a=$a p=$p\n";
 825   # print "# Tried: '$try'\n";
 826   if ($a ne '')
 827     {
 828     if (!(ok ($x->{_a}, $a) && ok_undef ($x->{_p})))
 829       {
 830       print "# Check: A=$a and P=undef\n";
 831       print "# Tried: '$try'\n";
 832       }
 833     }
 834   if ($p ne '')
 835     {
 836     if (!(ok ($x->{_p}, $p) && ok_undef ($x->{_a})))
 837       {
 838       print "# Check: A=undef and P=$p\n";
 839       print "# Tried: '$try'\n";
 840       }
 841     }
 842   }
 843
 844 # all done
 845 1;
 846
 847 ###############################################################################
 848 ###############################################################################
 849 # Perl 5.005 does not like ok ($x,undef)
 850
 851 sub ok_undef
 852   {
 853   my $x = shift;
 854
 855   ok (1,1) and return 1 if !defined $x;
 856   ok ($x,'undef');
 857   print "# Called from ",join(' ',caller()),"\n";
 858   return 0;
 859   }
 860
 861 ###############################################################################
 862 # sub to check validity of a BigInt internally, to ensure that no op leaves a
 863 # number object in an invalid state (f.i. "-0")
 864
 865 sub is_valid
 866   {
 867   my ($x,$f) = @_;
 868
 869   my $e = 0;                    # error?
 870   # ok as reference?
 871   $e = 'Not a reference' if !ref($x);
 872
 873   # has ok sign?
 874   $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
 875    if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
 876
 877   $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
 878   $e = $CALC->_check($x->{value}) if $e eq '0';
 879
 880   # test done, see if error did crop up
 881   ok (1,1), return if ($e eq '0');
 882
 883   ok (1,$e." after op '$f'");
 884   }
 885
 886 # format is:
 887 # x,A,P:x,A,P:result
 888 # 123,,3 means 123 with precision 3 (A is undef)
 889 # the A or P of the result is calculated automatically
 890 __DATA__
 891 &badd
 892 123,,:123,,:246
 893 123,3,:0,,:123
 894 123,,-3:0,,:123
 895 123,,:0,3,:123
 896 123,,:0,,-3:123
 897 &bmul
 898 123,,:1,,:123
 899 123,3,:0,,:0
 900 123,,-3:0,,:0
 901 123,,:0,3,:0
 902 123,,:0,,-3:0
 903 123,3,:1,,:123
 904 123,,-3:1,,:123
 905 123,,:1,3,:123
 906 123,,:1,,-3:123
 907 1,3,:123,,:123
 908 1,,-3:123,,:123
 909 1,,:123,3,:123
 910 1,,:123,,-3:123
 911 &bdiv
 912 123,,:1,,:123
 913 123,4,:1,,:123
 914 123,,:1,4,:123
 915 123,,:1,,-4:123
 916 123,,-4:1,,:123
 917 1,4,:123,,:0
 918 1,,:123,4,:0
 919 1,,:123,,-4:0
 920 1,,-4:123,,:0
 921 &band
 922 1,,:3,,:1
 923 1234,1,:0,,:0
 924 1234,,:0,1,:0
 925 1234,,-1:0,,:0
 926 1234,,:0,,-1:0
 927 0xFF,,:0x10,,:0x0x10
 928 0xFF,2,:0xFF,,:250
 929 0xFF,,:0xFF,2,:250
 930 0xFF,,1:0xFF,,:250
 931 0xFF,,:0xFF,,1:250
 932 &bxor
 933 1,,:3,,:2
 934 1234,1,:0,,:1000
 935 1234,,:0,1,:1000
 936 1234,,3:0,,:1000
 937 1234,,:0,,3:1000
 938 0xFF,,:0x10,,:239
 939 # 250 ^ 255 => 5
 940 0xFF,2,:0xFF,,:5
 941 0xFF,,:0xFF,2,:5
 942 0xFF,,1:0xFF,,:5
 943 0xFF,,:0xFF,,1:5
 944 # 250 ^ 4095 = 3845 => 3800
 945 0xFF,2,:0xFFF,,:3800
 946 # 255 ^ 4100 = 4347 => 4300
 947 0xFF,,:0xFFF,2,:4300
 948 0xFF,,2:0xFFF,,:3800
 949 # 255 ^ 4100 = 10fb => 4347 => 4300
 950 0xFF,,:0xFFF,,2:4300
 951 &bior
 952 1,,:3,,:3
 953 1234,1,:0,,:1000
 954 1234,,:0,1,:1000
 955 1234,,3:0,,:1000
 956 1234,,:0,,3:1000
 957 0xFF,,:0x10,,:0x0xFF
 958 # FF | FA = FF => 250
 959 250,2,:0xFF,,:250
 960 0xFF,,:250,2,:250
 961 0xFF,,1:0xFF,,:250
 962 0xFF,,:0xFF,,1:250
 963 &bpow
 964 2,,:3,,:8
 965 2,,:0,,:1
 966 2,2,:0,,:1
 967 2,,:0,2,:1