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