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