lib/Math/BigInt/t/mbimbf.t

   1 #!/usr/bin/perl -w
   2
   3 # test rounding, accuracy, precicion and fallback, round_mode and mixing
   4 # of classes
   5
   6 use strict;
   7 use Test;
   8
   9 BEGIN
  10   {
  11   $| = 1;
  12   # chdir 't' if -d 't';
  13   unshift @INC, '../lib'; # for running manually
  14   plan tests => 246;
  15   }
  16
  17 # for finding out whether round finds correct class
  18 package Foo;
  19
  20 use Math::BigInt;
  21 use vars qw/@ISA $precision $accuracy $div_scale $round_mode/;
  22 @ISA = qw/Math::BigInt/;
  23
  24 $precision = 6;
  25 $accuracy = 8;
  26 $div_scale = 5;
  27 $round_mode = 'odd';
  28
  29 sub new
  30   {
  31   my $class = shift;
  32   my $self = { _a => undef, _p => undef, value => 5 };
  33   bless $self, $class;
  34   }
  35
  36 sub bstr
  37   {
  38   my $self = shift;
  39
  40   return "$self->{value}";
  41   }
  42
  43 # these will be called with the rounding precision or accuracy, depending on
  44 # class
  45 sub bround
  46   {
  47   my ($self,$a,$r) = @_;
  48   $self->{value} = 'a' x $a;
  49   return $self;
  50   }
  51
  52 sub bnorm
  53   {
  54   my $self = shift;
  55   return $self;
  56   }
  57
  58 sub bfround
  59   {
  60   my ($self,$p,$r) = @_;
  61   $self->{value} = 'p' x $p;
  62   return $self;
  63   }
  64
  65 package main;
  66
  67 use Math::BigInt;
  68 use Math::BigFloat;
  69
  70 my ($x,$y,$z,$u);
  71
  72 ###############################################################################
  73 # test defaults and set/get
  74
  75 ok_undef ($Math::BigInt::accuracy);
  76 ok_undef ($Math::BigInt::precision);
  77 ok_undef (Math::BigInt->accuracy());
  78 ok_undef (Math::BigInt->precision());
  79 ok ($Math::BigInt::div_scale,40);
  80 ok (Math::BigInt::div_scale(),40);
  81 ok ($Math::BigInt::round_mode,'even');
  82 ok (Math::BigInt::round_mode(),'even');
  83
  84 ok_undef ($Math::BigFloat::accuracy);
  85 ok_undef ($Math::BigFloat::precision);
  86 ok_undef (Math::BigFloat->accuracy());
  87 ok_undef (Math::BigFloat->precision());
  88 ok ($Math::BigFloat::div_scale,40);
  89 ok (Math::BigFloat::div_scale(),40);
  90 ok ($Math::BigFloat::round_mode,'even');
  91 ok (Math::BigFloat::round_mode(),'even');
  92
  93 # accessors
  94 foreach my $class (qw/Math::BigInt Math::BigFloat/)
  95   {
  96   ok_undef ($class->accuracy());
  97   ok_undef ($class->precision());
  98   ok ($class->round_mode(),'even');
  99   ok ($class->div_scale(),40);
 100
 101   ok ($class->div_scale(20),20);
 102   $class->div_scale(40); ok ($class->div_scale(),40);
 103
 104   ok ($class->round_mode('odd'),'odd');
 105   $class->round_mode('even'); ok ($class->round_mode(),'even');
 106
 107   ok ($class->accuracy(2),2);
 108   $class->accuracy(3); ok ($class->accuracy(),3);
 109   ok_undef ($class->accuracy(undef));
 110
 111   ok ($class->precision(2),2);
 112   ok ($class->precision(-2),-2);
 113   $class->precision(3); ok ($class->precision(),3);
 114   ok_undef ($class->precision(undef));
 115   }
 116
 117 # accuracy
 118 foreach (qw/5 42 -1 0/)
 119   {
 120   ok ($Math::BigFloat::accuracy = $_,$_);
 121   ok ($Math::BigInt::accuracy = $_,$_);
 122   }
 123 ok_undef ($Math::BigFloat::accuracy = undef);
 124 ok_undef ($Math::BigInt::accuracy = undef);
 125
 126 # precision
 127 foreach (qw/5 42 -1 0/)
 128   {
 129   ok ($Math::BigFloat::precision = $_,$_);
 130   ok ($Math::BigInt::precision = $_,$_);
 131   }
 132 ok_undef ($Math::BigFloat::precision = undef);
 133 ok_undef ($Math::BigInt::precision = undef);
 134
 135 # fallback
 136 foreach (qw/5 42 1/)
 137   {
 138   ok ($Math::BigFloat::div_scale = $_,$_);
 139   ok ($Math::BigInt::div_scale = $_,$_);
 140   }
 141 # illegal values are possible for fallback due to no accessor
 142
 143 # round_mode
 144 foreach (qw/odd even zero trunc +inf -inf/)
 145   {
 146   ok ($Math::BigFloat::round_mode = $_,$_);
 147   ok ($Math::BigInt::round_mode = $_,$_);
 148   }
 149 $Math::BigFloat::round_mode = 'zero';
 150 ok ($Math::BigFloat::round_mode,'zero');
 151 ok ($Math::BigInt::round_mode,'-inf');  # from above
 152
 153 $Math::BigInt::accuracy = undef;
 154 $Math::BigInt::precision = undef;
 155 # local copies
 156 $x = Math::BigFloat->new(123.456);
 157 ok_undef ($x->accuracy());
 158 ok ($x->accuracy(5),5);
 159 ok_undef ($x->accuracy(undef),undef);
 160 ok_undef ($x->precision());
 161 ok ($x->precision(5),5);
 162 ok_undef ($x->precision(undef),undef);
 163
 164 # see if MBF changes MBIs values
 165 ok ($Math::BigInt::accuracy = 42,42);
 166 ok ($Math::BigFloat::accuracy = 64,64);
 167 ok ($Math::BigInt::accuracy,42);                # should be still 42
 168 ok ($Math::BigFloat::accuracy,64);              # should be still 64
 169
 170 ###############################################################################
 171 # see if creating a number under set A or P will round it
 172
 173 $Math::BigInt::accuracy = 4;
 174 $Math::BigInt::precision = 3;
 175
 176 ok (Math::BigInt->new(123456),123500);  # with A
 177 $Math::BigInt::accuracy = undef;
 178 ok (Math::BigInt->new(123456),123000);  # with P
 179
 180 $Math::BigFloat::accuracy = 4;
 181 $Math::BigFloat::precision = -1;
 182 $Math::BigInt::precision = undef;
 183
 184 ok (Math::BigFloat->new(123.456),123.5);        # with A
 185 $Math::BigFloat::accuracy = undef;
 186 ok (Math::BigFloat->new(123.456),123.5);        # with P from MBF, not MBI!
 187
 188 $Math::BigFloat::precision = undef;
 189
 190 ###############################################################################
 191 # see if setting accuracy/precision actually rounds the number
 192
 193 $x = Math::BigFloat->new(123.456); $x->accuracy(4);   ok ($x,123.5);
 194 $x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46);
 195
 196 $x = Math::BigInt->new(123456);    $x->accuracy(4);   ok ($x,123500);
 197 $x = Math::BigInt->new(123456);    $x->precision(2);  ok ($x,123500);
 198
 199 ###############################################################################
 200 # test actual rounding via round()
 201
 202 $x = Math::BigFloat->new(123.456);
 203 ok ($x->copy()->round(5,2),123.46);
 204 ok ($x->copy()->round(4,2),123.5);
 205 ok ($x->copy()->round(undef,-2),123.46);
 206 ok ($x->copy()->round(undef,2),100);
 207
 208 $x = Math::BigFloat->new(123.45000);
 209 ok ($x->copy()->round(undef,-1,'odd'),123.5);
 210
 211 # see if rounding is 'sticky'
 212 $x = Math::BigFloat->new(123.4567);
 213 $y = $x->copy()->bround();              # no-op since nowhere A or P defined
 214
 215 ok ($y,123.4567);
 216 $y = $x->copy()->round(5,2);
 217 ok ($y->accuracy(),5);
 218 ok_undef ($y->precision());             # A has precedence, so P still unset
 219 $y = $x->copy()->round(undef,2);
 220 ok ($y->precision(),2);
 221 ok_undef ($y->accuracy());              # P has precedence, so A still unset
 222
 223 # see if setting A clears P and vice versa
 224 $x = Math::BigFloat->new(123.4567);
 225 ok ($x,123.4567);
 226 ok ($x->accuracy(4),4);
 227 ok ($x->precision(-2),-2);              # clear A
 228 ok_undef ($x->accuracy());
 229
 230 $x = Math::BigFloat->new(123.4567);
 231 ok ($x,123.4567);
 232 ok ($x->precision(-2),-2);
 233 ok ($x->accuracy(4),4);                 # clear P
 234 ok_undef ($x->precision());
 235
 236 # does copy work?
 237 $x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
 238 $z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
 239
 240 ###############################################################################
 241 # test wether operations round properly afterwards
 242 # These tests are not complete, since they do not excercise every "return"
 243 # statement in the op's. But heh, it's better than nothing...
 244
 245 $x = Math::BigFloat->new(123.456);
 246 $y = Math::BigFloat->new(654.321);
 247 $x->{_a} = 5;           # $x->accuracy(5) would round $x straightaway
 248 $y->{_a} = 4;           # $y->accuracy(4) would round $x straightaway
 249
 250 $z = $x + $y;           ok ($z,777.8);
 251 $z = $y - $x;           ok ($z,530.9);
 252 $z = $y * $x;           ok ($z,80780);
 253 $z = $x ** 2;           ok ($z,15241);
 254 $z = $x * $x;           ok ($z,15241);
 255
 256 # not: $z = -$x;                ok ($z,-123.46); ok ($x,123.456);
 257 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
 258 $x = Math::BigFloat->new(123456); $x->{_a} = 4;
 259 $z = $x->copy; $z++;    ok ($z,123500);
 260
 261 $x = Math::BigInt->new(123456);
 262 $y = Math::BigInt->new(654321);
 263 $x->{_a} = 5;           # $x->accuracy(5) would round $x straightaway
 264 $y->{_a} = 4;           # $y->accuracy(4) would round $x straightaway
 265
 266 $z = $x + $y;           ok ($z,777800);
 267 $z = $y - $x;           ok ($z,530900);
 268 $z = $y * $x;           ok ($z,80780000000);
 269 $z = $x ** 2;           ok ($z,15241000000);
 270 # not yet: $z = -$x;            ok ($z,-123460); ok ($x,123456);
 271 $z = $x->copy; $z++;    ok ($z,123460);
 272 $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
 273
 274 $x = Math::BigInt->new(123400); $x->{_a} = 4;
 275 ok ($x->bnot(),-123400);                        # not -1234001
 276
 277 # both babs() and bneg() don't need to round, since the input will already
 278 # be rounded (either as $x or via new($string)), and they don't change the
 279 # value
 280 # The two tests below peek at this by using _a illegally
 281 $x = Math::BigInt->new(-123401); $x->{_a} = 4;
 282 ok ($x->babs(),123401);
 283 $x = Math::BigInt->new(-123401); $x->{_a} = 4;
 284 ok ($x->bneg(),123401);
 285
 286 ###############################################################################
 287 # test mixed arguments
 288
 289 $x = Math::BigFloat->new(10);
 290 $u = Math::BigFloat->new(2.5);
 291 $y = Math::BigInt->new(2);
 292
 293 $z = $x + $y; ok ($z,12); ok (ref($z),'Math::BigFloat');
 294 $z = $x / $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
 295 $z = $u * $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
 296
 297 $y = Math::BigInt->new(12345);
 298 $z = $u->copy()->bmul($y,2,0,'odd'); ok ($z,31000);
 299 $z = $u->copy()->bmul($y,3,0,'odd'); ok ($z,30900);
 300 $z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
 301 $z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
 302 $z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
 303
 304 # breakage:
 305 # $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
 306 # $z = $y * $u; ok ($z,5); ok (ref($z),'Math::BigInt');
 307 # $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
 308 # $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
 309
 310 ###############################################################################
 311 # rounding in bdiv with fallback and already set A or P
 312
 313 $Math::BigFloat::accuracy = undef;
 314 $Math::BigFloat::precision = undef;
 315 $Math::BigFloat::div_scale = 40;
 316
 317 $x = Math::BigFloat->new(10); $x->{_a} = 4;
 318 ok ($x->bdiv(3),'3.333');
 319 ok ($x->{_a},4);                        # set's it since no fallback
 320
 321 $x = Math::BigFloat->new(10); $x->{_a} = 4; $y = Math::BigFloat->new(3);
 322 ok ($x->bdiv($y),'3.333');
 323 ok ($x->{_a},4);                        # set's it since no fallback
 324
 325 # rounding to P of x
 326 $x = Math::BigFloat->new(10); $x->{_p} = -2;
 327 ok ($x->bdiv(3),'3.33');
 328
 329 # round in div with requested P
 330 $x = Math::BigFloat->new(10);
 331 ok ($x->bdiv(3,undef,-2),'3.33');
 332
 333 # round in div with requested P greater than fallback
 334 $Math::BigFloat::div_scale = 5;
 335 $x = Math::BigFloat->new(10);
 336 ok ($x->bdiv(3,undef,-8),'3.33333333');
 337 $Math::BigFloat::div_scale = 40;
 338
 339 $x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_a} = 4;
 340 ok ($x->bdiv($y),'3.333');
 341 ok ($x->{_a},4); ok ($y->{_a},4);       # set's it since no fallback
 342 ok_undef ($x->{_p}); ok_undef ($y->{_p});
 343
 344 # rounding to P of y
 345 $x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_p} = -2;
 346 ok ($x->bdiv($y),'3.33');
 347 ok ($x->{_p},-2);
 348  ok ($y->{_p},-2);
 349 ok_undef ($x->{_a}); ok_undef ($y->{_a});
 350
 351 ###############################################################################
 352 # test whether bround(-n) fails in MBF (undocumented in MBI)
 353 eval { $x = Math::BigFloat->new(1); $x->bround(-2); };
 354 ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
 355
 356 # test whether rounding to higher accuracy is no-op
 357 $x = Math::BigFloat->new(1); $x->{_a} = 4;
 358 ok ($x,'1.000');
 359 $x->bround(6);                  # must be no-op
 360 ok ($x->{_a},4);
 361 ok ($x,'1.000');
 362
 363 $x = Math::BigInt->new(1230); $x->{_a} = 3;
 364 ok ($x,'1230');
 365 $x->bround(6);                  # must be no-op
 366 ok ($x->{_a},3);
 367 ok ($x,'1230');
 368
 369 # bround(n) should set _a
 370 $x->bround(2);                  # smaller works
 371 ok ($x,'1200');
 372 ok ($x->{_a},2);
 373
 374 # bround(-n) is undocumented and only used by MBF
 375 # bround(-n) should set _a
 376 $x = Math::BigInt->new(12345);
 377 $x->bround(-1);
 378 ok ($x,'12300');
 379 ok ($x->{_a},4);
 380
 381 # bround(-n) should set _a
 382 $x = Math::BigInt->new(12345);
 383 $x->bround(-2);
 384 ok ($x,'12000');
 385 ok ($x->{_a},3);
 386
 387 # bround(-n) should set _a
 388 $x = Math::BigInt->new(12345); $x->{_a} = 5;
 389 $x->bround(-3);
 390 ok ($x,'10000');
 391 ok ($x->{_a},2);
 392
 393 # bround(-n) should set _a
 394 $x = Math::BigInt->new(12345); $x->{_a} = 5;
 395 $x->bround(-4);
 396 ok ($x,'00000');
 397 ok ($x->{_a},1);
 398
 399 # bround(-n) should be noop if n too big
 400 $x = Math::BigInt->new(12345);
 401 $x->bround(-5);
 402 ok ($x,'0');                    # scale to "big" => 0
 403 ok ($x->{_a},0);
 404
 405 # bround(-n) should be noop if n too big
 406 $x = Math::BigInt->new(54321);
 407 $x->bround(-5);
 408 ok ($x,'100000');               # used by MBF to round 0.0054321 at 0.0_6_00000
 409 ok ($x->{_a},0);
 410
 411 # bround(-n) should be noop if n too big
 412 $x = Math::BigInt->new(54321); $x->{_a} = 5;
 413 $x->bround(-6);
 414 ok ($x,'100000');               # no-op
 415 ok ($x->{_a},0);
 416
 417 # bround(n) should set _a
 418 $x = Math::BigInt->new(12345); $x->{_a} = 5;
 419 $x->bround(5);                  # must be no-op
 420 ok ($x,'12345');
 421 ok ($x->{_a},5);
 422
 423 # bround(n) should set _a
 424 $x = Math::BigInt->new(12345); $x->{_a} = 5;
 425 $x->bround(6);                  # must be no-op
 426 ok ($x,'12345');
 427
 428 $x = Math::BigFloat->new(0.0061); $x->bfround(-2);
 429 ok ($x,0.01);
 430
 431 ###############################################################################
 432 # rounding with already set precision/accuracy
 433
 434 $x = Math::BigFloat->new(1); $x->{_p} = -5;
 435 ok ($x,'1.00000');
 436
 437 # further rounding donw
 438 ok ($x->bfround(-2),'1.00');
 439 ok ($x->{_p},-2);
 440
 441 $x = Math::BigFloat->new(12345); $x->{_a} = 5;
 442 ok ($x->bround(2),'12000');
 443 ok ($x->{_a},2);
 444
 445 $x = Math::BigFloat->new(1.2345); $x->{_a} = 5;
 446 ok ($x->bround(2),'1.2');
 447 ok ($x->{_a},2);
 448
 449 # mantissa/exponent format and A/P
 450 $x = Math::BigFloat->new(12345.678); $x->accuracy(4);
 451 ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
 452 ok ($x->{_m}->{_f},1); ok ($x->{_e}->{_f},1);
 453 ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
 454 ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
 455
 456 # check for no A/P in case of fallback
 457 # result
 458 $x = Math::BigFloat->new(100) / 3;
 459 ok_undef ($x->{_a}); ok_undef ($x->{_p});
 460
 461 # result & reminder
 462 $x = Math::BigFloat->new(100) / 3; ($x,$y) = $x->bdiv(3);
 463 ok_undef ($x->{_a}); ok_undef ($x->{_p});
 464 ok_undef ($y->{_a}); ok_undef ($y->{_p});
 465
 466 ###############################################################################
 467 # math with two numbers with differen A and P
 468
 469 $x = Math::BigFloat->new(12345); $x->accuracy(4);       # '12340'
 470 $y = Math::BigFloat->new(12345); $y->accuracy(2);       # '12000'
 471 ok ($x+$y,24000);                               # 12340+12000=> 24340 => 24000
 472
 473 $x = Math::BigFloat->new(54321); $x->accuracy(4);       # '12340'
 474 $y = Math::BigFloat->new(12345); $y->accuracy(3);       # '12000'
 475 ok ($x-$y,42000);                               # 54320+12300=> 42020 => 42000
 476
 477 $x = Math::BigFloat->new(1.2345); $x->precision(-2);    # '1.23'
 478 $y = Math::BigFloat->new(1.2345); $y->precision(-4);    # '1.2345'
 479 ok ($x+$y,2.46);                        # 1.2345+1.2300=> 2.4645 => 2.46
 480
 481 ###############################################################################
 482 # round should find and use proper class
 483
 484 $x = Foo->new();
 485 ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
 486 ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
 487 ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
 488 ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
 489
 490 ###############################################################################
 491 # find out whether _find_round_parameters is doing what's it's supposed to do
 492
 493 $Math::BigInt::accuracy = undef;
 494 $Math::BigInt::precision = undef;
 495 $Math::BigInt::div_scale = 40;
 496 $Math::BigInt::round_mode = 'odd';
 497
 498 $x = Math::BigInt->new(123);
 499 my @params = $x->_find_round_parameters();
 500 ok (scalar @params,1);                          # nothing to round
 501
 502 @params = $x->_find_round_parameters(1);
 503 ok (scalar @params,4);                          # a=1
 504 ok ($params[0],$x);                             # self
 505 ok ($params[1],1);                              # a
 506 ok_undef ($params[2]);                          # p
 507 ok ($params[3],'odd');                          # round_mode
 508
 509 @params = $x->_find_round_parameters(undef,2);
 510 ok (scalar @params,4);                          # p=2
 511 ok ($params[0],$x);                             # self
 512 ok_undef ($params[1]);                          # a
 513 ok ($params[2],2);                              # p
 514 ok ($params[3],'odd');                          # round_mode
 515
 516 eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
 517 ok ($@ =~ /^Unknown round mode 'foo'/,1);
 518
 519 @params = $x->_find_round_parameters(undef,2,'+inf');
 520 ok (scalar @params,4);                          # p=2
 521 ok ($params[0],$x);                             # self
 522 ok_undef ($params[1]);                          # a
 523 ok ($params[2],2);                              # p
 524 ok ($params[3],'+inf');                         # round_mode
 525
 526 @params = $x->_find_round_parameters(2,-2,'+inf');
 527 ok (scalar @params,4);                          # p=2
 528 ok ($params[0],$x);                             # self
 529 ok ($params[1],2);                              # a
 530 ok ($params[2],-2);                             # p
 531 ok ($params[3],'+inf');                         # round_mode
 532
 533 # all done
 534
 535 ###############################################################################
 536 # Perl 5.005 does not like ok ($x,undef)
 537
 538 sub ok_undef
 539   {
 540   my $x = shift;
 541
 542   ok (1,1) and return if !defined $x;
 543   ok ($x,'undef');
 544   }
 545