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