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 7use strict; 8use warnings; 9 10my ($x, $y, $z, $u, $rc); 11our ($mbi, $mbf); 12 13############################################################################### 14# test defaults and set/get 15 16{ 17 no strict 'refs'; 18 is(${"$mbi\::accuracy"}, undef, qq|\${"$mbi\::accuracy"}|); 19 is(${"$mbi\::precision"}, undef, qq|\${"$mbi\::precision"}|); 20 is($mbi->accuracy(), undef, qq|$mbi->accuracy()|); 21 is($mbi->precision(), undef, qq|$mbi->precision()|); 22 is(${"$mbi\::div_scale"}, 40, qq|\${"$mbi\::div_scale"}|); 23 is(${"$mbi\::round_mode"}, 'even', qq|\${"$mbi\::round_mode"}|); 24 is($mbi->round_mode(), 'even', qq|$mbi->round_mode()|); 25 26 is(${"$mbf\::accuracy"}, undef, qq|\${"$mbf\::accuracy"}|); 27 is(${"$mbf\::precision"}, undef, qq|\${"$mbf\::precision"}|); 28 is($mbf->precision(), undef, qq|$mbf->precision()|); 29 is($mbf->precision(), undef, qq|$mbf->precision()|); 30 is(${"$mbf\::div_scale"}, 40, qq|\${"$mbf\::div_scale"}|); 31 is(${"$mbf\::round_mode"}, 'even', qq|\${"$mbf\::round_mode"}|); 32 is($mbf->round_mode(), 'even', qq|$mbf->round_mode()|); 33} 34 35# accessors 36foreach my $class ($mbi, $mbf) { 37 is($class->accuracy(), undef, qq|$class->accuracy()|); 38 is($class->precision(), undef, qq|$class->precision()|); 39 is($class->round_mode(), "even", qq|$class->round_mode()|); 40 is($class->div_scale(), 40, qq|$class->div_scale()|); 41 42 is($class->div_scale(20), 20, qq|$class->div_scale(20)|); 43 $class->div_scale(40); 44 is($class->div_scale(), 40, qq|$class->div_scale()|); 45 46 is($class->round_mode("odd"), "odd", qq|$class->round_mode("odd")|); 47 $class->round_mode("even"); 48 is($class->round_mode(), "even", qq|$class->round_mode()|); 49 50 is($class->accuracy(2), 2, qq|$class->accuracy(2)|); 51 $class->accuracy(3); 52 is($class->accuracy(), 3, qq|$class->accuracy()|); 53 is($class->accuracy(undef), undef, qq|$class->accuracy(undef)|); 54 55 is($class->precision(2), 2, qq|$class->precision(2)|); 56 is($class->precision(-2), -2, qq|$class->precision(-2)|); 57 $class->precision(3); 58 is($class->precision(), 3, qq|$class->precision()|); 59 is($class->precision(undef), undef, qq|$class->precision(undef)|); 60} 61 62{ 63 no strict 'refs'; 64 65 # accuracy 66 foreach (qw/5 42 -1 0/) { 67 is(${"$mbf\::accuracy"} = $_, $_, qq|\${"$mbf\::accuracy"} = $_|); 68 is(${"$mbi\::accuracy"} = $_, $_, qq|\${"$mbi\::accuracy"} = $_|); 69 } 70 is(${"$mbf\::accuracy"} = undef, undef, qq|\${"$mbf\::accuracy"} = undef|); 71 is(${"$mbi\::accuracy"} = undef, undef, qq|\${"$mbi\::accuracy"} = undef|); 72 73 # precision 74 foreach (qw/5 42 -1 0/) { 75 is(${"$mbf\::precision"} = $_, $_, qq|\${"$mbf\::precision"} = $_|); 76 is(${"$mbi\::precision"} = $_, $_, qq|\${"$mbi\::precision"} = $_|); 77 } 78 is(${"$mbf\::precision"} = undef, undef, 79 qq|\${"$mbf\::precision"} = undef|); 80 is(${"$mbi\::precision"} = undef, undef, 81 qq|\${"$mbi\::precision"} = undef|); 82 83 # fallback 84 foreach (qw/5 42 1/) { 85 is(${"$mbf\::div_scale"} = $_, $_, qq|\${"$mbf\::div_scale"} = $_|); 86 is(${"$mbi\::div_scale"} = $_, $_, qq|\${"$mbi\::div_scale"} = $_|); 87 } 88 # illegal values are possible for fallback due to no accessor 89 90 # round_mode 91 foreach (qw/odd even zero trunc +inf -inf/) { 92 is(${"$mbf\::round_mode"} = $_, $_, 93 qq|\${"$mbf\::round_mode"} = "$_"|); 94 is(${"$mbi\::round_mode"} = $_, $_, 95 qq|\${"$mbi\::round_mode"} = "$_"|); 96 } 97 ${"$mbf\::round_mode"} = 'zero'; 98 is(${"$mbf\::round_mode"}, 'zero', qq|\${"$mbf\::round_mode"}|); 99 is(${"$mbi\::round_mode"}, '-inf', qq|\${"$mbi\::round_mode"}|); 100 101 # reset for further tests 102 ${"$mbi\::accuracy"} = undef; 103 ${"$mbi\::precision"} = undef; 104 ${"$mbf\::div_scale"} = 40; 105} 106 107# local copies 108$x = $mbf->new('123.456'); 109is($x->accuracy(), undef, q|$x->accuracy()|); 110is($x->accuracy(5), 5, q|$x->accuracy(5)|); 111is($x->accuracy(undef), undef, q|$x->accuracy(undef)|); 112is($x->precision(), undef, q|$x->precision()|); 113is($x->precision(5), 5, q|$x->precision(5)|); 114is($x->precision(undef), undef, q|$x->precision(undef)|); 115 116{ 117 no strict 'refs'; 118 # see if MBF changes MBIs values 119 is(${"$mbi\::accuracy"} = 42, 42, qq|\${"$mbi\::accuracy"} = 42|); 120 is(${"$mbf\::accuracy"} = 64, 64, qq|\${"$mbf\::accuracy"} = 64|); 121 is(${"$mbi\::accuracy"}, 42, qq|\${"$mbi\::accuracy"} = 42|); 122 is(${"$mbf\::accuracy"}, 64, qq|\${"$mbf\::accuracy"} = 64|); 123} 124 125############################################################################### 126# see if creating a number under set A or P will round it 127 128{ 129 no strict 'refs'; 130 ${"$mbi\::accuracy"} = 4; 131 ${"$mbi\::precision"} = undef; 132 133 is($mbi->new(123456), 123500, qq|$mbi->new(123456) = 123500|); # with A 134 ${"$mbi\::accuracy"} = undef; 135 ${"$mbi\::precision"} = 3; 136 is($mbi->new(123456), 123000, qq|$mbi->new(123456) = 123000|); # with P 137 138 ${"$mbf\::accuracy"} = 4; 139 ${"$mbf\::precision"} = undef; 140 ${"$mbi\::precision"} = undef; 141 142 is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|); 143 ${"$mbf\::accuracy"} = undef; 144 ${"$mbf\::precision"} = -1; 145 is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|); 146 147 ${"$mbf\::precision"} = undef; # reset 148} 149 150############################################################################### 151# see if MBI leaves MBF's private parts alone 152 153{ 154 no strict 'refs'; 155 ${"$mbi\::precision"} = undef; 156 ${"$mbf\::precision"} = undef; 157 ${"$mbi\::accuracy"} = 4; 158 ${"$mbf\::accuracy"} = undef; 159 is($mbf->new("123.456"), "123.456", qq|$mbf->new("123.456") = 123.456|); 160 ${"$mbi\::accuracy"} = undef; # reset 161} 162 163############################################################################### 164# see if setting accuracy/precision actually rounds the number 165 166$x = $mbf->new("123.456"); 167$x->accuracy(4); 168is($x, "123.5", qq|\$x = $mbf->new("123.456"); \$x->accuracy(4)|); 169 170$x = $mbf->new("123.456"); 171$x->precision(-2); 172is($x, "123.46", qq|\$x = $mbf->new("123.456"); \$x->precision(-2)|); 173 174$x = $mbi->new(123456); 175$x->accuracy(4); 176is($x, 123500, qq|\$x = $mbi->new(123456); \$x->accuracy(4)|); 177 178$x = $mbi->new(123456); 179$x->precision(2); 180is($x, 123500, qq|\$x = $mbi->new(123456); \$x->precision(2)|); 181 182############################################################################### 183# test actual rounding via round() 184 185$x = $mbf->new("123.456"); 186is($x->copy()->round(5), "123.46", 187 qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5)|); 188is($x->copy()->round(4), "123.5", 189 qq|\$x = $mbf->new("123.456"); \$x->copy()->round(4)|); 190is($x->copy()->round(5, 2), "NaN", 191 qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5, 2)|); 192is($x->copy()->round(undef, -2), "123.46", 193 qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, -2)|); 194is($x->copy()->round(undef, 2), 120, 195 qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, 2)|); 196 197$x = $mbi->new("123"); 198is($x->round(5, 2), "NaN", 199 qq|\$x = $mbi->new("123"); \$x->round(5, 2)|); 200 201$x = $mbf->new("123.45000"); 202is($x->copy()->round(undef, -1, "odd"), "123.5", 203 qq|\$x = $mbf->new("123.45000"); \$x->copy()->round(undef, -1, "odd")|); 204 205# see if rounding is 'sticky' 206$x = $mbf->new("123.4567"); 207$y = $x->copy()->bround(); # no-op since nowhere A or P defined 208 209is($y, 123.4567, 210 qq|\$x = $mbf->new("123.4567"); \$y = \$x->copy()->bround()|); 211$y = $x->copy()->round(5); 212is($y->accuracy(), 5, 213 q|$y = $x->copy()->round(5); $y->accuracy()|); 214is($y->precision(), undef, # A has precedence, so P still unset 215 q|$y = $x->copy()->round(5); $y->precision()|); 216$y = $x->copy()->round(undef, 2); 217is($y->precision(), 2, 218 q|$y = $x->copy()->round(undef, 2); $y->precision()|); 219is($y->accuracy(), undef, # P has precedence, so A still unset 220 q|$y = $x->copy()->round(undef, 2); $y->accuracy()|); 221 222# see if setting A clears P and vice versa 223$x = $mbf->new("123.4567"); 224is($x, "123.4567", q|$x = $mbf->new("123.4567")|); 225is($x->accuracy(4), 4, q|$x->accuracy(4)|); 226is($x->precision(-2), -2, q|$x->precision(-2)|); # clear A 227is($x->accuracy(), undef, q|$x->accuracy()|); 228 229$x = $mbf->new("123.4567"); 230is($x, "123.4567", q|$x = $mbf->new("123.4567")|); 231is($x->precision(-2), -2, q|$x->precision(-2)|); 232is($x->accuracy(4), 4, q|$x->accuracy(4)|); # clear P 233is($x->precision(), undef, q|$x->precision()|); 234 235# does copy work? 236$x = $mbf->new(123.456); 237$x->accuracy(4); 238$x->precision(2); 239 240$z = $x->copy(); 241is($z->accuracy(), undef, q|$z = $x->copy(); $z->accuracy()|); 242is($z->precision(), 2, q|$z = $x->copy(); $z->precision()|); 243 244# does $x->bdiv($y, d) work when $d > div_scale? 245$x = $mbf->new("0.008"); 246$x->accuracy(8); 247 248for my $e (4, 8, 16, 32) { 249 is(scalar $x->copy()->bdiv(3, $e), "0.002" . ("6" x ($e - 2)) . "7", 250 qq|\$x->copy()->bdiv(3, $e)|); 251} 252 253# does accuracy()/precision work on zeros? 254foreach my $class ($mbi, $mbf) { 255 256 $x = $class->bzero(); 257 $x->accuracy(5); 258 is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{_a}|); 259 260 $x = $class->bzero(); 261 $x->precision(5); 262 is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->precision(5); \$x->{_p}|); 263 264 $x = $class->new(0); 265 $x->accuracy(5); 266 is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->accuracy(5); \$x->{_a}|); 267 268 $x = $class->new(0); 269 $x->precision(5); 270 is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->precision(5); \$x->{_p}|); 271 272 $x = $class->bzero(); 273 $x->round(5); 274 is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->round(5); \$x->{_a}|); 275 276 $x = $class->bzero(); 277 $x->round(undef, 5); 278 is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->round(undef, 5); \$x->{_p}|); 279 280 $x = $class->new(0); 281 $x->round(5); 282 is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->round(5); \$x->{_a}|); 283 284 $x = $class->new(0); 285 $x->round(undef, 5); 286 is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->round(undef, 5); \$x->{_p}|); 287 288 # see if trying to increasing A in bzero() doesn't do something 289 $x = $class->bzero(); 290 $x->{_a} = 3; 291 $x->round(5); 292 is($x->{_a}, 3, 293 qq|\$x = $class->bzero(); \$x->{_a} = 3; \$x->round(5); \$x->{_a}|); 294} 295 296############################################################################### 297# test whether an opp calls objectify properly or not (or at least does what 298# it should do given non-objects, w/ or w/o objectify()) 299 300foreach my $class ($mbi, $mbf) { 301 # ${"$class\::precision"} = undef; # reset 302 # ${"$class\::accuracy"} = undef; # reset 303 304 is($class->new(123)->badd(123), 246, qq|$class->new(123)->badd(123)|); 305 is($class->badd(123, 321), 444, qq|$class->badd(123, 321)|); 306 is($class->badd(123, $class->new(321)), 444, 307 qq|$class->badd(123, $class->new(321))|); 308 309 is($class->new(123)->bsub(122), 1, qq|$class->new(123)->bsub(122)|); 310 is($class->bsub(321, 123), 198, qq|$class->bsub(321, 123)|); 311 is($class->bsub(321, $class->new(123)), 198, 312 qq|$class->bsub(321, $class->new(123))|); 313 314 is($class->new(123)->bmul(123), 15129, qq|$class->new(123)->bmul(123)|); 315 is($class->bmul(123, 123), 15129, qq|$class->bmul(123, 123)|); 316 is($class->bmul(123, $class->new(123)), 15129, 317 qq|$class->bmul(123, $class->new(123))|); 318 319 # is($class->new(15129)->bdiv(123), 123, qq|$class->new(15129)->bdiv(123)|); 320 # is($class->bdiv(15129, 123), 123, qq|$class->bdiv(15129, 123)|); 321 # is($class->bdiv(15129, $class->new(123)), 123, 322 # qq|$class->bdiv(15129, $class->new(123))|); 323 324 is($class->new(15131)->bmod(123), 2, qq|$class->new(15131)->bmod(123)|); 325 is($class->bmod(15131, 123), 2, qq|$class->bmod(15131, 123)|); 326 is($class->bmod(15131, $class->new(123)), 2, 327 qq|$class->bmod(15131, $class->new(123))|); 328 329 is($class->new(2)->bpow(16), 65536, qq|$class->new(2)->bpow(16)|); 330 is($class->bpow(2, 16), 65536, qq|$class->bpow(2, 16)|); 331 is($class->bpow(2, $class->new(16)), 65536, 332 qq|$class->bpow(2, $class->new(16))|); 333 334 is($class->new(2**15)->brsft(1), 2**14, qq|$class->new(2**15)->brsft(1)|); 335 is($class->brsft(2**15, 1), 2**14, qq|$class->brsft(2**15, 1)|); 336 is($class->brsft(2**15, $class->new(1)), 2**14, 337 qq|$class->brsft(2**15, $class->new(1))|); 338 339 is($class->new(2**13)->blsft(1), 2**14, qq|$class->new(2**13)->blsft(1)|); 340 is($class->blsft(2**13, 1), 2**14, qq|$class->blsft(2**13, 1)|); 341 is($class->blsft(2**13, $class->new(1)), 2**14, 342 qq|$class->blsft(2**13, $class->new(1))|); 343} 344 345############################################################################### 346# Test whether operations round properly afterwards. 347# These tests are not complete, since they do not exercise every "return" 348# statement in the op's. But heh, it's better than nothing... 349 350$x = $mbf->new("123.456"); 351$y = $mbf->new("654.321"); 352$x->{_a} = 5; # $x->accuracy(5) would round $x straight away 353$y->{_a} = 4; # $y->accuracy(4) would round $x straight away 354 355$z = $x + $y; 356is($z, "777.8", q|$z = $x + $y|); 357 358$z = $y - $x; 359is($z, "530.9", q|$z = $y - $x|); 360 361$z = $y * $x; 362is($z, "80780", q|$z = $y * $x|); 363 364$z = $x ** 2; 365is($z, "15241", q|$z = $x ** 2|); 366 367$z = $x * $x; 368is($z, "15241", q|$z = $x * $x|); 369 370# not: 371#$z = -$x; 372#is($z, '-123.46'); 373#is($x, '123.456'); 374 375$z = $x->copy(); 376$z->{_a} = 2; 377$z = $z / 2; 378is($z, 62, q|$z = $z / 2|); 379 380$x = $mbf->new(123456); 381$x->{_a} = 4; 382$z = $x->copy; 383$z++; 384is($z, 123500, q|$z++|); 385 386$x = $mbi->new(123456); 387$y = $mbi->new(654321); 388$x->{_a} = 5; # $x->accuracy(5) would round $x straight away 389$y->{_a} = 4; # $y->accuracy(4) would round $x straight away 390 391$z = $x + $y; 392is($z, 777800, q|$z = $x + $y|); 393 394$z = $y - $x; 395is($z, 530900, q|$z = $y - $x|); 396 397$z = $y * $x; 398is($z, 80780000000, q|$z = $y * $x|); 399 400$z = $x ** 2; 401is($z, 15241000000, q|$z = $x ** 2|); 402 403# not yet: $z = -$x; 404# is($z, -123460, qq|$z|); 405# is($x, 123456, qq|$x|); 406 407$z = $x->copy; 408$z++; 409is($z, 123460, q|$z++|); 410 411$z = $x->copy(); 412$z->{_a} = 2; 413$z = $z / 2; 414is($z, 62000, q|$z = $z / 2|); 415 416$x = $mbi->new(123400); 417$x->{_a} = 4; 418is($x->bnot(), -123400, q|$x->bnot()|); # not -1234001 419 420# to be consistent with other methods, babs() and bneg() also support rounding 421 422$x = $mbi->new(-123401); 423$x->{_a} = 4; 424is($x->babs(), 123400, q|$x->babs()|); 425 426$x = $mbi->new(-123401); 427$x->{_a} = 4; 428is($x->bneg(), 123400, q|$x->bneg()|); 429 430# test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions) 431 432$mbf->round_mode('even'); 433$x = $mbf->new('740.7')->bdiv('6', 4, undef, 'zero'); 434is($x, '123.4', q|$x|); 435 436$x = $mbi->new('123456'); 437$y = $mbi->new('123456'); 438$y->{_a} = 6; 439is($x->bdiv($y), 1, q|$x->bdiv($y)|); 440is($x->{_a}, 6, q|$x->{_a}|); # carried over 441 442$x = $mbi->new('123456'); 443$y = $mbi->new('123456'); 444$x->{_a} = 6; 445is($x->bdiv($y), 1, q|$x->bdiv($y)|); 446is($x->{_a}, 6, q|$x->{_a}|); # carried over 447 448$x = $mbi->new('123456'); 449$y = $mbi->new('223456'); 450$y->{_a} = 6; 451is($x->bdiv($y), 0, q|$x->bdiv($y)|); 452is($x->{_a}, 6, q|$x->{_a}|); # carried over 453 454$x = $mbi->new('123456'); 455$y = $mbi->new('223456'); 456$x->{_a} = 6; 457is($x->bdiv($y), 0, q|$x->bdiv($y)|); 458is($x->{_a}, 6, q|$x->{_a}|); # carried over 459 460############################################################################### 461# test that bop(0) does the same than bop(undef) 462 463$x = $mbf->new('1234567890'); 464is($x->copy()->bsqrt(0), $x->copy()->bsqrt(undef), 465 q|$x->copy()->bsqrt(...)|); 466is($x->copy->bsqrt(0), '35136.41828644462161665823116758077037159', 467 q|$x->copy->bsqrt(...)|); 468 469is($x->{_a}, undef, q|$x->{_a}|); 470 471# test that bsqrt() modifies $x and does not just return something else 472# (especially under Math::BigInt::BareCalc) 473$z = $x->bsqrt(); 474is($z, $x, q|$z = $x->bsqrt(); $z|); 475is($x, '35136.41828644462161665823116758077037159', q|$z = $x->bsqrt(); $x|); 476 477$x = $mbf->new('1.234567890123456789'); 478 479is($x->copy()->bpow('0.5', 0), 480 $x->copy()->bpow('0.5', undef), 481 q|$x->copy()->bpow(...)|); 482 483is($x->copy()->bpow('0.5', 0), 484 $x->copy()->bsqrt(undef), 485 q|$x->copy()->bpow(...) vs. $x->copy()->bsqrt(...)|); 486 487is($x->copy()->bpow('2', 0), '1.524157875323883675019051998750190521', 488 q|$x->copy()->bpow('2', 0)|); 489 490############################################################################### 491# test (also under Bare) that bfac() rounds at last step 492 493is($mbi->new(12)->bfac(), '479001600', q|$mbi->new(12)->bfac()|); 494is($mbi->new(12)->bfac(2), '480000000', q|$mbi->new(12)->bfac(2)|); 495 496$x = $mbi->new(12); 497$x->accuracy(2); 498is($x->bfac(), '480000000', 499 qq|\$x = $mbi->new(12); \$x->accuracy(2); \$x->bfac()|); 500 501$x = $mbi->new(13); 502$x->accuracy(2); 503is($x->bfac(), '6200000000', 504 qq|\$x = $mbi->new(13); \$x->accuracy(2); \$x->bfac()|); 505 506$x = $mbi->new(13); 507$x->accuracy(3); 508is($x->bfac(), '6230000000', 509 qq|\$x = $mbi->new(13); \$x->accuracy(3); \$x->bfac()|); 510 511$x = $mbi->new(13); 512$x->accuracy(4); 513is($x->bfac(), '6227000000', 514 qq|\$x = $mbi->new(13); \$x->accuracy(4); \$x->bfac()|); 515 516# this does 1, 2, 3...9, 10, 11, 12...20 517$x = $mbi->new(20); 518$x->accuracy(1); 519is($x->bfac(), '2000000000000000000', 520 qq|\$x = $mbi->new(20); \$x->accuracy(1); \$x->bfac()|); 521 522############################################################################### 523# test bsqrt) rounding to given A/P/R (bug prior to v1.60) 524 525$x = $mbi->new('123456')->bsqrt(2, undef); 526is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351 527 528$x = $mbi->new('3')->bsqrt(2, undef); 529is($x->accuracy(), 2, q|$x->accuracy()|); 530 531$mbi->round_mode('even'); 532$x = $mbi->new('126025')->bsqrt(2, undef, '+inf'); 533is($x, '360', q|$x = 360|); # not 355 nor 350 534 535$x = $mbi->new('126025')->bsqrt(undef, 2); 536is($x, '400', q|$x = 400|); # not 355 537 538############################################################################### 539# test mixed arguments 540 541$x = $mbf->new(10); 542$u = $mbf->new(2.5); 543$y = $mbi->new(2); 544 545$z = $x + $y; 546is($z, 12, q|$z = $x + $y;|); 547is(ref($z), $mbf, qq|\$z is a "$mbf" object|); 548 549$z = $x / $y; 550is($z, 5, q|$z = $x / $y;|); 551is(ref($z), $mbf, qq|\$z is a "$mbf" object|); 552 553$z = $u * $y; 554is($z, 5, q|$z = $u * $y;|); 555is(ref($z), $mbf, qq|\$z is a "$mbf" object|); 556 557$y = $mbi->new(12345); 558$z = $u->copy()->bmul($y, 2, undef, 'odd'); 559is($z, 31000, q|$z = 31000|); 560 561$z = $u->copy()->bmul($y, 3, undef, 'odd'); 562is($z, 30900, q|$z = 30900|); 563 564$z = $u->copy()->bmul($y, undef, 0, 'odd'); 565is($z, 30863, q|$z = 30863|); 566 567$z = $u->copy()->bmul($y, undef, 1, 'odd'); 568is($z, 30863, q|$z = 30863|); 569 570$z = $u->copy()->bmul($y, undef, 2, 'odd'); 571is($z, 30860, q|$z = 30860|); 572 573$z = $u->copy()->bmul($y, undef, 3, 'odd'); 574is($z, 30900, q|$z = 30900|); 575 576$z = $u->copy()->bmul($y, undef, -1, 'odd'); 577is($z, 30862.5, q|$z = 30862.5|); 578 579my $warn = ''; 580$SIG{__WARN__} = sub { $warn = shift; }; 581 582# These should no longer warn, even though '3.17' is a NaN in Math::BigInt 583# (>= returns now false, bug until v1.80). 584 585$warn = ''; 586eval '$z = 3.17 <= $y'; 587is($z, '', q|$z = ""|); 588unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/, 589 q|"$z = $y >= 3.17" gives warning as expected|); 590 591$warn = ''; 592eval '$z = $y >= 3.17'; 593is($z, '', q|$z = ""|); 594unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/, 595 q|"$z = $y >= 3.17" gives warning as expected|); 596 597# XXX TODO breakage: 598# 599# $z = $y->copy()->bmul($u, 2, 0, 'odd'); 600# is($z, 31000); 601# 602# $z = $y * $u; 603# is($z, 5); 604# is(ref($z), $mbi, q|\$z is a $mbi object|); 605# 606# $z = $y + $x; 607# is($z, 12); 608# is(ref($z), $mbi, q|\$z is a $mbi object|); 609# 610# $z = $y / $x; 611# is($z, 0); 612# is(ref($z), $mbi, q|\$z is a $mbi object|); 613 614############################################################################### 615# rounding in bdiv with fallback and already set A or P 616 617{ 618 no strict 'refs'; 619 ${"$mbf\::accuracy"} = undef; 620 ${"$mbf\::precision"} = undef; 621 ${"$mbf\::div_scale"} = 40; 622} 623 624$x = $mbf->new(10); 625$x->{_a} = 4; 626is($x->bdiv(3), '3.333', q|$x->bdiv(3)|); 627is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback 628 629$x = $mbf->new(10); 630$x->{_a} = 4; 631$y = $mbf->new(3); 632is($x->bdiv($y), '3.333', q|$x->bdiv($y)|); 633is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback 634 635# rounding to P of x 636$x = $mbf->new(10); 637$x->{_p} = -2; 638is($x->bdiv(3), '3.33', q|$x->bdiv(3)|); 639 640# round in div with requested P 641$x = $mbf->new(10); 642is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|); 643 644# round in div with requested P greater than fallback 645{ 646 no strict 'refs'; 647 ${"$mbf\::div_scale"} = 5; 648 $x = $mbf->new(10); 649 is($x->bdiv(3, undef, -8), "3.33333333", 650 q|$x->bdiv(3, undef, -8) = "3.33333333"|); 651 ${"$mbf\::div_scale"} = 40; 652} 653 654$x = $mbf->new(10); 655$y = $mbf->new(3); 656$y->{_a} = 4; 657is($x->bdiv($y), '3.333', q|$x->bdiv($y) = '3.333'|); 658is($x->{_a}, 4, q|$x->{_a} = 4|); 659is($y->{_a}, 4, q|$y->{_a} = 4|); # set's it since no fallback 660is($x->{_p}, undef, q|$x->{_p} = undef|); 661is($y->{_p}, undef, q|$y->{_p} = undef|); 662 663# rounding to P of y 664$x = $mbf->new(10); 665$y = $mbf->new(3); 666$y->{_p} = -2; 667is($x->bdiv($y), '3.33', q|$x->bdiv($y) = '3.33'|); 668is($x->{_p}, -2, q|$x->{_p} = -2|); 669 is($y->{_p}, -2, q|$y->{_p} = -2|); 670is($x->{_a}, undef, q|$x->{_a} = undef|); 671is($y->{_a}, undef, q|$y->{_a} = undef|); 672 673############################################################################### 674# test whether bround(-n) fails in MBF (undocumented in MBI) 675eval { $x = $mbf->new(1); 676 $x->bround(-2); 677 }; 678like($@, qr/^bround\(\) needs positive accuracy/, 679 qq|"\$x->bround(-2)" gives warning as expected|); 680 681note("test whether rounding to higher accuracy is no-op"); 682 683$x = $mbf->new(1); 684$x->{_a} = 4; 685is($x, "1.000", q|$x = "1.000"|); 686$x->bround(6); # must be no-op 687is($x->{_a}, 4, q|$x->{_a} = 4|); 688is($x, "1.000", q|$x = "1.000"|); 689 690$x = $mbi->new(1230); 691$x->{_a} = 3; 692is($x, "1230", q|$x = "1230"|); 693$x->bround(6); # must be no-op 694is($x->{_a}, 3, q|$x->{_a} = 3|); 695is($x, "1230", q|$x = "1230"|); 696 697note("bround(n) should set _a"); 698 699$x->bround(2); # smaller works 700is($x, "1200", q|$x = "1200"|); 701is($x->{_a}, 2, q|$x->{_a} = 2|); 702 703# bround(-n) is undocumented and only used by MBF 704 705note("bround(-n) should set _a"); 706 707$x = $mbi->new(12345); 708$x->bround(-1); 709is($x, "12300", q|$x = "12300"|); 710is($x->{_a}, 4, q|$x->{_a} = 4|); 711 712note("bround(-n) should set _a"); 713 714$x = $mbi->new(12345); 715$x->bround(-2); 716is($x, "12000", q|$x = "12000"|); 717is($x->{_a}, 3, q|$x->{_a} = 3|); 718 719note("bround(-n) should set _a"); 720 721$x = $mbi->new(12345); 722$x->{_a} = 5; 723$x->bround(-3); 724is($x, "10000", q|$x = "10000"|); 725is($x->{_a}, 2, q|$x->{_a} = 2|); 726 727note("bround(-n) should set _a"); 728 729$x = $mbi->new(12345); 730$x->{_a} = 5; 731$x->bround(-4); 732is($x, "0", q|$x = "0"|); 733is($x->{_a}, 1, q|$x->{_a} = 1|); 734 735note("bround(-n) should be no-op if n too big"); 736 737$x = $mbi->new(12345); 738$x->bround(-5); 739is($x, "0", q|$x = "0"|); # scale to "big" => 0 740is($x->{_a}, 0, q|$x->{_a} = 0|); 741 742note("bround(-n) should be no-op if n too big"); 743 744$x = $mbi->new(54321); 745$x->bround(-5); 746is($x, "100000", q|$x = "100000"|); # used by MBF to round 0.0054321 at 0.0_6_00000 747is($x->{_a}, 0, q|$x->{_a} = 0|); 748 749note("bround(-n) should be no-op if n too big"); 750 751$x = $mbi->new(54321); 752$x->{_a} = 5; 753$x->bround(-6); 754is($x, "100000", q|$x = "100000"|); # no-op 755is($x->{_a}, 0, q|$x->{_a} = 0|); 756 757note("bround(n) should set _a"); 758 759$x = $mbi->new(12345); 760$x->{_a} = 5; 761$x->bround(5); # must be no-op 762is($x, "12345", q|$x = "12345"|); 763is($x->{_a}, 5, q|$x->{_a} = 5|); 764 765note("bround(n) should set _a"); 766 767$x = $mbi->new(12345); 768$x->{_a} = 5; 769$x->bround(6); # must be no-op 770is($x, "12345", q|$x = "12345"|); 771 772$x = $mbf->new("0.0061"); 773$x->bfround(-2); 774is($x, "0.01", q|$x = "0.01"|); 775$x = $mbf->new("0.004"); 776$x->bfround(-2); 777is($x, "0.00", q|$x = "0.00"|); 778$x = $mbf->new("0.005"); 779$x->bfround(-2); 780is($x, "0.00", q|$x = "0.00"|); 781 782$x = $mbf->new("12345"); 783$x->bfround(2); 784is($x, "12340", q|$x = "12340"|); 785$x = $mbf->new("12340"); 786$x->bfround(2); 787is($x, "12340", q|$x = "12340"|); 788 789note("MBI::bfround should clear A for negative P"); 790 791$x = $mbi->new("1234"); 792$x->accuracy(3); 793$x->bfround(-2); 794is($x->{_a}, undef, q|$x->{_a} = undef|); 795 796note("test that bfround() and bround() work with large numbers"); 797 798$x = $mbf->new(1)->bdiv(5678, undef, -63); 799is($x, "0.000176118351532229658330398027474462839027826699542092286016203", 800 q|$x = "0.000176118351532229658330398027474462839027826699542092286016203"|); 801 802$x = $mbf->new(1)->bdiv(5678, undef, -90); 803is($x, "0.00017611835153222965833039802747446283902782" 804 . "6699542092286016202888340965128566396618527651", 805 q|$x = "0.00017611835153222965833039802747446283902782| 806 . q|6699542092286016202888340965128566396618527651"|); 807 808$x = $mbf->new(1)->bdiv(5678, 80); 809is($x, "0.00017611835153222965833039802747446283902782" 810 . "669954209228601620288834096512856639662", 811 q|$x = "0.00017611835153222965833039802747446283902782| 812 . q|669954209228601620288834096512856639662"|); 813 814############################################################################### 815 816note("rounding with already set precision/accuracy"); 817 818$x = $mbf->new(1); 819$x->{_p} = -5; 820is($x, "1.00000", q|$x = "1.00000"|); 821 822note("further rounding down"); 823 824is($x->bfround(-2), "1.00", q|$x->bfround(-2) = "1.00"|); 825is($x->{_p}, -2, q|$x->{_p} = -2|); 826 827$x = $mbf->new(12345); 828$x->{_a} = 5; 829is($x->bround(2), "12000", q|$x->bround(2) = "12000"|); 830is($x->{_a}, 2, q|$x->{_a} = 2|); 831 832$x = $mbf->new("1.2345"); 833$x->{_a} = 5; 834is($x->bround(2), "1.2", q|$x->bround(2) = "1.2"|); 835is($x->{_a}, 2, q|$x->{_a} = 2|); 836 837note("mantissa/exponent format and A/P"); 838 839$x = $mbf->new("12345.678"); 840$x->accuracy(4); 841is($x, "12350", q|$x = "12350"|); 842is($x->{_a}, 4, q|$x->{_a} = 4|); 843is($x->{_p}, undef, q|$x->{_p} = undef|); 844 845#is($x->{_m}->{_a}, undef, q|$x->{_m}->{_a} = undef|); 846#is($x->{_e}->{_a}, undef, q|$x->{_e}->{_a} = undef|); 847#is($x->{_m}->{_p}, undef, q|$x->{_m}->{_p} = undef|); 848#is($x->{_e}->{_p}, undef, q|$x->{_e}->{_p} = undef|); 849 850note("check for no A/P in case of fallback result"); 851 852$x = $mbf->new(100) / 3; 853is($x->{_a}, undef, q|$x->{_a} = undef|); 854is($x->{_p}, undef, q|$x->{_p} = undef|); 855 856note("result & remainder"); 857 858$x = $mbf->new(100) / 3; 859($x, $y) = $x->bdiv(3); 860is($x->{_a}, undef, q|$x->{_a} = undef|); 861is($x->{_p}, undef, q|$x->{_p} = undef|); 862is($y->{_a}, undef, q|$y->{_a} = undef|); 863is($y->{_p}, undef, q|$y->{_p} = undef|); 864 865############################################################################### 866# math with two numbers with different A and P 867 868$x = $mbf->new(12345); 869$x->accuracy(4); # "12340" 870$y = $mbf->new(12345); 871$y->accuracy(2); # "12000" 872is($x+$y, 24000, q|$x+$y = 24000|); # 12340+12000=> 24340 => 24000 873 874$x = $mbf->new(54321); 875$x->accuracy(4); # "12340" 876$y = $mbf->new(12345); 877$y->accuracy(3); # "12000" 878is($x-$y, 42000, q|$x-$y = 42000|); # 54320+12300=> 42020 => 42000 879 880$x = $mbf->new("1.2345"); 881$x->precision(-2); # "1.23" 882$y = $mbf->new("1.2345"); 883$y->precision(-4); # "1.2345" 884is($x+$y, "2.46", q|$x+$y = "2.46"|); # 1.2345+1.2300=> 2.4645 => 2.46 885 886############################################################################### 887# round should find and use proper class 888 889#$x = Foo->new(); 890#is($x->round($Foo::accuracy), "a" x $Foo::accuracy); 891#is($x->round(undef, $Foo::precision), "p" x $Foo::precision); 892#is($x->bfround($Foo::precision), "p" x $Foo::precision); 893#is($x->bround($Foo::accuracy), "a" x $Foo::accuracy); 894 895############################################################################### 896# find out whether _find_round_parameters is doing what's it's supposed to do 897 898{ 899 no strict 'refs'; 900 ${"$mbi\::accuracy"} = undef; 901 ${"$mbi\::precision"} = undef; 902 ${"$mbi\::div_scale"} = 40; 903 ${"$mbi\::round_mode"} = 'odd'; 904} 905 906$x = $mbi->new(123); 907my @params = $x->_find_round_parameters(); 908is(scalar(@params), 1, q|scalar(@params) = 1|); # nothing to round 909 910@params = $x->_find_round_parameters(1); 911is(scalar(@params), 4, q|scalar(@params) = 4|); # a=1 912is($params[0], $x, q|$params[0] = $x|); # self 913is($params[1], 1, q|$params[1] = 1|); # a 914is($params[2], undef, q|$params[2] = undef|); # p 915is($params[3], "odd", q|$params[3] = "odd"|); # round_mode 916 917@params = $x->_find_round_parameters(undef, 2); 918is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2 919is($params[0], $x, q|$params[0] = $x|); # self 920is($params[1], undef, q|$params[1] = undef|); # a 921is($params[2], 2, q|$params[2] = 2|); # p 922is($params[3], "odd", q|$params[3] = "odd"|); # round_mode 923 924eval { @params = $x->_find_round_parameters(undef, 2, "foo"); }; 925like($@, qr/^Unknown round mode 'foo'/, 926 q|round mode "foo" gives a warning as expected|); 927 928@params = $x->_find_round_parameters(undef, 2, "+inf"); 929is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2 930is($params[0], $x, q|$params[0] = $x|); # self 931is($params[1], undef, q|$params[1] = undef|); # a 932is($params[2], 2, q|$params[2] = 2|); # p 933is($params[3], "+inf", q|$params[3] = "+inf"|); # round_mode 934 935@params = $x->_find_round_parameters(2, -2, "+inf"); 936is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined 937is($params[0], $x, q|$params[0] = $x|); # self 938 939{ 940 no strict 'refs'; 941 ${"$mbi\::accuracy"} = 1; 942 @params = $x->_find_round_parameters(undef, -2); 943 is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined 944 is($params[0], $x, q|$params[0] = $x|); # self 945 is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN 946 947 ${"$mbi\::accuracy"} = undef; 948 ${"$mbi\::precision"} = 1; 949 @params = $x->_find_round_parameters(1, undef); 950 is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined 951 is($params[0], $x, q|$params[0] = $x|); # self 952 is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN 953 954 ${"$mbi\::precision"} = undef; # reset 955} 956 957############################################################################### 958# test whether bone/bzero take additional A & P, or reset it etc 959 960foreach my $class ($mbi, $mbf) { 961 $x = $class->new(2)->bzero(); 962 is($x->{_a}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{_a}|); 963 is($x->{_p}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{_p}|); 964 965 $x = $class->new(2)->bone(); 966 is($x->{_a}, undef, qq|\$x = $class->new(2)->bone(); \$x->{_a}|); 967 is($x->{_p}, undef, qq|\$x = $class->new(2)->bone(); \$x->{_p}|); 968 969 $x = $class->new(2)->binf(); 970 is($x->{_a}, undef, qq|\$x = $class->new(2)->binf(); \$x->{_a}|); 971 is($x->{_p}, undef, qq|\$x = $class->new(2)->binf(); \$x->{_p}|); 972 973 $x = $class->new(2)->bnan(); 974 is($x->{_a}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{_a}|); 975 is($x->{_p}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{_p}|); 976 977 note "Verify that bnan() does not delete/undefine accuracy and precision."; 978 979 $x = $class->new(2); 980 $x->{_a} = 1; 981 $x->bnan(); 982 is($x->{_a}, 1, qq|\$x = $class->new(2); \$x->{_a} = 1; \$x->bnan(); \$x->{_a}|); 983 984 $x = $class->new(2); 985 $x->{_p} = 1; 986 $x->bnan(); 987 is($x->{_p}, 1, qq|\$x = $class->new(2); \$x->{_p} = 1; \$x->bnan(); \$x->{_p}|); 988 989 note "Verify that binf() does not delete/undefine accuracy and precision."; 990 991 $x = $class->new(2); 992 $x->{_a} = 1; 993 $x->binf(); 994 is($x->{_a}, 1, qq|\$x = $class->new(2); \$x->{_a} = 1; \$x->binf(); \$x->{_a}|); 995 996 $x = $class->new(2); 997 $x->{_p} = 1; 998 $x->binf(); 999 is($x->{_p}, 1, qq|\$x = $class->new(2); \$x->{_p} = 1; \$x->binf(); \$x->{_p}|); 1000 1001 note "Verify that accuracy can be set as argument to new()."; 1002 1003 $x = $class->new(2, 1); 1004 is($x->{_a}, 1, qq|\$x = $class->new(2, 1); \$x->{_a}|); 1005 is($x->{_p}, undef, qq|\$x = $class->new(2, 1); \$x->{_p}|); 1006 1007 note "Verify that precision can be set as argument to new()."; 1008 1009 $x = $class->new(2, undef, 1); 1010 is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1); \$x->{_a}|); 1011 is($x->{_p}, 1, qq|\$x = $class->new(2, undef, 1); \$x->{_p}|); 1012 1013 note "Verify that accuracy set with new() is preserved after calling bzero()."; 1014 1015 $x = $class->new(2, 1)->bzero(); 1016 is($x->{_a}, 1, qq|\$x = $class->new(2, 1)->bzero(); \$x->{_a}|); 1017 is($x->{_p}, undef, qq|\$x = $class->new(2, 1)->bzero(); \$x->{_p}|); 1018 1019 note "Verify that precision set with new() is preserved after calling bzero()."; 1020 1021 $x = $class->new(2, undef, 1)->bzero(); 1022 is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{_a}|); 1023 is($x->{_p}, 1, qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{_p}|); 1024 1025 note "Verify that accuracy set with new() is preserved after calling bone()."; 1026 1027 $x = $class->new(2, 1)->bone(); 1028 is($x->{_a}, 1, qq|\$x = $class->new(2, 1)->bone(); \$x->{_a}|); 1029 is($x->{_p}, undef, qq|\$x = $class->new(2, 1)->bone(); \$x->{_p}|); 1030 1031 note "Verify that precision set with new() is preserved after calling bone()."; 1032 1033 $x = $class->new(2, undef, 1)->bone(); 1034 is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{_a}|); 1035 is($x->{_p}, 1, qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{_p}|); 1036 1037 note "Verify that accuracy can be set with instance method bone('+')."; 1038 1039 $x = $class->new(2); 1040 $x->bone('+', 2, undef); 1041 is($x->{_a}, 2, qq|\$x = $class->new(2); \$x->{_a}|); 1042 is($x->{_p}, undef, qq|\$x = $class->new(2); \$x->{_p}|); 1043 1044 note "Verify that precision can be set with instance method bone('+')."; 1045 1046 $x = $class->new(2); 1047 $x->bone('+', undef, 2); 1048 is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{_a}|); 1049 is($x->{_p}, 2, qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{_p}|); 1050 1051 note "Verify that accuracy can be set with instance method bone('-')."; 1052 1053 $x = $class->new(2); 1054 $x->bone('-', 2, undef); 1055 is($x->{_a}, 2, qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{_a}|); 1056 is($x->{_p}, undef, qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{_p}|); 1057 1058 note "Verify that precision can be set with instance method bone('-')."; 1059 1060 $x = $class->new(2); 1061 $x->bone('-', undef, 2); 1062 is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{_a}|); 1063 is($x->{_p}, 2, qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{_p}|); 1064 1065 note "Verify that accuracy can be set with instance method bzero()."; 1066 1067 $x = $class->new(2); 1068 $x->bzero(2, undef); 1069 is($x->{_a}, 2, qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{_a}|); 1070 is($x->{_p}, undef, qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{_p}|); 1071 1072 note "Verify that precision can be set with instance method bzero()."; 1073 1074 $x = $class->new(2); 1075 $x->bzero(undef, 2); 1076 is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{_a}|); 1077 is($x->{_p}, 2, qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{_p}|); 1078} 1079 1080############################################################################### 1081# test whether bone/bzero honour class variables 1082 1083for my $class ($mbi, $mbf) { 1084 1085 note "Verify that class accuracy is copied into new objects."; 1086 1087 $class->accuracy(3); # set 1088 1089 $x = $class->bzero(); 1090 is($x->accuracy(), 3, 1091 qq|$class->accuracy(3); \$x = $class->bzero(); \$x->accuracy()|); 1092 1093 $x = $class->bone(); 1094 is($x->accuracy(), 3, 1095 qq|$class->accuracy(3); \$x = $class->bone(); \$x->accuracy()|); 1096 1097 $x = $class->new(2); 1098 is($x->accuracy(), 3, 1099 qq|$class->accuracy(3); \$x = $class->new(2); \$x->accuracy()|); 1100 1101 $class->accuracy(undef); # reset 1102 1103 note "Verify that class precision is copied into new objects."; 1104 1105 $class->precision(-4); # set 1106 1107 $x = $class->bzero(); 1108 is($x->precision(), -4, 1109 qq|$class->precision(-4); \$x = $class->bzero(); \$x->precision()|); 1110 1111 $x = $class->bone(); 1112 is($x->precision(), -4, 1113 qq|$class->precision(-4); \$x = $class->bone(); \$x->precision()|); 1114 1115 $x = $class->new(2); 1116 is($x->precision(), -4, 1117 qq|$class->precision(-4); \$x = $class->new(2); \$x->precision()|); 1118 1119 $class->precision(undef); # reset 1120 1121 note "Verify that setting accuracy as method argument overrides class variable"; 1122 1123 $class->accuracy(2); # set 1124 1125 $x = $class->bzero(5); 1126 is($x->accuracy(), 5, 1127 qq|$class->accuracy(2); \$x = $class->bzero(5); \$x->accuracy()|); 1128 1129 SKIP: { 1130 skip 1, "this won't work until we have a better OO implementation"; 1131 1132 $x = $class->bzero(undef); 1133 is($x->accuracy(), undef, 1134 qq|$class->accuracy(2); \$x = $class->bzero(undef); \$x->accuracy()|); 1135 } 1136 1137 $x = $class->bone("+", 5); 1138 is($x->accuracy(), 5, 1139 qq|$class->accuracy(2); \$x = $class->bone("+", 5); \$x->accuracy()|); 1140 1141 SKIP: { 1142 skip 1, "this won't work until we have a better OO implementation"; 1143 1144 $x = $class->bone("+", undef); 1145 is($x->accuracy(), undef, 1146 qq|$class->accuracy(2); \$x = $class->bone("+", undef); \$x->accuracy()|); 1147 } 1148 1149 $x = $class->new(2, 5); 1150 is($x->accuracy(), 5, 1151 qq|$class->accuracy(2); \$x = $class->new(2, 5); \$x->accuracy()|); 1152 1153 SKIP: { 1154 skip 1, "this won't work until we have a better OO implementation"; 1155 1156 $x = $class->new(2, undef); 1157 is($x->accuracy(), undef, 1158 qq|$class->accuracy(2); \$x = $class->new(2, undef); \$x->accuracy()|); 1159 } 1160 1161 $class->accuracy(undef); # reset 1162 1163 note "Verify that setting precision as method argument overrides class variable"; 1164 1165 $class->precision(-2); # set 1166 1167 $x = $class->bzero(undef, -6); 1168 is($x->precision(), -6, 1169 qq|$class->precision(-2); \$x = $class->bzero(undef, -6); \$x->precision()|); 1170 1171 SKIP: { 1172 skip 1, "this won't work until we have a better OO implementation"; 1173 1174 $x = $class->bzero(undef, undef); 1175 is($x->precision(), undef, 1176 qq|$class->precision(-2); \$x = $class->bzero(undef, undef); \$x->precision()|); 1177 } 1178 1179 $x = $class->bone("+", undef, -6); 1180 is($x->precision(), -6, 1181 qq|$class->precision(-2); \$x = $class->bone("+", undef, -6); \$x->precision()|); 1182 1183 SKIP: { 1184 skip 1, "this won't work until we have a better OO implementation"; 1185 1186 $x = $class->bone("+", undef, undef); 1187 is($x->precision(), undef, 1188 qq|$class->precision(-2); \$x = $class->bone("+", undef, undef); \$x->precision()|); 1189 } 1190 1191 $x = $class->new(2, undef, -6); 1192 is($x->precision(), -6, 1193 qq|$class->precision(-2); \$x = $class->new(2, undef, -6); \$x->precision()|); 1194 1195 SKIP: { 1196 skip 1, "this won't work until we have a better OO implementation"; 1197 1198 $x = $class->new(2, undef, undef); 1199 is($x->precision(), undef, 1200 qq|$class->precision(-2); \$x = $class->new(2, undef, undef); \$x->precision()|); 1201 } 1202 1203 $class->precision(undef); # reset 1204} 1205 1206############################################################################### 1207# check whether mixing A and P creates a NaN 1208 1209# new with set accuracy/precision and with parameters 1210{ 1211 no strict 'refs'; 1212 foreach my $class ($mbi, $mbf) { 1213 is($class->new(123, 4, -3), 'NaN', # with parameters 1214 "mixing A and P creates a NaN"); 1215 ${"$class\::accuracy"} = 42; 1216 ${"$class\::precision"} = 2; 1217 is($class->new(123), "NaN", # with globals 1218 q|$class->new(123) = "NaN"|); 1219 ${"$class\::accuracy"} = undef; 1220 ${"$class\::precision"} = undef; 1221 } 1222} 1223 1224# binary ops 1225foreach my $class ($mbi, $mbf) { 1226 #foreach (qw/add sub mul div pow mod/) { 1227 foreach my $method (qw/add sub mul pow mod/) { 1228 my $try = "my \$x = $class->new(1234); \$x->accuracy(5);"; 1229 $try .= " my \$y = $class->new(12); \$y->precision(-3);"; 1230 $try .= " \$x->b$method(\$y);"; 1231 $rc = eval $try; 1232 is($rc, "NaN", $try); 1233 } 1234} 1235 1236# unary ops 1237foreach my $method (qw/new bsqrt/) { 1238 my $try = "my \$x = $mbi->$method(1234, 5, -3);"; 1239 $rc = eval $try; 1240 is($rc, "NaN", $try); 1241} 1242 1243# see if $x->bsub(0) and $x->badd(0) really round 1244foreach my $class ($mbi, $mbf) { 1245 $x = $class->new(123); 1246 $class->accuracy(2); 1247 $x->bsub(0); 1248 is($x, 120, q|$x = 120|); 1249 1250 $class->accuracy(undef); # reset 1251 1252 $x = $class->new(123); 1253 $class->accuracy(2); 1254 $x->badd(0); 1255 is($x, 120, q|$x = 120|); 1256 1257 $class->accuracy(undef); # reset 1258} 1259 1260############################################################################### 1261# test whether shortcuts returning zero/one preserve A and P 1262 1263my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args); 1264 1265my $LIB = Math::BigInt->config('lib'); 1266 1267while (<DATA>) { 1268 s/#.*$//; # remove comments 1269 s/\s+$//; # remove trailing whitespace 1270 next unless length; # skip empty lines 1271 1272 if (s/^&//) { 1273 $f = $_; # function 1274 next; 1275 } 1276 1277 @args = split(/:/, $_); 1278 my $want = pop(@args); 1279 1280 ($x, $xa, $xp) = split (/,/, $args[0]); 1281 $xa = $xa || ''; 1282 $xp = $xp || ''; 1283 $try = qq|\$x = $mbi->new("$x");|; 1284 $try .= qq| \$x->accuracy($xa);| if $xa ne ''; 1285 $try .= qq| \$x->precision($xp);| if $xp ne ''; 1286 1287 ($y, $ya, $yp) = split (/,/, $args[1]); 1288 $ya = $ya || ''; 1289 $yp = $yp || ''; 1290 $try .= qq| \$y = $mbi->new("$y");|; 1291 $try .= qq| \$y->accuracy($ya);| if $ya ne ''; 1292 $try .= qq| \$y->precision($yp);| if $yp ne ''; 1293 1294 $try .= ' $x->' . $f . '($y);'; 1295 1296 # print "trying $try\n"; 1297 $rc = eval $try; 1298 print "# Error: $@\n" if $@; 1299 1300 # convert hex/binary targets to decimal 1301 if ($want =~ /^(0x0x|0b0b)/) { 1302 $want =~ s/^0[xb]//; 1303 $want = $mbi->new($want)->bstr(); 1304 } 1305 is($rc, $want, $try); 1306 # check internal state of number objects 1307 is_valid($rc, $f) if ref $rc; 1308 1309 # now check whether A and P are set correctly 1310 # only one of $a or $p will be set (no crossing here) 1311 $a = $xa || $ya; 1312 $p = $xp || $yp; 1313 1314 # print "Check a=$a p=$p\n"; 1315 # print "# Tried: '$try'\n"; 1316 if ($a ne '') { 1317 unless (is($x->{_a}, $a, qq|\$x->{_a} == $a|) && 1318 is($x->{_p}, undef, qq|\$x->{_p} is undef|)) 1319 { 1320 print "# Check: A = $a and P = undef\n"; 1321 print "# Tried: $try\n"; 1322 } 1323 } 1324 if ($p ne '') { 1325 unless (is($x->{_p}, $p, qq|\$x->{_p} == $p|) && 1326 is($x->{_a}, undef, qq|\$x->{_a} is undef|)) 1327 { 1328 print "# Check: A = undef and P = $p\n"; 1329 print "# Tried: $try\n"; 1330 } 1331 } 1332} 1333 1334# all done 13351; 1336 1337############################################################################### 1338# sub to check validity of a Math::BigInt object internally, to ensure that no 1339# op leaves a number object in an invalid state (f.i. "-0") 1340 1341sub is_valid { 1342 my ($x, $f) = @_; 1343 1344 my $e = 0; # error? 1345 1346 # ok as reference? 1347 $e = 'Not a reference' if !ref($x); 1348 1349 # has ok sign? 1350 $e = qq|Illegal sign $x->{sign}| 1351 . q| (expected: "+", "-", "-inf", "+inf" or "NaN")| 1352 if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; 1353 1354 $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; 1355 $e = $LIB->_check($x->{value}) if $e eq '0'; 1356 1357 # test done, see if error did crop up 1358 if ($e eq '0') { 1359 pass('is a valid object'); 1360 return; 1361 } 1362 1363 fail($e . qq| after op "$f"|); 1364} 1365 1366# format is: 1367# x,A,P:x,A,P:result 1368# 123,,3 means 123 with precision 3 (A is undef) 1369# the A or P of the result is calculated automatically 1370__DATA__ 1371&badd 1372123,,:123,,:246 1373123,3,:0,,:123 1374123,,-3:0,,:123 1375123,,:0,3,:123 1376123,,:0,,-3:123 1377&bmul 1378123,,:1,,:123 1379123,3,:0,,:0 1380123,,-3:0,,:0 1381123,,:0,3,:0 1382123,,:0,,-3:0 1383123,3,:1,,:123 1384123,,-3:1,,:123 1385123,,:1,3,:123 1386123,,:1,,-3:123 13871,3,:123,,:123 13881,,-3:123,,:123 13891,,:123,3,:123 13901,,:123,,-3:123 1391&bdiv 1392123,,:1,,:123 1393123,4,:1,,:123 1394123,,:1,4,:123 1395123,,:1,,-4:123 1396123,,-4:1,,:123 13971,4,:123,,:0 13981,,:123,4,:0 13991,,:123,,-4:0 14001,,-4:123,,:0 1401&band 14021,,:3,,:1 14031234,1,:0,,:0 14041234,,:0,1,:0 14051234,,-1:0,,:0 14061234,,:0,,-1:0 14070xFF,,:0x10,,:0x0x10 14080xFF,2,:0xFF,,:250 14090xFF,,:0xFF,2,:250 14100xFF,,1:0xFF,,:250 14110xFF,,:0xFF,,1:250 1412&bxor 14131,,:3,,:2 14141234,1,:0,,:1000 14151234,,:0,1,:1000 14161234,,3:0,,:1000 14171234,,:0,,3:1000 14180xFF,,:0x10,,:239 1419# 250 ^ 255 => 5 14200xFF,2,:0xFF,,:5 14210xFF,,:0xFF,2,:5 14220xFF,,1:0xFF,,:5 14230xFF,,:0xFF,,1:5 1424# 250 ^ 4095 = 3845 => 3800 14250xFF,2,:0xFFF,,:3800 1426# 255 ^ 4100 = 4347 => 4300 14270xFF,,:0xFFF,2,:4300 14280xFF,,2:0xFFF,,:3800 1429# 255 ^ 4100 = 10fb => 4347 => 4300 14300xFF,,:0xFFF,,2:4300 1431&bior 14321,,:3,,:3 14331234,1,:0,,:1000 14341234,,:0,1,:1000 14351234,,3:0,,:1000 14361234,,:0,,3:1000 14370xFF,,:0x10,,:0x0xFF 1438# FF | FA = FF => 250 1439250,2,:0xFF,,:250 14400xFF,,:250,2,:250 14410xFF,,1:0xFF,,:250 14420xFF,,:0xFF,,1:250 1443&bpow 14442,,:3,,:8 14452,,:0,,:1 14462,2,:0,,:1 14472,,:0,2,:1 1448