1# test rounding, accuracy, precision and fallback, round_mode and mixing
2# of classes
3
4# Make sure you always quote any bare floating-point values, lest 123.46 will
5# be stringified to 123.4599999999 due to limited float prevision.
6
7use strict;
8use warnings;
9
10my ($x, $y, $z, $u, $rc);
11our ($mbi, $mbf);
12
13###############################################################################
14# test defaults and set/get
15
16{
17    no strict 'refs';
18    is(${"$mbi\::accuracy"},   undef,  qq|\${"$mbi\::accuracy"}|);
19    is(${"$mbi\::precision"},  undef,  qq|\${"$mbi\::precision"}|);
20    is($mbi->accuracy(),       undef,  qq|$mbi->accuracy()|);
21    is($mbi->precision(),      undef,  qq|$mbi->precision()|);
22    is(${"$mbi\::div_scale"},  40,     qq|\${"$mbi\::div_scale"}|);
23    is(${"$mbi\::round_mode"}, 'even', qq|\${"$mbi\::round_mode"}|);
24    is($mbi->round_mode(),     'even', qq|$mbi->round_mode()|);
25
26    is(${"$mbf\::accuracy"},   undef,  qq|\${"$mbf\::accuracy"}|);
27    is(${"$mbf\::precision"},  undef,  qq|\${"$mbf\::precision"}|);
28    is($mbf->precision(),      undef,  qq|$mbf->precision()|);
29    is($mbf->precision(),      undef,  qq|$mbf->precision()|);
30    is(${"$mbf\::div_scale"},  40,     qq|\${"$mbf\::div_scale"}|);
31    is(${"$mbf\::round_mode"}, 'even', qq|\${"$mbf\::round_mode"}|);
32    is($mbf->round_mode(),     'even', qq|$mbf->round_mode()|);
33}
34
35# accessors
36foreach my $class ($mbi, $mbf) {
37    is($class->accuracy(),        undef,  qq|$class->accuracy()|);
38    is($class->precision(),       undef,  qq|$class->precision()|);
39    is($class->round_mode(),      "even", qq|$class->round_mode()|);
40    is($class->div_scale(),       40,     qq|$class->div_scale()|);
41
42    is($class->div_scale(20),     20,     qq|$class->div_scale(20)|);
43    $class->div_scale(40);
44    is($class->div_scale(),       40,     qq|$class->div_scale()|);
45
46    is($class->round_mode("odd"), "odd",  qq|$class->round_mode("odd")|);
47    $class->round_mode("even");
48    is($class->round_mode(),      "even", qq|$class->round_mode()|);
49
50    is($class->accuracy(2),       2,      qq|$class->accuracy(2)|);
51    $class->accuracy(3);
52    is($class->accuracy(),        3,      qq|$class->accuracy()|);
53    is($class->accuracy(undef),   undef,  qq|$class->accuracy(undef)|);
54
55    is($class->precision(2),      2,      qq|$class->precision(2)|);
56    is($class->precision(-2),     -2,     qq|$class->precision(-2)|);
57    $class->precision(3);
58    is($class->precision(),       3,      qq|$class->precision()|);
59    is($class->precision(undef),  undef,  qq|$class->precision(undef)|);
60}
61
62{
63    no strict 'refs';
64
65    # accuracy
66    foreach (qw/5 42 -1 0/) {
67        is(${"$mbf\::accuracy"} = $_, $_, qq|\${"$mbf\::accuracy"} = $_|);
68        is(${"$mbi\::accuracy"} = $_, $_, qq|\${"$mbi\::accuracy"} = $_|);
69    }
70    is(${"$mbf\::accuracy"} = undef, undef, qq|\${"$mbf\::accuracy"} = undef|);
71    is(${"$mbi\::accuracy"} = undef, undef, qq|\${"$mbi\::accuracy"} = undef|);
72
73    # precision
74    foreach (qw/5 42 -1 0/) {
75        is(${"$mbf\::precision"} = $_, $_, qq|\${"$mbf\::precision"} = $_|);
76        is(${"$mbi\::precision"} = $_, $_, qq|\${"$mbi\::precision"} = $_|);
77    }
78    is(${"$mbf\::precision"} = undef, undef,
79       qq|\${"$mbf\::precision"} = undef|);
80    is(${"$mbi\::precision"} = undef, undef,
81       qq|\${"$mbi\::precision"} = undef|);
82
83    # fallback
84    foreach (qw/5 42 1/) {
85        is(${"$mbf\::div_scale"} = $_, $_, qq|\${"$mbf\::div_scale"} = $_|);
86        is(${"$mbi\::div_scale"} = $_, $_, qq|\${"$mbi\::div_scale"} = $_|);
87    }
88    # illegal values are possible for fallback due to no accessor
89
90    # round_mode
91    foreach (qw/odd even zero trunc +inf -inf/) {
92        is(${"$mbf\::round_mode"} = $_, $_,
93           qq|\${"$mbf\::round_mode"} = "$_"|);
94        is(${"$mbi\::round_mode"} = $_, $_,
95           qq|\${"$mbi\::round_mode"} = "$_"|);
96    }
97    ${"$mbf\::round_mode"} = 'zero';
98    is(${"$mbf\::round_mode"}, 'zero', qq|\${"$mbf\::round_mode"}|);
99    is(${"$mbi\::round_mode"}, '-inf', qq|\${"$mbi\::round_mode"}|);
100
101    # reset for further tests
102    ${"$mbi\::accuracy"}  = undef;
103    ${"$mbi\::precision"} = undef;
104    ${"$mbf\::div_scale"} = 40;
105}
106
107# local copies
108$x = $mbf->new('123.456');
109is($x->accuracy(),       undef, q|$x->accuracy()|);
110is($x->accuracy(5),      5,     q|$x->accuracy(5)|);
111is($x->accuracy(undef),  undef, q|$x->accuracy(undef)|);
112is($x->precision(),      undef, q|$x->precision()|);
113is($x->precision(5),     5,     q|$x->precision(5)|);
114is($x->precision(undef), undef, q|$x->precision(undef)|);
115
116{
117    no strict 'refs';
118    # see if MBF changes MBIs values
119    is(${"$mbi\::accuracy"} = 42, 42, qq|\${"$mbi\::accuracy"} = 42|);
120    is(${"$mbf\::accuracy"} = 64, 64, qq|\${"$mbf\::accuracy"} = 64|);
121    is(${"$mbi\::accuracy"},      42, qq|\${"$mbi\::accuracy"} = 42|);
122    is(${"$mbf\::accuracy"},      64, qq|\${"$mbf\::accuracy"} = 64|);
123}
124
125###############################################################################
126# see if creating a number under set A or P will round it
127
128{
129    no strict 'refs';
130    ${"$mbi\::accuracy"}  = 4;
131    ${"$mbi\::precision"} = undef;
132
133    is($mbi->new(123456), 123500, qq|$mbi->new(123456) = 123500|); # with A
134    ${"$mbi\::accuracy"}  = undef;
135    ${"$mbi\::precision"} = 3;
136    is($mbi->new(123456), 123000, qq|$mbi->new(123456) = 123000|); # with P
137
138    ${"$mbf\::accuracy"}  = 4;
139    ${"$mbf\::precision"} = undef;
140    ${"$mbi\::precision"} = undef;
141
142    is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
143    ${"$mbf\::accuracy"}  = undef;
144    ${"$mbf\::precision"} = -1;
145    is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
146
147    ${"$mbf\::precision"} = undef; # reset
148}
149
150###############################################################################
151# see if MBI leaves MBF's private parts alone
152
153{
154    no strict 'refs';
155    ${"$mbi\::precision"} = undef;
156    ${"$mbf\::precision"} = undef;
157    ${"$mbi\::accuracy"}  = 4;
158    ${"$mbf\::accuracy"}  = undef;
159    is($mbf->new("123.456"), "123.456", qq|$mbf->new("123.456") = 123.456|);
160    ${"$mbi\::accuracy"}  = undef; # reset
161}
162
163###############################################################################
164# see if setting accuracy/precision actually rounds the number
165
166$x = $mbf->new("123.456");
167$x->accuracy(4);
168is($x, "123.5", qq|\$x = $mbf->new("123.456"); \$x->accuracy(4)|);
169
170$x = $mbf->new("123.456");
171$x->precision(-2);
172is($x, "123.46", qq|\$x = $mbf->new("123.456"); \$x->precision(-2)|);
173
174$x = $mbi->new(123456);
175$x->accuracy(4);
176is($x, 123500, qq|\$x = $mbi->new(123456); \$x->accuracy(4)|);
177
178$x = $mbi->new(123456);
179$x->precision(2);
180is($x, 123500, qq|\$x = $mbi->new(123456); \$x->precision(2)|);
181
182###############################################################################
183# test actual rounding via round()
184
185$x = $mbf->new("123.456");
186is($x->copy()->round(5), "123.46",
187   qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5)|);
188is($x->copy()->round(4), "123.5",
189   qq|\$x = $mbf->new("123.456"); \$x->copy()->round(4)|);
190is($x->copy()->round(5, 2), "NaN",
191   qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5, 2)|);
192is($x->copy()->round(undef, -2), "123.46",
193   qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, -2)|);
194is($x->copy()->round(undef, 2), 120,
195   qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, 2)|);
196
197$x = $mbi->new("123");
198is($x->round(5, 2), "NaN",
199   qq|\$x = $mbi->new("123"); \$x->round(5, 2)|);
200
201$x = $mbf->new("123.45000");
202is($x->copy()->round(undef, -1, "odd"), "123.5",
203   qq|\$x = $mbf->new("123.45000"); \$x->copy()->round(undef, -1, "odd")|);
204
205# see if rounding is 'sticky'
206$x = $mbf->new("123.4567");
207$y = $x->copy()->bround();              # no-op since nowhere A or P defined
208
209is($y, 123.4567,
210   qq|\$x = $mbf->new("123.4567"); \$y = \$x->copy()->bround()|);
211$y = $x->copy()->round(5);
212is($y->accuracy(), 5,
213   q|$y = $x->copy()->round(5); $y->accuracy()|);
214is($y->precision(), undef,              # A has precedence, so P still unset
215   q|$y = $x->copy()->round(5); $y->precision()|);
216$y = $x->copy()->round(undef, 2);
217is($y->precision(), 2,
218   q|$y = $x->copy()->round(undef, 2); $y->precision()|);
219is($y->accuracy(), undef,               # P has precedence, so A still unset
220   q|$y = $x->copy()->round(undef, 2); $y->accuracy()|);
221
222# see if setting A clears P and vice versa
223$x = $mbf->new("123.4567");
224is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
225is($x->accuracy(4), 4, q|$x->accuracy(4)|);
226is($x->precision(-2), -2, q|$x->precision(-2)|);                # clear A
227is($x->accuracy(), undef, q|$x->accuracy()|);
228
229$x = $mbf->new("123.4567");
230is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
231is($x->precision(-2), -2, q|$x->precision(-2)|);
232is($x->accuracy(4), 4, q|$x->accuracy(4)|);                     # clear P
233is($x->precision(), undef, q|$x->precision()|);
234
235# does copy work?
236$x = $mbf->new(123.456);
237$x->accuracy(4);
238$x->precision(2);
239
240$z = $x->copy();
241is($z->accuracy(),  undef, q|$z = $x->copy(); $z->accuracy()|);
242is($z->precision(), 2,     q|$z = $x->copy(); $z->precision()|);
243
244# does $x->bdiv($y, d) work when $d > div_scale?
245$x = $mbf->new("0.008");
246$x->accuracy(8);
247
248for my $e (4, 8, 16, 32) {
249    is(scalar $x->copy()->bdiv(3, $e), "0.002" . ("6" x ($e - 2)) . "7",
250       qq|\$x->copy()->bdiv(3, $e)|);
251}
252
253# does accuracy()/precision work on zeros?
254foreach my $class ($mbi, $mbf) {
255
256    $x = $class->bzero();
257    $x->accuracy(5);
258    is($x->{accuracy}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{accuracy}|);
259
260    $x = $class->bzero();
261    $x->precision(5);
262    is($x->{precision}, 5, qq|\$x = $class->bzero(); \$x->precision(5); \$x->{precision}|);
263
264    $x = $class->new(0);
265    $x->accuracy(5);
266    is($x->{accuracy}, 5, qq|\$x = $class->new(0); \$x->accuracy(5); \$x->{accuracy}|);
267
268    $x = $class->new(0);
269    $x->precision(5);
270    is($x->{precision}, 5, qq|\$x = $class->new(0); \$x->precision(5); \$x->{precision}|);
271
272    $x = $class->bzero();
273    $x->round(5);
274    is($x->{accuracy}, 5, qq|\$x = $class->bzero(); \$x->round(5); \$x->{accuracy}|);
275
276    $x = $class->bzero();
277    $x->round(undef, 5);
278    is($x->{precision}, 5, qq|\$x = $class->bzero(); \$x->round(undef, 5); \$x->{precision}|);
279
280    $x = $class->new(0);
281    $x->round(5);
282    is($x->{accuracy}, 5, qq|\$x = $class->new(0); \$x->round(5); \$x->{accuracy}|);
283
284    $x = $class->new(0);
285    $x->round(undef, 5);
286    is($x->{precision}, 5, qq|\$x = $class->new(0); \$x->round(undef, 5); \$x->{precision}|);
287
288    # see if trying to increasing A in bzero() doesn't do something
289    $x = $class->bzero();
290    $x->{accuracy} = 3;
291    $x->round(5);
292    is($x->{accuracy}, 3,
293       qq|\$x = $class->bzero(); \$x->{accuracy} = 3; \$x->round(5); \$x->{accuracy}|);
294}
295
296###############################################################################
297# test whether an opp calls objectify properly or not (or at least does what
298# it should do given non-objects, w/ or w/o objectify())
299
300foreach my $class ($mbi, $mbf) {
301    #  ${"$class\::precision"} = undef;         # reset
302    #  ${"$class\::accuracy"} = undef;          # reset
303
304    is($class->new(123)->badd(123), 246, qq|$class->new(123)->badd(123)|);
305    is($class->badd(123, 321), 444, qq|$class->badd(123, 321)|);
306    is($class->badd(123, $class->new(321)), 444,
307       qq|$class->badd(123, $class->new(321))|);
308
309    is($class->new(123)->bsub(122), 1, qq|$class->new(123)->bsub(122)|);
310    is($class->bsub(321, 123), 198, qq|$class->bsub(321, 123)|);
311    is($class->bsub(321, $class->new(123)), 198,
312       qq|$class->bsub(321, $class->new(123))|);
313
314    is($class->new(123)->bmul(123), 15129, qq|$class->new(123)->bmul(123)|);
315    is($class->bmul(123, 123), 15129, qq|$class->bmul(123, 123)|);
316    is($class->bmul(123, $class->new(123)), 15129,
317       qq|$class->bmul(123, $class->new(123))|);
318
319    # is($class->new(15129)->bdiv(123), 123, qq|$class->new(15129)->bdiv(123)|);
320    # is($class->bdiv(15129, 123), 123, qq|$class->bdiv(15129, 123)|);
321    # is($class->bdiv(15129, $class->new(123)), 123,
322    #    qq|$class->bdiv(15129, $class->new(123))|);
323
324    is($class->new(15131)->bmod(123), 2, qq|$class->new(15131)->bmod(123)|);
325    is($class->bmod(15131, 123), 2, qq|$class->bmod(15131, 123)|);
326    is($class->bmod(15131, $class->new(123)), 2,
327       qq|$class->bmod(15131, $class->new(123))|);
328
329    is($class->new(2)->bpow(16), 65536, qq|$class->new(2)->bpow(16)|);
330    is($class->bpow(2, 16), 65536, qq|$class->bpow(2, 16)|);
331    is($class->bpow(2, $class->new(16)), 65536,
332       qq|$class->bpow(2, $class->new(16))|);
333
334    is($class->new(2**15)->brsft(1), 2**14, qq|$class->new(2**15)->brsft(1)|);
335    is($class->brsft(2**15, 1), 2**14, qq|$class->brsft(2**15, 1)|);
336    is($class->brsft(2**15, $class->new(1)), 2**14,
337       qq|$class->brsft(2**15, $class->new(1))|);
338
339    is($class->new(2**13)->blsft(1), 2**14, qq|$class->new(2**13)->blsft(1)|);
340    is($class->blsft(2**13, 1), 2**14, qq|$class->blsft(2**13, 1)|);
341    is($class->blsft(2**13, $class->new(1)), 2**14,
342       qq|$class->blsft(2**13, $class->new(1))|);
343}
344
345###############################################################################
346# Test whether operations round properly afterwards.
347# These tests are not complete, since they do not exercise every "return"
348# statement in the op's. But heh, it's better than nothing...
349
350$x = $mbf->new("123.456");
351$y = $mbf->new("654.321");
352$x->{accuracy} = 5;           # $x->accuracy(5) would round $x straight away
353$y->{accuracy} = 4;           # $y->accuracy(4) would round $x straight away
354
355$z = $x + $y;
356is($z, "777.8", q|$z = $x + $y|);
357
358$z = $y - $x;
359is($z, "530.9", q|$z = $y - $x|);
360
361$z = $y * $x;
362is($z, "80780", q|$z = $y * $x|);
363
364$z = $x ** 2;
365is($z, "15241", q|$z = $x ** 2|);
366
367$z = $x * $x;
368is($z, "15241", q|$z = $x * $x|);
369
370# not:
371#$z = -$x;
372#is($z, '-123.46');
373#is($x, '123.456');
374
375$z = $x->copy();
376$z->{accuracy} = 2;
377$z = $z / 2;
378is($z, 62, q|$z = $z / 2|);
379
380$x = $mbf->new(123456);
381$x->{accuracy} = 4;
382$z = $x->copy;
383$z++;
384is($z, 123500, q|$z++|);
385
386$x = $mbi->new(123456);
387$y = $mbi->new(654321);
388$x->{accuracy} = 5;           # $x->accuracy(5) would round $x straight away
389$y->{accuracy} = 4;           # $y->accuracy(4) would round $x straight away
390
391$z = $x + $y;
392is($z, 777800, q|$z = $x + $y|);
393
394$z = $y - $x;
395is($z, 530900, q|$z = $y - $x|);
396
397$z = $y * $x;
398is($z, 80780000000, q|$z = $y * $x|);
399
400$z = $x ** 2;
401is($z, 15241000000, q|$z = $x ** 2|);
402
403# not yet: $z = -$x;
404# is($z, -123460, qq|$z|);
405# is($x, 123456, qq|$x|);
406
407$z = $x->copy;
408$z++;
409is($z, 123460, q|$z++|);
410
411$z = $x->copy();
412$z->{accuracy} = 2;
413$z = $z / 2;
414is($z, 62000, q|$z = $z / 2|);
415
416$x = $mbi->new(123400);
417$x->{accuracy} = 4;
418is($x->bnot(), -123400, q|$x->bnot()|);         # not -1234001
419
420# to be consistent with other methods, babs() and bneg() also support rounding
421
422$x = $mbi->new(-123401);
423$x->{accuracy} = 4;
424is($x->babs(), 123400, q|$x->babs()|);
425
426$x = $mbi->new(-123401);
427$x->{accuracy} = 4;
428is($x->bneg(), 123400, q|$x->bneg()|);
429
430# test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
431
432$mbf->round_mode('even');
433$x = $mbf->new('740.7')->bdiv('6', 4, undef, 'zero');
434is($x, '123.4', q|$x|);
435
436$x = $mbi->new('123456');
437$y = $mbi->new('123456');
438$y->{accuracy} = 6;
439is($x->bdiv($y), 1, q|$x->bdiv($y)|);
440is($x->{accuracy}, 6, q|$x->{accuracy}|);                   # carried over
441
442$x = $mbi->new('123456');
443$y = $mbi->new('123456');
444$x->{accuracy} = 6;
445is($x->bdiv($y), 1, q|$x->bdiv($y)|);
446is($x->{accuracy}, 6, q|$x->{accuracy}|);                   # carried over
447
448$x = $mbi->new('123456');
449$y = $mbi->new('223456');
450$y->{accuracy} = 6;
451is($x->bdiv($y), 0, q|$x->bdiv($y)|);
452is($x->{accuracy}, 6, q|$x->{accuracy}|);                   # carried over
453
454$x = $mbi->new('123456');
455$y = $mbi->new('223456');
456$x->{accuracy} = 6;
457is($x->bdiv($y), 0, q|$x->bdiv($y)|);
458is($x->{accuracy}, 6, q|$x->{accuracy}|);                   # carried over
459
460###############################################################################
461# test that bop(0) does the same than bop(undef)
462
463$x = $mbf->new('1234567890');
464is($x->copy()->bsqrt(0), $x->copy()->bsqrt(undef),
465   q|$x->copy()->bsqrt(...)|);
466is($x->copy->bsqrt(0), '35136.41828644462161665823116758077037159',
467   q|$x->copy->bsqrt(...)|);
468
469is($x->{accuracy}, undef, q|$x->{accuracy}|);
470
471# test that bsqrt() modifies $x and does not just return something else
472# (especially under Math::BigInt::BareCalc)
473$z = $x->bsqrt();
474is($z, $x, q|$z = $x->bsqrt(); $z|);
475is($x, '35136.41828644462161665823116758077037159', q|$z = $x->bsqrt(); $x|);
476
477$x = $mbf->new('1.234567890123456789');
478
479is($x->copy()->bpow('0.5', 0),
480   $x->copy()->bpow('0.5', undef),
481   q|$x->copy()->bpow(...)|);
482
483is($x->copy()->bpow('0.5', 0),
484   $x->copy()->bsqrt(undef),
485   q|$x->copy()->bpow(...) vs. $x->copy()->bsqrt(...)|);
486
487is($x->copy()->bpow('2', 0), '1.524157875323883675019051998750190521',
488   q|$x->copy()->bpow('2', 0)|);
489
490###############################################################################
491# test (also under Bare) that bfac() rounds at last step
492
493is($mbi->new(12)->bfac(),  '479001600', q|$mbi->new(12)->bfac()|);
494is($mbi->new(12)->bfac(2), '480000000', q|$mbi->new(12)->bfac(2)|);
495
496$x = $mbi->new(12);
497$x->accuracy(2);
498is($x->bfac(), '480000000',
499   qq|\$x = $mbi->new(12); \$x->accuracy(2); \$x->bfac()|);
500
501$x = $mbi->new(13);
502$x->accuracy(2);
503is($x->bfac(), '6200000000',
504   qq|\$x = $mbi->new(13); \$x->accuracy(2); \$x->bfac()|);
505
506$x = $mbi->new(13);
507$x->accuracy(3);
508is($x->bfac(), '6230000000',
509   qq|\$x = $mbi->new(13); \$x->accuracy(3); \$x->bfac()|);
510
511$x = $mbi->new(13);
512$x->accuracy(4);
513is($x->bfac(), '6227000000',
514   qq|\$x = $mbi->new(13); \$x->accuracy(4); \$x->bfac()|);
515
516# this does 1, 2, 3...9, 10, 11, 12...20
517$x = $mbi->new(20);
518$x->accuracy(1);
519is($x->bfac(), '2000000000000000000',
520   qq|\$x = $mbi->new(20); \$x->accuracy(1); \$x->bfac()|);
521
522###############################################################################
523# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
524
525$x = $mbi->new('123456')->bsqrt(2, undef);
526is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351
527
528$x = $mbi->new('3')->bsqrt(2, undef);
529is($x->accuracy(), 2, q|$x->accuracy()|);
530
531$mbi->round_mode('even');
532$x = $mbi->new('126025')->bsqrt(2, undef, '+inf');
533is($x, '360', q|$x = 360|);     # not 355 nor 350
534
535$x = $mbi->new('126025')->bsqrt(undef, 2);
536is($x, '400', q|$x = 400|);      # not 355
537
538###############################################################################
539# test mixed arguments
540
541$x = $mbf->new(10);
542$u = $mbf->new(2.5);
543$y = $mbi->new(2);
544
545$z = $x + $y;
546is($z, 12, q|$z = $x + $y;|);
547is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
548
549$z = $x / $y;
550is($z, 5, q|$z = $x / $y;|);
551is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
552
553$z = $u * $y;
554is($z, 5, q|$z = $u * $y;|);
555is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
556
557$y = $mbi->new(12345);
558$z = $u->copy()->bmul($y, 2, undef, 'odd');
559is($z, 31000, q|$z = 31000|);
560
561$z = $u->copy()->bmul($y, 3, undef, 'odd');
562is($z, 30900, q|$z = 30900|);
563
564$z = $u->copy()->bmul($y, undef, 0, 'odd');
565is($z, 30863, q|$z = 30863|);
566
567$z = $u->copy()->bmul($y, undef, 1, 'odd');
568is($z, 30863, q|$z = 30863|);
569
570$z = $u->copy()->bmul($y, undef, 2, 'odd');
571is($z, 30860, q|$z = 30860|);
572
573$z = $u->copy()->bmul($y, undef, 3, 'odd');
574is($z, 30900, q|$z = 30900|);
575
576$z = $u->copy()->bmul($y, undef, -1, 'odd');
577is($z, 30862.5, q|$z = 30862.5|);
578
579my $warn = '';
580$SIG{__WARN__} = sub { $warn = shift; };
581
582# These should no longer warn, even though '3.17' is a NaN in Math::BigInt
583# (>= returns now false, bug until v1.80).
584
585$warn = '';
586eval '$z = 3.17 <= $y';
587is($z, '', q|$z = ""|);
588unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/,
589       q|"$z = $y >= 3.17" gives warning as expected|);
590
591$warn = '';
592eval '$z = $y >= 3.17';
593is($z, '', q|$z = ""|);
594unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/,
595      q|"$z = $y >= 3.17" gives warning as expected|);
596
597# XXX TODO breakage:
598#
599# $z = $y->copy()->bmul($u, 2, 0, 'odd');
600# is($z, 31000);
601#
602# $z = $y * $u;
603# is($z, 5);
604# is(ref($z), $mbi, q|\$z is a $mbi object|);
605#
606# $z = $y + $x;
607# is($z, 12);
608# is(ref($z), $mbi, q|\$z is a $mbi object|);
609#
610# $z = $y / $x;
611# is($z, 0);
612# is(ref($z), $mbi, q|\$z is a $mbi object|);
613
614###############################################################################
615# rounding in bdiv with fallback and already set A or P
616
617{
618    no strict 'refs';
619    ${"$mbf\::accuracy"}  = undef;
620    ${"$mbf\::precision"} = undef;
621    ${"$mbf\::div_scale"} = 40;
622}
623
624$x = $mbf->new(10);
625$x->{accuracy} = 4;
626is($x->bdiv(3), '3.333', q|$x->bdiv(3)|);
627is($x->{accuracy}, 4, q|$x->{accuracy}|);                # set's it since no fallback
628
629$x = $mbf->new(10);
630$x->{accuracy} = 4;
631$y = $mbf->new(3);
632is($x->bdiv($y), '3.333', q|$x->bdiv($y)|);
633is($x->{accuracy}, 4, q|$x->{accuracy}|);                   # set's it since no fallback
634
635# rounding to P of x
636$x = $mbf->new(10);
637$x->{precision} = -2;
638is($x->bdiv(3), '3.33', q|$x->bdiv(3)|);
639
640# round in div with requested P
641$x = $mbf->new(10);
642is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|);
643
644# round in div with requested P greater than fallback
645{
646    no strict 'refs';
647    ${"$mbf\::div_scale"} = 5;
648    $x = $mbf->new(10);
649    is($x->bdiv(3, undef, -8), "3.33333333",
650       q|$x->bdiv(3, undef, -8) = "3.33333333"|);
651    ${"$mbf\::div_scale"} = 40;
652}
653
654$x = $mbf->new(10);
655$y = $mbf->new(3);
656$y->{accuracy} = 4;
657is($x->bdiv($y), '3.333', q|$x->bdiv($y) = '3.333'|);
658is($x->{accuracy}, 4, q|$x->{accuracy} = 4|);
659is($y->{accuracy}, 4, q|$y->{accuracy} = 4|);       # set's it since no fallback
660is($x->{precision}, undef, q|$x->{precision} = undef|);
661is($y->{precision}, undef, q|$y->{precision} = undef|);
662
663# rounding to P of y
664$x = $mbf->new(10);
665$y = $mbf->new(3);
666$y->{precision} = -2;
667is($x->bdiv($y), '3.33', q|$x->bdiv($y) = '3.33'|);
668is($x->{precision}, -2, q|$x->{precision} = -2|);
669 is($y->{precision}, -2, q|$y->{precision} = -2|);
670is($x->{accuracy}, undef, q|$x->{accuracy} = undef|);
671is($y->{accuracy}, undef, q|$y->{accuracy} = undef|);
672
673###############################################################################
674# test whether bround(-n) fails in MBF (undocumented in MBI)
675eval { $x = $mbf->new(1);
676       $x->bround(-2);
677     };
678like($@, qr/^bround\(\) needs positive accuracy/,
679    qq|"\$x->bround(-2)" gives warning as expected|);
680
681note("test whether rounding to higher accuracy is no-op");
682
683$x = $mbf->new(1);
684$x->{accuracy} = 4;
685is($x, "1.000", q|$x = "1.000"|);
686$x->bround(6);                  # must be no-op
687is($x->{accuracy}, 4, q|$x->{accuracy} = 4|);
688is($x, "1.000", q|$x = "1.000"|);
689
690$x = $mbi->new(1230);
691$x->{accuracy} = 3;
692is($x, "1230", q|$x = "1230"|);
693$x->bround(6);                  # must be no-op
694is($x->{accuracy}, 3, q|$x->{accuracy} = 3|);
695is($x, "1230", q|$x = "1230"|);
696
697note("bround(n) should set accuracy");
698
699$x->bround(2);                  # smaller works
700is($x, "1200", q|$x = "1200"|);
701is($x->{accuracy}, 2, q|$x->{accuracy} = 2|);
702
703# bround(-n) is undocumented and only used by MBF
704
705note("bround(-n) should set accuracy");
706
707$x = $mbi->new(12345);
708$x->bround(-1);
709is($x, "12300", q|$x = "12300"|);
710is($x->{accuracy}, 4, q|$x->{accuracy} = 4|);
711
712note("bround(-n) should set accuracy");
713
714$x = $mbi->new(12345);
715$x->bround(-2);
716is($x, "12000", q|$x = "12000"|);
717is($x->{accuracy}, 3, q|$x->{accuracy} = 3|);
718
719note("bround(-n) should set accuracy");
720
721$x = $mbi->new(12345);
722$x->{accuracy} = 5;
723$x->bround(-3);
724is($x, "10000", q|$x = "10000"|);
725is($x->{accuracy}, 2, q|$x->{accuracy} = 2|);
726
727note("bround(-n) should set accuracy");
728
729$x = $mbi->new(12345);
730$x->{accuracy} = 5;
731$x->bround(-4);
732is($x, "0", q|$x = "0"|);
733is($x->{accuracy}, 1, q|$x->{accuracy} = 1|);
734
735note("bround(-n) should be no-op if n too big");
736
737$x = $mbi->new(12345);
738$x->bround(-5);
739is($x, "0", q|$x = "0"|);               # scale to "big" => 0
740is($x->{accuracy}, 0, q|$x->{accuracy} = 0|);
741
742note("bround(-n) should be no-op if n too big");
743
744$x = $mbi->new(54321);
745$x->bround(-5);
746is($x, "100000", q|$x = "100000"|);     # used by MBF to round 0.0054321 at 0.0_6_00000
747is($x->{accuracy}, 0, q|$x->{accuracy} = 0|);
748
749note("bround(-n) should be no-op if n too big");
750
751$x = $mbi->new(54321);
752$x->{accuracy} = 5;
753$x->bround(-6);
754is($x, "100000", q|$x = "100000"|);     # no-op
755is($x->{accuracy}, 0, q|$x->{accuracy} = 0|);
756
757note("bround(n) should set accuracy");
758
759$x = $mbi->new(12345);
760$x->{accuracy} = 5;
761$x->bround(5);                          # must be no-op
762is($x, "12345", q|$x = "12345"|);
763is($x->{accuracy}, 5, q|$x->{accuracy} = 5|);
764
765note("bround(n) should set accuracy");
766
767$x = $mbi->new(12345);
768$x->{accuracy} = 5;
769$x->bround(6);                          # must be no-op
770is($x, "12345", q|$x = "12345"|);
771
772$x = $mbf->new("0.0061");
773$x->bfround(-2);
774is($x, "0.01", q|$x = "0.01"|);
775$x = $mbf->new("0.004");
776$x->bfround(-2);
777is($x, "0.00", q|$x = "0.00"|);
778$x = $mbf->new("0.005");
779$x->bfround(-2);
780is($x, "0.00", q|$x = "0.00"|);
781
782$x = $mbf->new("12345");
783$x->bfround(2);
784is($x, "12340", q|$x = "12340"|);
785$x = $mbf->new("12340");
786$x->bfround(2);
787is($x, "12340", q|$x = "12340"|);
788
789note("MBI::bfround should clear A for negative P");
790
791$x = $mbi->new("1234");
792$x->accuracy(3);
793$x->bfround(-2);
794is($x->{accuracy}, undef, q|$x->{accuracy} = undef|);
795
796note("test that bfround() and bround() work with large numbers");
797
798$x = $mbf->new(1)->bdiv(5678, undef, -63);
799is($x, "0.000176118351532229658330398027474462839027826699542092286016203",
800   q|$x = "0.000176118351532229658330398027474462839027826699542092286016203"|);
801
802$x = $mbf->new(1)->bdiv(5678, undef, -90);
803is($x, "0.00017611835153222965833039802747446283902782"
804     . "6699542092286016202888340965128566396618527651",
805   q|$x = "0.00017611835153222965833039802747446283902782|
806       . q|6699542092286016202888340965128566396618527651"|);
807
808$x = $mbf->new(1)->bdiv(5678, 80);
809is($x, "0.00017611835153222965833039802747446283902782"
810     . "669954209228601620288834096512856639662",
811   q|$x = "0.00017611835153222965833039802747446283902782|
812       . q|669954209228601620288834096512856639662"|);
813
814###############################################################################
815
816note("rounding with already set precision/accuracy");
817
818$x = $mbf->new(1);
819$x->{precision} = -5;
820is($x, "1.00000", q|$x = "1.00000"|);
821
822note("further rounding down");
823
824is($x->bfround(-2), "1.00", q|$x->bfround(-2) = "1.00"|);
825is($x->{precision}, -2, q|$x->{precision} = -2|);
826
827$x = $mbf->new(12345);
828$x->{accuracy} = 5;
829is($x->bround(2), "12000", q|$x->bround(2) = "12000"|);
830is($x->{accuracy}, 2, q|$x->{accuracy} = 2|);
831
832$x = $mbf->new("1.2345");
833$x->{accuracy} = 5;
834is($x->bround(2), "1.2", q|$x->bround(2) = "1.2"|);
835is($x->{accuracy}, 2, q|$x->{accuracy} = 2|);
836
837note("mantissa/exponent format and A/P");
838
839$x = $mbf->new("12345.678");
840$x->accuracy(4);
841is($x, "12350", q|$x = "12350"|);
842is($x->{accuracy}, 4, q|$x->{accuracy} = 4|);
843is($x->{precision}, undef, q|$x->{precision} = undef|);
844
845#is($x->{_m}->{accuracy}, undef, q|$x->{_m}->{accuracy} = undef|);
846#is($x->{_e}->{accuracy}, undef, q|$x->{_e}->{accuracy} = undef|);
847#is($x->{_m}->{precision}, undef, q|$x->{_m}->{precision} = undef|);
848#is($x->{_e}->{precision}, undef, q|$x->{_e}->{precision} = undef|);
849
850note("check for no A/P in case of fallback result");
851
852$x = $mbf->new(100) / 3;
853is($x->{accuracy}, undef, q|$x->{accuracy} = undef|);
854is($x->{precision}, undef, q|$x->{precision} = undef|);
855
856note("result & remainder");
857
858$x = $mbf->new(100) / 3;
859($x, $y) = $x->bdiv(3);
860is($x->{accuracy}, undef, q|$x->{accuracy} = undef|);
861is($x->{precision}, undef, q|$x->{precision} = undef|);
862is($y->{accuracy}, undef, q|$y->{accuracy} = undef|);
863is($y->{precision}, undef, q|$y->{precision} = undef|);
864
865###############################################################################
866# math with two numbers with different A and P
867
868$x = $mbf->new(12345);
869$x->accuracy(4); # "12340"
870$y = $mbf->new(12345);
871$y->accuracy(2); # "12000"
872is($x+$y, 24000, q|$x+$y = 24000|);     # 12340+12000=> 24340 => 24000
873
874$x = $mbf->new(54321);
875$x->accuracy(4); # "12340"
876$y = $mbf->new(12345);
877$y->accuracy(3); # "12000"
878is($x-$y, 42000, q|$x-$y = 42000|);     # 54320+12300=> 42020 => 42000
879
880$x = $mbf->new("1.2345");
881$x->precision(-2); # "1.23"
882$y = $mbf->new("1.2345");
883$y->precision(-4); # "1.2345"
884is($x+$y, "2.46", q|$x+$y = "2.46"|);   # 1.2345+1.2300=> 2.4645 => 2.46
885
886###############################################################################
887# round should find and use proper class
888
889#$x = Foo->new();
890#is($x->round($Foo::accuracy), "a" x $Foo::accuracy);
891#is($x->round(undef, $Foo::precision), "p" x $Foo::precision);
892#is($x->bfround($Foo::precision), "p" x $Foo::precision);
893#is($x->bround($Foo::accuracy), "a" x $Foo::accuracy);
894
895###############################################################################
896# find out whether _find_round_parameters is doing what's it's supposed to do
897
898{
899    no strict 'refs';
900    ${"$mbi\::accuracy"} = undef;
901    ${"$mbi\::precision"} = undef;
902    ${"$mbi\::div_scale"} = 40;
903    ${"$mbi\::round_mode"} = 'odd';
904}
905
906$x = $mbi->new(123);
907my @params = $x->_find_round_parameters();
908is(scalar(@params), 1, q|scalar(@params) = 1|);       # nothing to round
909
910@params = $x->_find_round_parameters(1);
911is(scalar(@params), 4, q|scalar(@params) = 4|);       # a=1
912is($params[0], $x, q|$params[0] = $x|);               # self
913is($params[1], 1, q|$params[1] = 1|);                 # a
914is($params[2], undef, q|$params[2] = undef|);         # p
915is($params[3], "odd", q|$params[3] = "odd"|);         # round_mode
916
917@params = $x->_find_round_parameters(undef, 2);
918is(scalar(@params), 4, q|scalar(@params) = 4|);       # p=2
919is($params[0], $x, q|$params[0] = $x|);               # self
920is($params[1], undef, q|$params[1] = undef|);         # a
921is($params[2], 2, q|$params[2] = 2|);                 # p
922is($params[3], "odd", q|$params[3] = "odd"|);         # round_mode
923
924eval { @params = $x->_find_round_parameters(undef, 2, "foo"); };
925like($@, qr/^Unknown round mode 'foo'/,
926    q|round mode "foo" gives a warning as expected|);
927
928@params = $x->_find_round_parameters(undef, 2, "+inf");
929is(scalar(@params), 4, q|scalar(@params) = 4|);       # p=2
930is($params[0], $x, q|$params[0] = $x|);               # self
931is($params[1], undef, q|$params[1] = undef|);         # a
932is($params[2], 2, q|$params[2] = 2|);                 # p
933is($params[3], "+inf", q|$params[3] = "+inf"|);       # round_mode
934
935@params = $x->_find_round_parameters(2, -2, "+inf");
936is(scalar(@params), 1, q|scalar(@params) = 1|);       # error, A and P defined
937is($params[0], $x, q|$params[0] = $x|);               # self
938
939{
940    no strict 'refs';
941    ${"$mbi\::accuracy"} = 1;
942    @params = $x->_find_round_parameters(undef, -2);
943    is(scalar(@params), 1, q|scalar(@params) = 1|);   # error, A and P defined
944    is($params[0], $x, q|$params[0] = $x|);           # self
945    is($x->is_nan(), 1, q|$x->is_nan() = 1|);         # and must be NaN
946
947    ${"$mbi\::accuracy"} = undef;
948    ${"$mbi\::precision"} = 1;
949    @params = $x->_find_round_parameters(1, undef);
950    is(scalar(@params), 1, q|scalar(@params) = 1|);   # error, A and P defined
951    is($params[0], $x, q|$params[0] = $x|);           # self
952    is($x->is_nan(), 1, q|$x->is_nan() = 1|);         # and must be NaN
953
954    ${"$mbi\::precision"} = undef; # reset
955}
956
957###############################################################################
958# test whether bone/bzero take additional A & P, or reset it etc
959
960foreach my $class ($mbi, $mbf) {
961    $x = $class->new(2)->bzero();
962    is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{accuracy}|);
963    is($x->{precision}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{precision}|);
964
965    $x = $class->new(2)->bone();
966    is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bone(); \$x->{accuracy}|);
967    is($x->{precision}, undef, qq|\$x = $class->new(2)->bone(); \$x->{precision}|);
968
969    $x = $class->new(2)->binf();
970    is($x->{accuracy}, undef, qq|\$x = $class->new(2)->binf(); \$x->{accuracy}|);
971    is($x->{precision}, undef, qq|\$x = $class->new(2)->binf(); \$x->{precision}|);
972
973    $x = $class->new(2)->bnan();
974    is($x->{accuracy}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{accuracy}|);
975    is($x->{precision}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{precision}|);
976
977    note "Verify that bnan() does not delete/undefine accuracy and precision.";
978
979    $x = $class->new(2);
980    $x->{accuracy} = 1;
981    $x->bnan();
982    is($x->{accuracy}, 1, qq|\$x = $class->new(2); \$x->{accuracy} = 1; \$x->bnan(); \$x->{accuracy}|);
983
984    $x = $class->new(2);
985    $x->{precision} = 1;
986    $x->bnan();
987    is($x->{precision}, 1, qq|\$x = $class->new(2); \$x->{precision} = 1; \$x->bnan(); \$x->{precision}|);
988
989    note "Verify that binf() does not delete/undefine accuracy and precision.";
990
991    $x = $class->new(2);
992    $x->{accuracy} = 1;
993    $x->binf();
994    is($x->{accuracy}, 1, qq|\$x = $class->new(2); \$x->{accuracy} = 1; \$x->binf(); \$x->{accuracy}|);
995
996    $x = $class->new(2);
997    $x->{precision} = 1;
998    $x->binf();
999    is($x->{precision}, 1, qq|\$x = $class->new(2); \$x->{precision} = 1; \$x->binf(); \$x->{precision}|);
1000
1001    note "Verify that accuracy can be set as argument to new().";
1002
1003    $x = $class->new(2, 1);
1004    is($x->{accuracy}, 1,     qq|\$x = $class->new(2, 1); \$x->{accuracy}|);
1005    is($x->{precision}, undef, qq|\$x = $class->new(2, 1); \$x->{precision}|);
1006
1007    note "Verify that precision can be set as argument to new().";
1008
1009    $x = $class->new(2, undef, 1);
1010    is($x->{accuracy}, undef, qq|\$x = $class->new(2, undef, 1); \$x->{accuracy}|);
1011    is($x->{precision}, 1,     qq|\$x = $class->new(2, undef, 1); \$x->{precision}|);
1012
1013    note "Verify that accuracy set with new() is preserved after calling bzero().";
1014
1015    $x = $class->new(2, 1)->bzero();
1016    is($x->{accuracy}, 1,     qq|\$x = $class->new(2, 1)->bzero(); \$x->{accuracy}|);
1017    is($x->{precision}, undef, qq|\$x = $class->new(2, 1)->bzero(); \$x->{precision}|);
1018
1019    note "Verify that precision set with new() is preserved after calling bzero().";
1020
1021    $x = $class->new(2, undef, 1)->bzero();
1022    is($x->{accuracy}, undef, qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{accuracy}|);
1023    is($x->{precision}, 1,     qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{precision}|);
1024
1025    note "Verify that accuracy set with new() is preserved after calling bone().";
1026
1027    $x = $class->new(2, 1)->bone();
1028    is($x->{accuracy}, 1,     qq|\$x = $class->new(2, 1)->bone(); \$x->{accuracy}|);
1029    is($x->{precision}, undef, qq|\$x = $class->new(2, 1)->bone(); \$x->{precision}|);
1030
1031    note "Verify that precision set with new() is preserved after calling bone().";
1032
1033    $x = $class->new(2, undef, 1)->bone();
1034    is($x->{accuracy}, undef, qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{accuracy}|);
1035    is($x->{precision}, 1,     qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{precision}|);
1036
1037    note "Verify that accuracy can be set with instance method bone('+').";
1038
1039    $x = $class->new(2);
1040    $x->bone('+', 2, undef);
1041    is($x->{accuracy}, 2,     qq|\$x = $class->new(2); \$x->{accuracy}|);
1042    is($x->{precision}, undef, qq|\$x = $class->new(2); \$x->{precision}|);
1043
1044    note "Verify that precision can be set with instance method bone('+').";
1045
1046    $x = $class->new(2);
1047    $x->bone('+', undef, 2);
1048    is($x->{accuracy}, undef, qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{accuracy}|);
1049    is($x->{precision}, 2,     qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{precision}|);
1050
1051    note "Verify that accuracy can be set with instance method bone('-').";
1052
1053    $x = $class->new(2);
1054    $x->bone('-', 2, undef);
1055    is($x->{accuracy}, 2,     qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{accuracy}|);
1056    is($x->{precision}, undef, qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{precision}|);
1057
1058    note "Verify that precision can be set with instance method bone('-').";
1059
1060    $x = $class->new(2);
1061    $x->bone('-', undef, 2);
1062    is($x->{accuracy}, undef, qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{accuracy}|);
1063    is($x->{precision}, 2,     qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{precision}|);
1064
1065    note "Verify that accuracy can be set with instance method bzero().";
1066
1067    $x = $class->new(2);
1068    $x->bzero(2, undef);
1069    is($x->{accuracy}, 2,     qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{accuracy}|);
1070    is($x->{precision}, undef, qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{precision}|);
1071
1072    note "Verify that precision can be set with instance method bzero().";
1073
1074    $x = $class->new(2);
1075    $x->bzero(undef, 2);
1076    is($x->{accuracy}, undef, qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{accuracy}|);
1077    is($x->{precision}, 2,     qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{precision}|);
1078}
1079
1080###############################################################################
1081# test whether bone/bzero honour class variables
1082
1083for my $class ($mbi, $mbf) {
1084
1085    note "Verify that class accuracy is copied into new objects.";
1086
1087    $class->accuracy(3);                # set
1088
1089    $x = $class->bzero();
1090    is($x->accuracy(), 3,
1091       qq|$class->accuracy(3); \$x = $class->bzero(); \$x->accuracy()|);
1092
1093    $x = $class->bone();
1094    is($x->accuracy(), 3,
1095       qq|$class->accuracy(3); \$x = $class->bone(); \$x->accuracy()|);
1096
1097    $x = $class->new(2);
1098    is($x->accuracy(), 3,
1099       qq|$class->accuracy(3); \$x = $class->new(2); \$x->accuracy()|);
1100
1101    $class->accuracy(undef);            # reset
1102
1103    note "Verify that class precision is copied into new objects.";
1104
1105    $class->precision(-4);              # set
1106
1107    $x = $class->bzero();
1108    is($x->precision(), -4,
1109       qq|$class->precision(-4); \$x = $class->bzero(); \$x->precision()|);
1110
1111    $x = $class->bone();
1112    is($x->precision(), -4,
1113       qq|$class->precision(-4); \$x = $class->bone(); \$x->precision()|);
1114
1115    $x = $class->new(2);
1116    is($x->precision(), -4,
1117       qq|$class->precision(-4); \$x = $class->new(2); \$x->precision()|);
1118
1119    $class->precision(undef);           # reset
1120
1121    note "Verify that setting accuracy as method argument overrides class variable";
1122
1123    $class->accuracy(2);                # set
1124
1125    $x = $class->bzero(5);
1126    is($x->accuracy(), 5,
1127       qq|$class->accuracy(2); \$x = $class->bzero(5); \$x->accuracy()|);
1128
1129    SKIP: {
1130          skip 1, "this won't work until we have a better OO implementation";
1131
1132          $x = $class->bzero(undef);
1133          is($x->accuracy(), undef,
1134             qq|$class->accuracy(2); \$x = $class->bzero(undef); \$x->accuracy()|);
1135      }
1136
1137    $x = $class->bone("+", 5);
1138    is($x->accuracy(), 5,
1139       qq|$class->accuracy(2); \$x = $class->bone("+", 5); \$x->accuracy()|);
1140
1141    SKIP: {
1142          skip 1, "this won't work until we have a better OO implementation";
1143
1144          $x = $class->bone("+", undef);
1145          is($x->accuracy(), undef,
1146             qq|$class->accuracy(2); \$x = $class->bone("+", undef); \$x->accuracy()|);
1147      }
1148
1149    $x = $class->new(2, 5);
1150    is($x->accuracy(), 5,
1151       qq|$class->accuracy(2); \$x = $class->new(2, 5); \$x->accuracy()|);
1152
1153    SKIP: {
1154          skip 1, "this won't work until we have a better OO implementation";
1155
1156          $x = $class->new(2, undef);
1157          is($x->accuracy(), undef,
1158             qq|$class->accuracy(2); \$x = $class->new(2, undef); \$x->accuracy()|);
1159      }
1160
1161    $class->accuracy(undef);            # reset
1162
1163    note "Verify that setting precision as method argument overrides class variable";
1164
1165    $class->precision(-2);              # set
1166
1167    $x = $class->bzero(undef, -6);
1168    is($x->precision(), -6,
1169       qq|$class->precision(-2); \$x = $class->bzero(undef, -6); \$x->precision()|);
1170
1171    SKIP: {
1172          skip 1, "this won't work until we have a better OO implementation";
1173
1174          $x = $class->bzero(undef, undef);
1175          is($x->precision(), undef,
1176             qq|$class->precision(-2); \$x = $class->bzero(undef, undef); \$x->precision()|);
1177      }
1178
1179    $x = $class->bone("+", undef, -6);
1180    is($x->precision(), -6,
1181       qq|$class->precision(-2); \$x = $class->bone("+", undef, -6); \$x->precision()|);
1182
1183    SKIP: {
1184          skip 1, "this won't work until we have a better OO implementation";
1185
1186          $x = $class->bone("+", undef, undef);
1187          is($x->precision(), undef,
1188             qq|$class->precision(-2); \$x = $class->bone("+", undef, undef); \$x->precision()|);
1189      }
1190
1191    $x = $class->new(2, undef, -6);
1192    is($x->precision(), -6,
1193       qq|$class->precision(-2); \$x = $class->new(2, undef, -6); \$x->precision()|);
1194
1195    SKIP: {
1196          skip 1, "this won't work until we have a better OO implementation";
1197
1198          $x = $class->new(2, undef, undef);
1199          is($x->precision(), undef,
1200             qq|$class->precision(-2); \$x = $class->new(2, undef, undef); \$x->precision()|);
1201      }
1202
1203    $class->precision(undef);           # reset
1204}
1205
1206###############################################################################
1207# check whether mixing A and P creates a NaN
1208
1209# new with set accuracy/precision and with parameters
1210{
1211    no strict 'refs';
1212    foreach my $class ($mbi, $mbf) {
1213        is($class->new(123, 4, -3), 'NaN',      # with parameters
1214           "mixing A and P creates a NaN");
1215        ${"$class\::accuracy"} = 42;
1216        ${"$class\::precision"} = 2;
1217        is($class->new(123), "NaN",             # with globals
1218           q|$class->new(123) = "NaN"|);
1219        ${"$class\::accuracy"} = undef;
1220        ${"$class\::precision"} = undef;
1221    }
1222}
1223
1224# binary ops
1225foreach my $class ($mbi, $mbf) {
1226    #foreach (qw/add sub mul div pow mod/) {
1227    foreach my $method (qw/add sub mul pow mod/) {
1228        my $try = "my \$x = $class->new(1234); \$x->accuracy(5);";
1229        $try .= " my \$y = $class->new(12); \$y->precision(-3);";
1230        $try .= " \$x->b$method(\$y);";
1231        $rc = eval $try;
1232        is($rc, "NaN", $try);
1233    }
1234}
1235
1236# unary ops
1237foreach my $method (qw/new bsqrt/) {
1238    my $try = "my \$x = $mbi->$method(1234, 5, -3);";
1239    $rc = eval $try;
1240    is($rc, "NaN", $try);
1241}
1242
1243# see if $x->bsub(0) and $x->badd(0) really round
1244foreach my $class ($mbi, $mbf) {
1245    $x = $class->new(123);
1246    $class->accuracy(2);
1247    $x->bsub(0);
1248    is($x, 120, q|$x = 120|);
1249
1250    $class->accuracy(undef);            # reset
1251
1252    $x = $class->new(123);
1253    $class->accuracy(2);
1254    $x->badd(0);
1255    is($x, 120, q|$x = 120|);
1256
1257    $class->accuracy(undef);            # reset
1258}
1259
1260###############################################################################
1261# test whether shortcuts returning zero/one preserve A and P
1262
1263my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args);
1264
1265my $LIB = Math::BigInt->config('lib');
1266
1267while (<DATA>) {
1268    s/#.*$//;                   # remove comments
1269    s/\s+$//;                   # remove trailing whitespace
1270    next unless length;         # skip empty lines
1271
1272    if (s/^&//) {
1273        $f = $_;                # function
1274        next;
1275    }
1276
1277    @args = split(/:/, $_);
1278    my $want = pop(@args);
1279
1280    ($x, $xa, $xp) = split (/,/, $args[0]);
1281    $xa = $xa || '';
1282    $xp = $xp || '';
1283    $try  = qq|\$x = $mbi->new("$x");|;
1284    $try .= qq| \$x->accuracy($xa);|  if $xa ne '';
1285    $try .= qq| \$x->precision($xp);| if $xp ne '';
1286
1287    ($y, $ya, $yp) = split (/,/, $args[1]);
1288    $ya = $ya || '';
1289    $yp = $yp || '';
1290    $try .= qq| \$y = $mbi->new("$y");|;
1291    $try .= qq| \$y->accuracy($ya);|  if $ya ne '';
1292    $try .= qq| \$y->precision($yp);| if $yp ne '';
1293
1294    $try .= ' $x->' . $f . '($y);';
1295
1296    # print "trying $try\n";
1297    $rc = eval $try;
1298    print "# Error: $@\n" if $@;
1299
1300    # convert hex/binary targets to decimal
1301    if ($want =~ /^(0x0x|0b0b)/) {
1302        $want =~ s/^0[xb]//;
1303        $want = $mbi->new($want)->bstr();
1304    }
1305    is($rc, $want, $try);
1306    # check internal state of number objects
1307    is_valid($rc, $f) if ref $rc;
1308
1309    # now check whether A and P are set correctly
1310    # only one of $a or $p will be set (no crossing here)
1311    $a = $xa || $ya;
1312    $p = $xp || $yp;
1313
1314    # print "Check a=$a p=$p\n";
1315    # print "# Tried: '$try'\n";
1316    if ($a ne '') {
1317        unless (is($x->{accuracy}, $a,    qq|\$x->{accuracy} == $a|) &&
1318                is($x->{precision}, undef, qq|\$x->{precision} is undef|))
1319        {
1320            print "# Check: A = $a and P = undef\n";
1321            print "# Tried: $try\n";
1322        }
1323    }
1324    if ($p ne '') {
1325        unless (is($x->{precision}, $p,    qq|\$x->{precision} == $p|) &&
1326                is($x->{accuracy}, undef, qq|\$x->{accuracy} is undef|))
1327        {
1328            print "# Check: A = undef and P = $p\n";
1329            print "# Tried: $try\n";
1330        }
1331    }
1332}
1333
1334# all done
13351;
1336
1337###############################################################################
1338# sub to check validity of a Math::BigInt object internally, to ensure that no
1339# op leaves a number object in an invalid state (f.i. "-0")
1340
1341sub is_valid {
1342    my ($x, $f) = @_;
1343
1344    my $e = 0;                  # error?
1345
1346    # ok as reference?
1347    $e = 'Not a reference' if !ref($x);
1348
1349    # has ok sign?
1350    $e = qq|Illegal sign $x->{sign}|
1351      . q| (expected: "+", "-", "-inf", "+inf" or "NaN")|
1352        if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
1353
1354    $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
1355    $e = $LIB->_check($x->{value}) if $e eq '0';
1356
1357    # test done, see if error did crop up
1358    if ($e eq '0') {
1359        pass('is a valid object');
1360        return;
1361    }
1362
1363    fail($e . qq| after op "$f"|);
1364}
1365
1366# format is:
1367# x,A,P:x,A,P:result
1368# 123,,3 means 123 with precision 3 (A is undef)
1369# the A or P of the result is calculated automatically
1370__DATA__
1371&badd
1372123,,:123,,:246
1373123,3,:0,,:123
1374123,,-3:0,,:123
1375123,,:0,3,:123
1376123,,:0,,-3:123
1377&bmul
1378123,,:1,,:123
1379123,3,:0,,:0
1380123,,-3:0,,:0
1381123,,:0,3,:0
1382123,,:0,,-3:0
1383123,3,:1,,:123
1384123,,-3:1,,:123
1385123,,:1,3,:123
1386123,,:1,,-3:123
13871,3,:123,,:123
13881,,-3:123,,:123
13891,,:123,3,:123
13901,,:123,,-3:123
1391&bdiv
1392123,,:1,,:123
1393123,4,:1,,:123
1394123,,:1,4,:123
1395123,,:1,,-4:123
1396123,,-4:1,,:123
13971,4,:123,,:0
13981,,:123,4,:0
13991,,:123,,-4:0
14001,,-4:123,,:0
1401&band
14021,,:3,,:1
14031234,1,:0,,:0
14041234,,:0,1,:0
14051234,,-1:0,,:0
14061234,,:0,,-1:0
14070xFF,,:0x10,,:0x0x10
14080xFF,2,:0xFF,,:250
14090xFF,,:0xFF,2,:250
14100xFF,,1:0xFF,,:250
14110xFF,,:0xFF,,1:250
1412&bxor
14131,,:3,,:2
14141234,1,:0,,:1000
14151234,,:0,1,:1000
14161234,,3:0,,:1000
14171234,,:0,,3:1000
14180xFF,,:0x10,,:239
1419# 250 ^ 255 => 5
14200xFF,2,:0xFF,,:5
14210xFF,,:0xFF,2,:5
14220xFF,,1:0xFF,,:5
14230xFF,,:0xFF,,1:5
1424# 250 ^ 4095 = 3845 => 3800
14250xFF,2,:0xFFF,,:3800
1426# 255 ^ 4100 = 4347 => 4300
14270xFF,,:0xFFF,2,:4300
14280xFF,,2:0xFFF,,:3800
1429# 255 ^ 4100 = 10fb => 4347 => 4300
14300xFF,,:0xFFF,,2:4300
1431&bior
14321,,:3,,:3
14331234,1,:0,,:1000
14341234,,:0,1,:1000
14351234,,3:0,,:1000
14361234,,:0,,3:1000
14370xFF,,:0x10,,:0x0xFF
1438# FF | FA = FF => 250
1439250,2,:0xFF,,:250
14400xFF,,:250,2,:250
14410xFF,,1:0xFF,,:250
14420xFF,,:0xFF,,1:250
1443&bpow
14442,,:3,,:8
14452,,:0,,:1
14462,2,:0,,:1
14472,,:0,2,:1
1448