dist/Math-BigInt/t/mbimbf.inc

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