projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Include variable names in "Use of uninitialized value" warnings
[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
2ab5f49d 94 # reset for further tests
56d9de68 95 ${"$mbi\::accuracy"} = undef;
96 ${"$mbi\::precision"} = undef;
2ab5f49d 97 ${"$mbf\::div_scale"} = 40;
56d9de68 98}
61f5c3f5 99
61f5c3f5 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
56d9de68 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}
61f5c3f5 117
118###############################################################################
119# see if creating a number under set A or P will round it
120
56d9de68 121{
122 no strict 'refs';
123 ${"$mbi\::accuracy"} = 4;
124 ${"$mbi\::precision"} = undef;
61f5c3f5 125
56d9de68 126 ok ($mbi->new(123456),123500); # with A
127 ${"$mbi\::accuracy"} = undef;
128 ${"$mbi\::precision"} = 3;
129 ok ($mbi->new(123456),123000); # with P
61f5c3f5 130
56d9de68 131 ${"$mbf\::accuracy"} = 4;
132 ${"$mbf\::precision"} = undef;
133 ${"$mbi\::precision"} = undef;
61f5c3f5 134
56d9de68 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!
61f5c3f5 139
56d9de68 140 ${"$mbf\::precision"} = undef; # reset
141}
61f5c3f5 142
143###############################################################################
144# see if MBI leaves MBF's private parts alone
145
56d9de68 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}
61f5c3f5 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');
b3abae2a 171ok ($x->copy()->round(undef,2),120);
61f5c3f5 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
56d9de68 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
61f5c3f5 217# does accuracy()/precision work on zeros?
56d9de68 218foreach my $c ($mbi,$mbf)
61f5c3f5 219 {
56d9de68 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);
61f5c3f5 224
56d9de68 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);
61f5c3f5 229
230 # see if trying to increasing A in bzero() doesn't do something
56d9de68 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
9b924220 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);
56d9de68 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);
61f5c3f5 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
990fb837 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
61f5c3f5 335###############################################################################
2ab5f49d 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###############################################################################
f9a08e12 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###############################################################################
61f5c3f5 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);
b3abae2a 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);
61f5c3f5 395$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
396
56d9de68 397my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
398# these should warn, since '3.17' is a NaN in BigInt and thus >= returns undef
399$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1);
400print "# Got: '$warn'\n" unless
29489e7c 401ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);
56d9de68 402$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1);
403print "# Got: '$warn'\n" unless
29489e7c 404ok ($warn =~ /^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);
56d9de68 405
406# XXX TODO breakage:
61f5c3f5 407# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
408# $z = $y * $u; ok ($z,5); ok (ref($z),$mbi);
409# $z = $y + $x; ok ($z,12); ok (ref($z),$mbi);
410# $z = $y / $x; ok ($z,0); ok (ref($z),$mbi);
411
412###############################################################################
413# rounding in bdiv with fallback and already set A or P
414
56d9de68 415{
416 no strict 'refs';
417 ${"$mbf\::accuracy"} = undef;
418 ${"$mbf\::precision"} = undef;
419 ${"$mbf\::div_scale"} = 40;
420}
61f5c3f5 421
56d9de68 422 $x = $mbf->new(10); $x->{_a} = 4;
423 ok ($x->bdiv(3),'3.333');
424 ok ($x->{_a},4); # set's it since no fallback
61f5c3f5 425
426$x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
427ok ($x->bdiv($y),'3.333');
428ok ($x->{_a},4); # set's it since no fallback
429
430# rounding to P of x
431$x = $mbf->new(10); $x->{_p} = -2;
432ok ($x->bdiv(3),'3.33');
433
434# round in div with requested P
435$x = $mbf->new(10);
436ok ($x->bdiv(3,undef,-2),'3.33');
437
438# round in div with requested P greater than fallback
56d9de68 439{
440 no strict 'refs';
441 ${"$mbf\::div_scale"} = 5;
442 $x = $mbf->new(10);
443 ok ($x->bdiv(3,undef,-8),'3.33333333');
444 ${"$mbf\::div_scale"} = 40;
445}
61f5c3f5 446
447$x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4;
448ok ($x->bdiv($y),'3.333');
449ok ($x->{_a},4); ok ($y->{_a},4); # set's it since no fallback
450ok_undef ($x->{_p}); ok_undef ($y->{_p});
451
452# rounding to P of y
453$x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2;
454ok ($x->bdiv($y),'3.33');
455ok ($x->{_p},-2);
456 ok ($y->{_p},-2);
457ok_undef ($x->{_a}); ok_undef ($y->{_a});
458
459###############################################################################
460# test whether bround(-n) fails in MBF (undocumented in MBI)
461eval { $x = $mbf->new(1); $x->bround(-2); };
462ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
463
464# test whether rounding to higher accuracy is no-op
465$x = $mbf->new(1); $x->{_a} = 4;
466ok ($x,'1.000');
467$x->bround(6); # must be no-op
468ok ($x->{_a},4);
469ok ($x,'1.000');
470
471$x = $mbi->new(1230); $x->{_a} = 3;
472ok ($x,'1230');
473$x->bround(6); # must be no-op
474ok ($x->{_a},3);
475ok ($x,'1230');
476
477# bround(n) should set _a
478$x->bround(2); # smaller works
479ok ($x,'1200');
480ok ($x->{_a},2);
481
482# bround(-n) is undocumented and only used by MBF
483# bround(-n) should set _a
484$x = $mbi->new(12345);
485$x->bround(-1);
486ok ($x,'12300');
487ok ($x->{_a},4);
488
489# bround(-n) should set _a
490$x = $mbi->new(12345);
491$x->bround(-2);
492ok ($x,'12000');
493ok ($x->{_a},3);
494
495# bround(-n) should set _a
496$x = $mbi->new(12345); $x->{_a} = 5;
497$x->bround(-3);
498ok ($x,'10000');
499ok ($x->{_a},2);
500
501# bround(-n) should set _a
502$x = $mbi->new(12345); $x->{_a} = 5;
503$x->bround(-4);
504ok ($x,'0');
505ok ($x->{_a},1);
506
507# bround(-n) should be noop if n too big
508$x = $mbi->new(12345);
509$x->bround(-5);
510ok ($x,'0'); # scale to "big" => 0
511ok ($x->{_a},0);
512
513# bround(-n) should be noop if n too big
514$x = $mbi->new(54321);
515$x->bround(-5);
516ok ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000
517ok ($x->{_a},0);
518
519# bround(-n) should be noop if n too big
520$x = $mbi->new(54321); $x->{_a} = 5;
521$x->bround(-6);
522ok ($x,'100000'); # no-op
523ok ($x->{_a},0);
524
525# bround(n) should set _a
526$x = $mbi->new(12345); $x->{_a} = 5;
527$x->bround(5); # must be no-op
528ok ($x,'12345');
529ok ($x->{_a},5);
530
531# bround(n) should set _a
532$x = $mbi->new(12345); $x->{_a} = 5;
533$x->bround(6); # must be no-op
534ok ($x,'12345');
535
b3abae2a 536$x = $mbf->new('0.0061'); $x->bfround(-2); ok ($x,'0.01');
537$x = $mbf->new('0.004'); $x->bfround(-2); ok ($x,'0.00');
538$x = $mbf->new('0.005'); $x->bfround(-2); ok ($x,'0.00');
539
540$x = $mbf->new('12345'); $x->bfround(2); ok ($x,'12340');
541$x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340');
61f5c3f5 542
543# MBI::bfround should clear A for negative P
544$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
545ok_undef ($x->{_a});
546
9b924220 547# test that bfround() and bround() work with large numbers
548
549$x = $mbf->new(1)->bdiv(5678,undef,-63);
550ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203');
551
552$x = $mbf->new(1)->bdiv(5678,undef,-90);
553ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651');
554
555$x = $mbf->new(1)->bdiv(5678,80);
556ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662');
557
61f5c3f5 558###############################################################################
559# rounding with already set precision/accuracy
560
561$x = $mbf->new(1); $x->{_p} = -5;
562ok ($x,'1.00000');
563
564# further rounding donw
565ok ($x->bfround(-2),'1.00');
566ok ($x->{_p},-2);
567
568$x = $mbf->new(12345); $x->{_a} = 5;
569ok ($x->bround(2),'12000');
570ok ($x->{_a},2);
571
572$x = $mbf->new('1.2345'); $x->{_a} = 5;
573ok ($x->bround(2),'1.2');
574ok ($x->{_a},2);
575
576# mantissa/exponent format and A/P
577$x = $mbf->new('12345.678'); $x->accuracy(4);
578ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
9b924220 579
580#ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
581#ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
61f5c3f5 582
583# check for no A/P in case of fallback
584# result
585$x = $mbf->new(100) / 3;
586ok_undef ($x->{_a}); ok_undef ($x->{_p});
587
588# result & reminder
589$x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3);
590ok_undef ($x->{_a}); ok_undef ($x->{_p});
591ok_undef ($y->{_a}); ok_undef ($y->{_p});
592
593###############################################################################
594# math with two numbers with differen A and P
595
596$x = $mbf->new(12345); $x->accuracy(4); # '12340'
597$y = $mbf->new(12345); $y->accuracy(2); # '12000'
598ok ($x+$y,24000); # 12340+12000=> 24340 => 24000
599
600$x = $mbf->new(54321); $x->accuracy(4); # '12340'
601$y = $mbf->new(12345); $y->accuracy(3); # '12000'
602ok ($x-$y,42000); # 54320+12300=> 42020 => 42000
603
604$x = $mbf->new('1.2345'); $x->precision(-2); # '1.23'
605$y = $mbf->new('1.2345'); $y->precision(-4); # '1.2345'
606ok ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46
607
608###############################################################################
609# round should find and use proper class
610
611#$x = Foo->new();
612#ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
613#ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
614#ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
615#ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
616
617###############################################################################
618# find out whether _find_round_parameters is doing what's it's supposed to do
56d9de68 619
620{
621 no strict 'refs';
622 ${"$mbi\::accuracy"} = undef;
623 ${"$mbi\::precision"} = undef;
624 ${"$mbi\::div_scale"} = 40;
625 ${"$mbi\::round_mode"} = 'odd';
626}
627
61f5c3f5 628$x = $mbi->new(123);
629my @params = $x->_find_round_parameters();
630ok (scalar @params,1); # nothing to round
631
632@params = $x->_find_round_parameters(1);
633ok (scalar @params,4); # a=1
634ok ($params[0],$x); # self
635ok ($params[1],1); # a
636ok_undef ($params[2]); # p
637ok ($params[3],'odd'); # round_mode
638
639@params = $x->_find_round_parameters(undef,2);
640ok (scalar @params,4); # p=2
641ok ($params[0],$x); # self
642ok_undef ($params[1]); # a
643ok ($params[2],2); # p
644ok ($params[3],'odd'); # round_mode
645
646eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
647ok ($@ =~ /^Unknown round mode 'foo'/,1);
648
649@params = $x->_find_round_parameters(undef,2,'+inf');
650ok (scalar @params,4); # p=2
651ok ($params[0],$x); # self
652ok_undef ($params[1]); # a
653ok ($params[2],2); # p
654ok ($params[3],'+inf'); # round_mode
655
656@params = $x->_find_round_parameters(2,-2,'+inf');
657ok (scalar @params,1); # error, A and P defined
658ok ($params[0],$x); # self
659
56d9de68 660{
661 no strict 'refs';
662 ${"$mbi\::accuracy"} = 1;
663 @params = $x->_find_round_parameters(undef,-2);
664 ok (scalar @params,1); # error, A and P defined
665 ok ($params[0],$x); # self
990fb837 666 ok ($x->is_nan(),1); # and must be NaN
56d9de68 667
668 ${"$mbi\::accuracy"} = undef;
669 ${"$mbi\::precision"} = 1;
670 @params = $x->_find_round_parameters(1,undef);
671 ok (scalar @params,1); # error, A and P defined
672 ok ($params[0],$x); # self
990fb837 673 ok ($x->is_nan(),1); # and must be NaN
56d9de68 674
675 ${"$mbi\::precision"} = undef; # reset
676}
61f5c3f5 677
678###############################################################################
679# test whether bone/bzero take additional A & P, or reset it etc
680
f9a08e12 681foreach my $c ($mbi,$mbf)
61f5c3f5 682 {
f9a08e12 683 $x = $c->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
684 $x = $c->new(2)->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
685 $x = $c->new(2)->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
686 $x = $c->new(2)->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
61f5c3f5 687
f9a08e12 688 $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
61f5c3f5 689 ok_undef ($x->{_a}); ok_undef ($x->{_p});
f9a08e12 690 $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
61f5c3f5 691 ok_undef ($x->{_a}); ok_undef ($x->{_p});
692
f9a08e12 693 $x = $c->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
694 $x = $c->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
695
696 $x = $c->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
697 $x = $c->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
698
699 $x = $c->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
700 $x = $c->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
701
702 $x = $c->new(2); $x->bone('+',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
703 $x = $c->new(2); $x->bone('+',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
704 $x = $c->new(2); $x->bone('-',2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
705 $x = $c->new(2); $x->bone('-',undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
61f5c3f5 706
f9a08e12 707 $x = $c->new(2); $x->bzero(2,undef); ok ($x->{_a},2); ok_undef ($x->{_p});
708 $x = $c->new(2); $x->bzero(undef,2); ok_undef ($x->{_a}); ok ($x->{_p},2);
709 }
710
711###############################################################################
712# test whether bone/bzero honour globals
61f5c3f5 713
f9a08e12 714for my $c ($mbi,$mbf)
715 {
716 $c->accuracy(2);
717 $x = $c->bone(); ok ($x->accuracy(),2);
718 $x = $c->bzero(); ok ($x->accuracy(),2);
719 $c->accuracy(undef);
720
721 $c->precision(-2);
722 $x = $c->bone(); ok ($x->precision(),-2);
723 $x = $c->bzero(); ok ($x->precision(),-2);
724 $c->precision(undef);
61f5c3f5 725 }
726
727###############################################################################
728# check whether mixing A and P creates a NaN
729
730# new with set accuracy/precision and with parameters
56d9de68 731{
732 no strict 'refs';
733 foreach my $c ($mbi,$mbf)
734 {
735 ok ($c->new(123,4,-3),'NaN'); # with parameters
736 ${"$c\::accuracy"} = 42;
737 ${"$c\::precision"} = 2;
738 ok ($c->new(123),'NaN'); # with globals
739 ${"$c\::accuracy"} = undef;
740 ${"$c\::precision"} = undef;
741 }
742}
61f5c3f5 743
744# binary ops
745foreach my $class ($mbi,$mbf)
746 {
747 foreach (qw/add sub mul pow mod/)
748 #foreach (qw/add sub mul div pow mod/)
749 {
750 my $try = "my \$x = $class->new(1234); \$x->accuracy(5); ";
751 $try .= "my \$y = $class->new(12); \$y->precision(-3); ";
752 $try .= "\$x->b$_(\$y);";
753 $rc = eval $try;
754 print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
755 }
756 }
757
758# unary ops
759foreach (qw/new bsqrt/)
760 {
761 my $try = 'my $x = $mbi->$_(1234,5,-3); ';
762 $rc = eval $try;
763 print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
764 }
765
28df3e88 766# see if $x->bsub(0) and $x->badd(0) really round
767foreach my $class ($mbi,$mbf)
768 {
769 $x = $class->new(123); $class->accuracy(2); $x->bsub(0);
770 ok ($x,120);
771 $class->accuracy(undef);
772 $x = $class->new(123); $class->accuracy(2); $x->badd(0);
773 ok ($x,120);
774 $class->accuracy(undef);
775 }
b3abae2a 776
61f5c3f5 777###############################################################################
778# test whether shortcuts returning zero/one preserve A and P
779
780my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args);
b3abae2a 781my $CALC = Math::BigInt->config()->{lib};
61f5c3f5 782while (<DATA>)
783 {
d614cd8b 784 chomp;
61f5c3f5 785 next if /^\s*(#|$)/; # skip comments and empty lines
786 if (s/^&//)
787 {
788 $f = $_; next; # function
789 }
790 @args = split(/:/,$_,99);
791 my $ans = pop(@args);
792
793 ($x,$xa,$xp) = split (/,/,$args[0]);
794 $xa = $xa || ''; $xp = $xp || '';
795 $try = "\$x = $mbi->new('$x'); ";
796 $try .= "\$x->accuracy($xa); " if $xa ne '';
797 $try .= "\$x->precision($xp); " if $xp ne '';
798
799 ($y,$ya,$yp) = split (/,/,$args[1]);
800 $ya = $ya || ''; $yp = $yp || '';
801 $try .= "\$y = $mbi->new('$y'); ";
802 $try .= "\$y->accuracy($ya); " if $ya ne '';
803 $try .= "\$y->precision($yp); " if $yp ne '';
804
805 $try .= "\$x->$f(\$y);";
806
9b924220 807 # print "trying $try\n";
61f5c3f5 808 $rc = eval $try;
809 # convert hex/binary targets to decimal
810 if ($ans =~ /^(0x0x|0b0b)/)
811 {
812 $ans =~ s/^0[xb]//;
813 $ans = $mbi->new($ans)->bstr();
814 }
815 print "# Tried: '$try'\n" if !ok ($rc, $ans);
816 # check internal state of number objects
817 is_valid($rc,$f) if ref $rc;
818
819 # now check whether A and P are set correctly
820 # only one of $a or $p will be set (no crossing here)
821 $a = $xa || $ya; $p = $xp || $yp;
822
823 # print "Check a=$a p=$p\n";
b3abae2a 824 # print "# Tried: '$try'\n";
f9a08e12 825 if ($a ne '')
826 {
827 if (!(ok ($x->{_a}, $a) && ok_undef ($x->{_p})))
828 {
829 print "# Check: A=$a and P=undef\n";
830 print "# Tried: '$try'\n";
831 }
832 }
833 if ($p ne '')
834 {
835 if (!(ok ($x->{_p}, $p) && ok_undef ($x->{_a})))
836 {
837 print "# Check: A=undef and P=$p\n";
838 print "# Tried: '$try'\n";
839 }
840 }
61f5c3f5 841 }
842
843# all done
8441;
845
846###############################################################################
847###############################################################################
848# Perl 5.005 does not like ok ($x,undef)
849
850sub ok_undef
851 {
852 my $x = shift;
853
f9a08e12 854 ok (1,1) and return 1 if !defined $x;
61f5c3f5 855 ok ($x,'undef');
856 print "# Called from ",join(' ',caller()),"\n";
f9a08e12 857 return 0;
61f5c3f5 858 }
859
860###############################################################################
861# sub to check validity of a BigInt internally, to ensure that no op leaves a
862# number object in an invalid state (f.i. "-0")
863
864sub is_valid
865 {
866 my ($x,$f) = @_;
867
868 my $e = 0; # error?
869 # ok as reference?
870 $e = 'Not a reference' if !ref($x);
871
872 # has ok sign?
873 $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
874 if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
875
876 $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
877 $e = $CALC->_check($x->{value}) if $e eq '0';
878
879 # test done, see if error did crop up
880 ok (1,1), return if ($e eq '0');
881
882 ok (1,$e." after op '$f'");
883 }
884
885# format is:
886# x,A,P:x,A,P:result
887# 123,,3 means 123 with precision 3 (A is undef)
888# the A or P of the result is calculated automatically
889__DATA__
890&badd
61f5c3f5 891123,,:123,,:246
892123,3,:0,,:123
893123,,-3:0,,:123
894123,,:0,3,:123
895123,,:0,,-3:123
896&bmul
897123,,:1,,:123
898123,3,:0,,:0
899123,,-3:0,,:0
900123,,:0,3,:0
901123,,:0,,-3:0
902123,3,:1,,:123
903123,,-3:1,,:123
904123,,:1,3,:123
905123,,:1,,-3:123
9061,3,:123,,:123
9071,,-3:123,,:123
9081,,:123,3,:123
9091,,:123,,-3:123
910&bdiv
911123,,:1,,:123
912123,4,:1,,:123
913123,,:1,4,:123
914123,,:1,,-4:123
915123,,-4:1,,:123
9161,4,:123,,:0
9171,,:123,4,:0
9181,,:123,,-4:0
9191,,-4:123,,:0
f9a08e12 920&band
9211,,:3,,:1
9221234,1,:0,,:0
9231234,,:0,1,:0
9241234,,-1:0,,:0
9251234,,:0,,-1:0
9260xFF,,:0x10,,:0x0x10
9270xFF,2,:0xFF,,:250
9280xFF,,:0xFF,2,:250
9290xFF,,1:0xFF,,:250
9300xFF,,:0xFF,,1:250
931&bxor
9321,,:3,,:2
9331234,1,:0,,:1000
9341234,,:0,1,:1000
9351234,,3:0,,:1000
9361234,,:0,,3:1000
9370xFF,,:0x10,,:239
938# 250 ^ 255 => 5
9390xFF,2,:0xFF,,:5
9400xFF,,:0xFF,2,:5
9410xFF,,1:0xFF,,:5
9420xFF,,:0xFF,,1:5
943# 250 ^ 4095 = 3845 => 3800
9440xFF,2,:0xFFF,,:3800
945# 255 ^ 4100 = 4347 => 4300
9460xFF,,:0xFFF,2,:4300
9470xFF,,2:0xFFF,,:3800
948# 255 ^ 4100 = 10fb => 4347 => 4300
9490xFF,,:0xFFF,,2:4300
950&bior
9511,,:3,,:3
9521234,1,:0,,:1000
9531234,,:0,1,:1000
9541234,,3:0,,:1000
9551234,,:0,,3:1000
9560xFF,,:0x10,,:0x0xFF
957# FF | FA = FF => 250
958250,2,:0xFF,,:250
9590xFF,,:250,2,:250
9600xFF,,1:0xFF,,:250
9610xFF,,:0xFF,,1:250
962&bpow
9632,,:3,,:8
9642,,:0,,:1
9652,2,:0,,:1
9662,,:0,2,:1
Unnamed repository; edit this file to name it for gitweb.