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