Commit | Line | Data |
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 |
7 | use strict; |
61f5c3f5 |
8 | my ($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 |
33 | foreach 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'); |
102 | ok_undef ($x->accuracy()); |
103 | ok ($x->accuracy(5),5); |
104 | ok_undef ($x->accuracy(undef),undef); |
105 | ok_undef ($x->precision()); |
106 | ok ($x->precision(5),5); |
107 | ok_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'); |
167 | ok ($x->copy()->round(5),'123.46'); |
168 | ok ($x->copy()->round(4),'123.5'); |
169 | ok ($x->copy()->round(5,2),'NaN'); |
170 | ok ($x->copy()->round(undef,-2),'123.46'); |
b3abae2a |
171 | ok ($x->copy()->round(undef,2),120); |
61f5c3f5 |
172 | |
173 | $x = $mbi->new('123'); |
174 | ok ($x->round(5,2),'NaN'); |
175 | |
176 | $x = $mbf->new('123.45000'); |
177 | ok ($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 | |
183 | ok ($y,123.4567); |
184 | $y = $x->copy()->round(5); |
185 | ok ($y->accuracy(),5); |
186 | ok_undef ($y->precision()); # A has precedence, so P still unset |
187 | $y = $x->copy()->round(undef,2); |
188 | ok ($y->precision(),2); |
189 | ok_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'); |
193 | ok ($x,'123.4567'); |
194 | ok ($x->accuracy(4),4); |
195 | ok ($x->precision(-2),-2); # clear A |
196 | ok_undef ($x->accuracy()); |
197 | |
198 | $x = $mbf->new('123.4567'); |
199 | ok ($x,'123.4567'); |
200 | ok ($x->precision(-2),-2); |
201 | ok ($x->accuracy(4),4); # clear P |
202 | ok_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 | |
211 | for 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 |
218 | foreach 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 | |
238 | foreach 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; |
311 | ok ($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; |
324 | ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over |
325 | |
326 | $x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6; |
327 | ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over |
328 | |
329 | $x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6; |
330 | ok ($x->bdiv($y),0); ok ($x->{_a},6); # carried over |
331 | |
332 | $x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6; |
333 | ok ($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'); |
339 | ok ($x->copy()->bsqrt(0),$x->copy()->bsqrt(undef)); |
340 | ok ($x->copy->bsqrt(0),'35136.41828644462161665823116758077037159'); |
341 | |
342 | ok_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(); |
347 | ok ($z,$x); ok ($x,'35136.41828644462161665823116758077037159'); |
348 | |
349 | $x = $mbf->new('1.234567890123456789'); |
350 | ok ($x->copy()->bpow('0.5',0),$x->copy()->bpow('0.5',undef)); |
351 | ok ($x->copy()->bpow('0.5',0),$x->copy()->bsqrt(undef)); |
352 | ok ($x->copy()->bpow('2',0),'1.524157875323883675019051998750190521'); |
353 | |
354 | ############################################################################### |
f9a08e12 |
355 | # test (also under Bare) that bfac() rounds at last step |
356 | |
357 | ok ($mbi->new(12)->bfac(),'479001600'); |
358 | ok ($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'); |
372 | ok ($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 |
397 | my $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); |
400 | print "# Got: '$warn'\n" unless |
990fb837 |
401 | ok ($warn =~ /^Use of uninitialized value (in numeric le \(<=\) |)at/); |
56d9de68 |
402 | $warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1); |
403 | print "# Got: '$warn'\n" unless |
990fb837 |
404 | ok ($warn =~ /^Use of uninitialized value (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); |
427 | ok ($x->bdiv($y),'3.333'); |
428 | ok ($x->{_a},4); # set's it since no fallback |
429 | |
430 | # rounding to P of x |
431 | $x = $mbf->new(10); $x->{_p} = -2; |
432 | ok ($x->bdiv(3),'3.33'); |
433 | |
434 | # round in div with requested P |
435 | $x = $mbf->new(10); |
436 | ok ($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; |
448 | ok ($x->bdiv($y),'3.333'); |
449 | ok ($x->{_a},4); ok ($y->{_a},4); # set's it since no fallback |
450 | ok_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; |
454 | ok ($x->bdiv($y),'3.33'); |
455 | ok ($x->{_p},-2); |
456 | ok ($y->{_p},-2); |
457 | ok_undef ($x->{_a}); ok_undef ($y->{_a}); |
458 | |
459 | ############################################################################### |
460 | # test whether bround(-n) fails in MBF (undocumented in MBI) |
461 | eval { $x = $mbf->new(1); $x->bround(-2); }; |
462 | ok ($@ =~ /^bround\(\) needs positive accuracy/,1); |
463 | |
464 | # test whether rounding to higher accuracy is no-op |
465 | $x = $mbf->new(1); $x->{_a} = 4; |
466 | ok ($x,'1.000'); |
467 | $x->bround(6); # must be no-op |
468 | ok ($x->{_a},4); |
469 | ok ($x,'1.000'); |
470 | |
471 | $x = $mbi->new(1230); $x->{_a} = 3; |
472 | ok ($x,'1230'); |
473 | $x->bround(6); # must be no-op |
474 | ok ($x->{_a},3); |
475 | ok ($x,'1230'); |
476 | |
477 | # bround(n) should set _a |
478 | $x->bround(2); # smaller works |
479 | ok ($x,'1200'); |
480 | ok ($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); |
486 | ok ($x,'12300'); |
487 | ok ($x->{_a},4); |
488 | |
489 | # bround(-n) should set _a |
490 | $x = $mbi->new(12345); |
491 | $x->bround(-2); |
492 | ok ($x,'12000'); |
493 | ok ($x->{_a},3); |
494 | |
495 | # bround(-n) should set _a |
496 | $x = $mbi->new(12345); $x->{_a} = 5; |
497 | $x->bround(-3); |
498 | ok ($x,'10000'); |
499 | ok ($x->{_a},2); |
500 | |
501 | # bround(-n) should set _a |
502 | $x = $mbi->new(12345); $x->{_a} = 5; |
503 | $x->bround(-4); |
504 | ok ($x,'0'); |
505 | ok ($x->{_a},1); |
506 | |
507 | # bround(-n) should be noop if n too big |
508 | $x = $mbi->new(12345); |
509 | $x->bround(-5); |
510 | ok ($x,'0'); # scale to "big" => 0 |
511 | ok ($x->{_a},0); |
512 | |
513 | # bround(-n) should be noop if n too big |
514 | $x = $mbi->new(54321); |
515 | $x->bround(-5); |
516 | ok ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000 |
517 | ok ($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); |
522 | ok ($x,'100000'); # no-op |
523 | ok ($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 |
528 | ok ($x,'12345'); |
529 | ok ($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 |
534 | ok ($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); |
545 | ok_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); |
550 | ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203'); |
551 | |
552 | $x = $mbf->new(1)->bdiv(5678,undef,-90); |
553 | ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651'); |
554 | |
555 | $x = $mbf->new(1)->bdiv(5678,80); |
556 | ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662'); |
557 | |
61f5c3f5 |
558 | ############################################################################### |
559 | # rounding with already set precision/accuracy |
560 | |
561 | $x = $mbf->new(1); $x->{_p} = -5; |
562 | ok ($x,'1.00000'); |
563 | |
564 | # further rounding donw |
565 | ok ($x->bfround(-2),'1.00'); |
566 | ok ($x->{_p},-2); |
567 | |
568 | $x = $mbf->new(12345); $x->{_a} = 5; |
569 | ok ($x->bround(2),'12000'); |
570 | ok ($x->{_a},2); |
571 | |
572 | $x = $mbf->new('1.2345'); $x->{_a} = 5; |
573 | ok ($x->bround(2),'1.2'); |
574 | ok ($x->{_a},2); |
575 | |
576 | # mantissa/exponent format and A/P |
577 | $x = $mbf->new('12345.678'); $x->accuracy(4); |
578 | ok ($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; |
586 | ok_undef ($x->{_a}); ok_undef ($x->{_p}); |
587 | |
588 | # result & reminder |
589 | $x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3); |
590 | ok_undef ($x->{_a}); ok_undef ($x->{_p}); |
591 | ok_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' |
598 | ok ($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' |
602 | ok ($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' |
606 | ok ($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); |
629 | my @params = $x->_find_round_parameters(); |
630 | ok (scalar @params,1); # nothing to round |
631 | |
632 | @params = $x->_find_round_parameters(1); |
633 | ok (scalar @params,4); # a=1 |
634 | ok ($params[0],$x); # self |
635 | ok ($params[1],1); # a |
636 | ok_undef ($params[2]); # p |
637 | ok ($params[3],'odd'); # round_mode |
638 | |
639 | @params = $x->_find_round_parameters(undef,2); |
640 | ok (scalar @params,4); # p=2 |
641 | ok ($params[0],$x); # self |
642 | ok_undef ($params[1]); # a |
643 | ok ($params[2],2); # p |
644 | ok ($params[3],'odd'); # round_mode |
645 | |
646 | eval { @params = $x->_find_round_parameters(undef,2,'foo'); }; |
647 | ok ($@ =~ /^Unknown round mode 'foo'/,1); |
648 | |
649 | @params = $x->_find_round_parameters(undef,2,'+inf'); |
650 | ok (scalar @params,4); # p=2 |
651 | ok ($params[0],$x); # self |
652 | ok_undef ($params[1]); # a |
653 | ok ($params[2],2); # p |
654 | ok ($params[3],'+inf'); # round_mode |
655 | |
656 | @params = $x->_find_round_parameters(2,-2,'+inf'); |
657 | ok (scalar @params,1); # error, A and P defined |
658 | ok ($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 |
681 | foreach 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 |
714 | for 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 |
745 | foreach 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 |
759 | foreach (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 |
767 | foreach 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 | |
780 | my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args); |
b3abae2a |
781 | my $CALC = Math::BigInt->config()->{lib}; |
61f5c3f5 |
782 | while (<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 |
844 | 1; |
845 | |
846 | ############################################################################### |
847 | ############################################################################### |
848 | # Perl 5.005 does not like ok ($x,undef) |
849 | |
850 | sub 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 | |
864 | sub 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 |
891 | 123,,:123,,:246 |
892 | 123,3,:0,,:123 |
893 | 123,,-3:0,,:123 |
894 | 123,,:0,3,:123 |
895 | 123,,:0,,-3:123 |
896 | &bmul |
897 | 123,,:1,,:123 |
898 | 123,3,:0,,:0 |
899 | 123,,-3:0,,:0 |
900 | 123,,:0,3,:0 |
901 | 123,,:0,,-3:0 |
902 | 123,3,:1,,:123 |
903 | 123,,-3:1,,:123 |
904 | 123,,:1,3,:123 |
905 | 123,,:1,,-3:123 |
906 | 1,3,:123,,:123 |
907 | 1,,-3:123,,:123 |
908 | 1,,:123,3,:123 |
909 | 1,,:123,,-3:123 |
910 | &bdiv |
911 | 123,,:1,,:123 |
912 | 123,4,:1,,:123 |
913 | 123,,:1,4,:123 |
914 | 123,,:1,,-4:123 |
915 | 123,,-4:1,,:123 |
916 | 1,4,:123,,:0 |
917 | 1,,:123,4,:0 |
918 | 1,,:123,,-4:0 |
919 | 1,,-4:123,,:0 |
f9a08e12 |
920 | &band |
921 | 1,,:3,,:1 |
922 | 1234,1,:0,,:0 |
923 | 1234,,:0,1,:0 |
924 | 1234,,-1:0,,:0 |
925 | 1234,,:0,,-1:0 |
926 | 0xFF,,:0x10,,:0x0x10 |
927 | 0xFF,2,:0xFF,,:250 |
928 | 0xFF,,:0xFF,2,:250 |
929 | 0xFF,,1:0xFF,,:250 |
930 | 0xFF,,:0xFF,,1:250 |
931 | &bxor |
932 | 1,,:3,,:2 |
933 | 1234,1,:0,,:1000 |
934 | 1234,,:0,1,:1000 |
935 | 1234,,3:0,,:1000 |
936 | 1234,,:0,,3:1000 |
937 | 0xFF,,:0x10,,:239 |
938 | # 250 ^ 255 => 5 |
939 | 0xFF,2,:0xFF,,:5 |
940 | 0xFF,,:0xFF,2,:5 |
941 | 0xFF,,1:0xFF,,:5 |
942 | 0xFF,,:0xFF,,1:5 |
943 | # 250 ^ 4095 = 3845 => 3800 |
944 | 0xFF,2,:0xFFF,,:3800 |
945 | # 255 ^ 4100 = 4347 => 4300 |
946 | 0xFF,,:0xFFF,2,:4300 |
947 | 0xFF,,2:0xFFF,,:3800 |
948 | # 255 ^ 4100 = 10fb => 4347 => 4300 |
949 | 0xFF,,:0xFFF,,2:4300 |
950 | &bior |
951 | 1,,:3,,:3 |
952 | 1234,1,:0,,:1000 |
953 | 1234,,:0,1,:1000 |
954 | 1234,,3:0,,:1000 |
955 | 1234,,:0,,3:1000 |
956 | 0xFF,,:0x10,,:0x0xFF |
957 | # FF | FA = FF => 250 |
958 | 250,2,:0xFF,,:250 |
959 | 0xFF,,:250,2,:250 |
960 | 0xFF,,1:0xFF,,:250 |
961 | 0xFF,,:0xFF,,1:250 |
962 | &bpow |
963 | 2,,:3,,:8 |
964 | 2,,:0,,:1 |
965 | 2,2,:0,,:1 |
966 | 2,,:0,2,:1 |