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->{_a}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{_a}|);
259
260    $x = $class->bzero();
261    $x->precision(5);
262    is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->precision(5); \$x->{_p}|);
263
264    $x = $class->new(0);
265    $x->accuracy(5);
266    is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->accuracy(5); \$x->{_a}|);
267
268    $x = $class->new(0);
269    $x->precision(5);
270    is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->precision(5); \$x->{_p}|);
271
272    $x = $class->bzero();
273    $x->round(5);
274    is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->round(5); \$x->{_a}|);
275
276    $x = $class->bzero();
277    $x->round(undef, 5);
278    is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->round(undef, 5); \$x->{_p}|);
279
280    $x = $class->new(0);
281    $x->round(5);
282    is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->round(5); \$x->{_a}|);
283
284    $x = $class->new(0);
285    $x->round(undef, 5);
286    is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->round(undef, 5); \$x->{_p}|);
287
288    # see if trying to increasing A in bzero() doesn't do something
289    $x = $class->bzero();
290    $x->{_a} = 3;
291    $x->round(5);
292    is($x->{_a}, 3,
293       qq|\$x = $class->bzero(); \$x->{_a} = 3; \$x->round(5); \$x->{_a}|);
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->{_a} = 5;           # $x->accuracy(5) would round $x straight away
353$y->{_a} = 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->{_a} = 2;
377$z = $z / 2;
378is($z, 62, q|$z = $z / 2|);
379
380$x = $mbf->new(123456);
381$x->{_a} = 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->{_a} = 5;           # $x->accuracy(5) would round $x straight away
389$y->{_a} = 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->{_a} = 2;
413$z = $z / 2;
414is($z, 62000, q|$z = $z / 2|);
415
416$x = $mbi->new(123400);
417$x->{_a} = 4;
418is($x->bnot(), -123400, q|$x->bnot()|);         # not -1234001
419
420# both babs() and bneg() don't need to round, since the input will already
421# be rounded (either as $x or via new($string)), and they don't change the
422# value. The two tests below peek at this by using _a (illegally) directly
423
424$x = $mbi->new(-123401);
425$x->{_a} = 4;
426is($x->babs(), 123401, q|$x->babs()|);
427
428$x = $mbi->new(-123401);
429$x->{_a} = 4;
430is($x->bneg(), 123401, q|$x->bneg()|);
431
432# test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
433
434$mbf->round_mode('even');
435$x = $mbf->new('740.7')->bdiv('6', 4, undef, 'zero');
436is($x, '123.4', q|$x|);
437
438$x = $mbi->new('123456');
439$y = $mbi->new('123456');
440$y->{_a} = 6;
441is($x->bdiv($y), 1, q|$x->bdiv($y)|);
442is($x->{_a}, 6, q|$x->{_a}|);                   # carried over
443
444$x = $mbi->new('123456');
445$y = $mbi->new('123456');
446$x->{_a} = 6;
447is($x->bdiv($y), 1, q|$x->bdiv($y)|);
448is($x->{_a}, 6, q|$x->{_a}|);                   # carried over
449
450$x = $mbi->new('123456');
451$y = $mbi->new('223456');
452$y->{_a} = 6;
453is($x->bdiv($y), 0, q|$x->bdiv($y)|);
454is($x->{_a}, 6, q|$x->{_a}|);                   # carried over
455
456$x = $mbi->new('123456');
457$y = $mbi->new('223456');
458$x->{_a} = 6;
459is($x->bdiv($y), 0, q|$x->bdiv($y)|);
460is($x->{_a}, 6, q|$x->{_a}|);                   # carried over
461
462###############################################################################
463# test that bop(0) does the same than bop(undef)
464
465$x = $mbf->new('1234567890');
466is($x->copy()->bsqrt(0), $x->copy()->bsqrt(undef),
467   q|$x->copy()->bsqrt(...)|);
468is($x->copy->bsqrt(0), '35136.41828644462161665823116758077037159',
469   q|$x->copy->bsqrt(...)|);
470
471is($x->{_a}, undef, q|$x->{_a}|);
472
473# test that bsqrt() modifies $x and does not just return something else
474# (especially under Math::BigInt::BareCalc)
475$z = $x->bsqrt();
476is($z, $x, q|$z = $x->bsqrt(); $z|);
477is($x, '35136.41828644462161665823116758077037159', q|$z = $x->bsqrt(); $x|);
478
479$x = $mbf->new('1.234567890123456789');
480
481is($x->copy()->bpow('0.5', 0),
482   $x->copy()->bpow('0.5', undef),
483   q|$x->copy()->bpow(...)|);
484
485is($x->copy()->bpow('0.5', 0),
486   $x->copy()->bsqrt(undef),
487   q|$x->copy()->bpow(...) vs. $x->copy()->bsqrt(...)|);
488
489is($x->copy()->bpow('2', 0), '1.524157875323883675019051998750190521',
490   q|$x->copy()->bpow('2', 0)|);
491
492###############################################################################
493# test (also under Bare) that bfac() rounds at last step
494
495is($mbi->new(12)->bfac(),  '479001600', q|$mbi->new(12)->bfac()|);
496is($mbi->new(12)->bfac(2), '480000000', q|$mbi->new(12)->bfac(2)|);
497
498$x = $mbi->new(12);
499$x->accuracy(2);
500is($x->bfac(), '480000000',
501   qq|\$x = $mbi->new(12); \$x->accuracy(2); \$x->bfac()|);
502
503$x = $mbi->new(13);
504$x->accuracy(2);
505is($x->bfac(), '6200000000',
506   qq|\$x = $mbi->new(13); \$x->accuracy(2); \$x->bfac()|);
507
508$x = $mbi->new(13);
509$x->accuracy(3);
510is($x->bfac(), '6230000000',
511   qq|\$x = $mbi->new(13); \$x->accuracy(3); \$x->bfac()|);
512
513$x = $mbi->new(13);
514$x->accuracy(4);
515is($x->bfac(), '6227000000',
516   qq|\$x = $mbi->new(13); \$x->accuracy(4); \$x->bfac()|);
517
518# this does 1, 2, 3...9, 10, 11, 12...20
519$x = $mbi->new(20);
520$x->accuracy(1);
521is($x->bfac(), '2000000000000000000',
522   qq|\$x = $mbi->new(20); \$x->accuracy(1); \$x->bfac()|);
523
524###############################################################################
525# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
526
527$x = $mbi->new('123456')->bsqrt(2, undef);
528is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351
529
530$x = $mbi->new('3')->bsqrt(2, undef);
531is($x->accuracy(), 2, q|$x->accuracy()|);
532
533$mbi->round_mode('even');
534$x = $mbi->new('126025')->bsqrt(2, undef, '+inf');
535is($x, '360', q|$x = 360|);     # not 355 nor 350
536
537$x = $mbi->new('126025')->bsqrt(undef, 2);
538is($x, '400', q|$x = 400|);      # not 355
539
540###############################################################################
541# test mixed arguments
542
543$x = $mbf->new(10);
544$u = $mbf->new(2.5);
545$y = $mbi->new(2);
546
547$z = $x + $y;
548is($z, 12, q|$z = $x + $y;|);
549is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
550
551$z = $x / $y;
552is($z, 5, q|$z = $x / $y;|);
553is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
554
555$z = $u * $y;
556is($z, 5, q|$z = $u * $y;|);
557is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
558
559$y = $mbi->new(12345);
560$z = $u->copy()->bmul($y, 2, undef, 'odd');
561is($z, 31000, q|$z = 31000|);
562
563$z = $u->copy()->bmul($y, 3, undef, 'odd');
564is($z, 30900, q|$z = 30900|);
565
566$z = $u->copy()->bmul($y, undef, 0, 'odd');
567is($z, 30863, q|$z = 30863|);
568
569$z = $u->copy()->bmul($y, undef, 1, 'odd');
570is($z, 30863, q|$z = 30863|);
571
572$z = $u->copy()->bmul($y, undef, 2, 'odd');
573is($z, 30860, q|$z = 30860|);
574
575$z = $u->copy()->bmul($y, undef, 3, 'odd');
576is($z, 30900, q|$z = 30900|);
577
578$z = $u->copy()->bmul($y, undef, -1, 'odd');
579is($z, 30862.5, q|$z = 30862.5|);
580
581my $warn = '';
582$SIG{__WARN__} = sub { $warn = shift; };
583
584# These should no longer warn, even though '3.17' is a NaN in Math::BigInt
585# (>= returns now false, bug until v1.80).
586
587$warn = '';
588eval '$z = 3.17 <= $y';
589is($z, '', q|$z = ""|);
590unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/,
591       q|"$z = $y >= 3.17" gives warning as expected|);
592
593$warn = '';
594eval '$z = $y >= 3.17';
595is($z, '', q|$z = ""|);
596unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/,
597      q|"$z = $y >= 3.17" gives warning as expected|);
598
599# XXX TODO breakage:
600#
601# $z = $y->copy()->bmul($u, 2, 0, 'odd');
602# is($z, 31000);
603#
604# $z = $y * $u;
605# is($z, 5);
606# is(ref($z), $mbi, q|\$z is a $mbi object|);
607#
608# $z = $y + $x;
609# is($z, 12);
610# is(ref($z), $mbi, q|\$z is a $mbi object|);
611#
612# $z = $y / $x;
613# is($z, 0);
614# is(ref($z), $mbi, q|\$z is a $mbi object|);
615
616###############################################################################
617# rounding in bdiv with fallback and already set A or P
618
619{
620    no strict 'refs';
621    ${"$mbf\::accuracy"}  = undef;
622    ${"$mbf\::precision"} = undef;
623    ${"$mbf\::div_scale"} = 40;
624}
625
626$x = $mbf->new(10);
627$x->{_a} = 4;
628is($x->bdiv(3), '3.333', q|$x->bdiv(3)|);
629is($x->{_a}, 4, q|$x->{_a}|);                # set's it since no fallback
630
631$x = $mbf->new(10);
632$x->{_a} = 4;
633$y = $mbf->new(3);
634is($x->bdiv($y), '3.333', q|$x->bdiv($y)|);
635is($x->{_a}, 4, q|$x->{_a}|);                   # set's it since no fallback
636
637# rounding to P of x
638$x = $mbf->new(10);
639$x->{_p} = -2;
640is($x->bdiv(3), '3.33', q|$x->bdiv(3)|);
641
642# round in div with requested P
643$x = $mbf->new(10);
644is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|);
645
646# round in div with requested P greater than fallback
647{
648    no strict 'refs';
649    ${"$mbf\::div_scale"} = 5;
650    $x = $mbf->new(10);
651    is($x->bdiv(3, undef, -8), "3.33333333",
652       q|$x->bdiv(3, undef, -8) = "3.33333333"|);
653    ${"$mbf\::div_scale"} = 40;
654}
655
656$x = $mbf->new(10);
657$y = $mbf->new(3);
658$y->{_a} = 4;
659is($x->bdiv($y), '3.333', q|$x->bdiv($y) = '3.333'|);
660is($x->{_a}, 4, q|$x->{_a} = 4|);
661is($y->{_a}, 4, q|$y->{_a} = 4|);       # set's it since no fallback
662is($x->{_p}, undef, q|$x->{_p} = undef|);
663is($y->{_p}, undef, q|$y->{_p} = undef|);
664
665# rounding to P of y
666$x = $mbf->new(10);
667$y = $mbf->new(3);
668$y->{_p} = -2;
669is($x->bdiv($y), '3.33', q|$x->bdiv($y) = '3.33'|);
670is($x->{_p}, -2, q|$x->{_p} = -2|);
671 is($y->{_p}, -2, q|$y->{_p} = -2|);
672is($x->{_a}, undef, q|$x->{_a} = undef|);
673is($y->{_a}, undef, q|$y->{_a} = undef|);
674
675###############################################################################
676# test whether bround(-n) fails in MBF (undocumented in MBI)
677eval { $x = $mbf->new(1);
678       $x->bround(-2);
679     };
680like($@, qr/^bround\(\) needs positive accuracy/,
681    qq|"\$x->bround(-2)" gives warning as expected|);
682
683note("test whether rounding to higher accuracy is no-op");
684
685$x = $mbf->new(1);
686$x->{_a} = 4;
687is($x, "1.000", q|$x = "1.000"|);
688$x->bround(6);                  # must be no-op
689is($x->{_a}, 4, q|$x->{_a} = 4|);
690is($x, "1.000", q|$x = "1.000"|);
691
692$x = $mbi->new(1230);
693$x->{_a} = 3;
694is($x, "1230", q|$x = "1230"|);
695$x->bround(6);                  # must be no-op
696is($x->{_a}, 3, q|$x->{_a} = 3|);
697is($x, "1230", q|$x = "1230"|);
698
699note("bround(n) should set _a");
700
701$x->bround(2);                  # smaller works
702is($x, "1200", q|$x = "1200"|);
703is($x->{_a}, 2, q|$x->{_a} = 2|);
704
705# bround(-n) is undocumented and only used by MBF
706
707note("bround(-n) should set _a");
708
709$x = $mbi->new(12345);
710$x->bround(-1);
711is($x, "12300", q|$x = "12300"|);
712is($x->{_a}, 4, q|$x->{_a} = 4|);
713
714note("bround(-n) should set _a");
715
716$x = $mbi->new(12345);
717$x->bround(-2);
718is($x, "12000", q|$x = "12000"|);
719is($x->{_a}, 3, q|$x->{_a} = 3|);
720
721note("bround(-n) should set _a");
722
723$x = $mbi->new(12345);
724$x->{_a} = 5;
725$x->bround(-3);
726is($x, "10000", q|$x = "10000"|);
727is($x->{_a}, 2, q|$x->{_a} = 2|);
728
729note("bround(-n) should set _a");
730
731$x = $mbi->new(12345);
732$x->{_a} = 5;
733$x->bround(-4);
734is($x, "0", q|$x = "0"|);
735is($x->{_a}, 1, q|$x->{_a} = 1|);
736
737note("bround(-n) should be no-op if n too big");
738
739$x = $mbi->new(12345);
740$x->bround(-5);
741is($x, "0", q|$x = "0"|);               # scale to "big" => 0
742is($x->{_a}, 0, q|$x->{_a} = 0|);
743
744note("bround(-n) should be no-op if n too big");
745
746$x = $mbi->new(54321);
747$x->bround(-5);
748is($x, "100000", q|$x = "100000"|);     # used by MBF to round 0.0054321 at 0.0_6_00000
749is($x->{_a}, 0, q|$x->{_a} = 0|);
750
751note("bround(-n) should be no-op if n too big");
752
753$x = $mbi->new(54321);
754$x->{_a} = 5;
755$x->bround(-6);
756is($x, "100000", q|$x = "100000"|);     # no-op
757is($x->{_a}, 0, q|$x->{_a} = 0|);
758
759note("bround(n) should set _a");
760
761$x = $mbi->new(12345);
762$x->{_a} = 5;
763$x->bround(5);                          # must be no-op
764is($x, "12345", q|$x = "12345"|);
765is($x->{_a}, 5, q|$x->{_a} = 5|);
766
767note("bround(n) should set _a");
768
769$x = $mbi->new(12345);
770$x->{_a} = 5;
771$x->bround(6);                          # must be no-op
772is($x, "12345", q|$x = "12345"|);
773
774$x = $mbf->new("0.0061");
775$x->bfround(-2);
776is($x, "0.01", q|$x = "0.01"|);
777$x = $mbf->new("0.004");
778$x->bfround(-2);
779is($x, "0.00", q|$x = "0.00"|);
780$x = $mbf->new("0.005");
781$x->bfround(-2);
782is($x, "0.00", q|$x = "0.00"|);
783
784$x = $mbf->new("12345");
785$x->bfround(2);
786is($x, "12340", q|$x = "12340"|);
787$x = $mbf->new("12340");
788$x->bfround(2);
789is($x, "12340", q|$x = "12340"|);
790
791note("MBI::bfround should clear A for negative P");
792
793$x = $mbi->new("1234");
794$x->accuracy(3);
795$x->bfround(-2);
796is($x->{_a}, undef, q|$x->{_a} = undef|);
797
798note("test that bfround() and bround() work with large numbers");
799
800$x = $mbf->new(1)->bdiv(5678, undef, -63);
801is($x, "0.000176118351532229658330398027474462839027826699542092286016203",
802   q|$x = "0.000176118351532229658330398027474462839027826699542092286016203"|);
803
804$x = $mbf->new(1)->bdiv(5678, undef, -90);
805is($x, "0.00017611835153222965833039802747446283902782"
806     . "6699542092286016202888340965128566396618527651",
807   q|$x = "0.00017611835153222965833039802747446283902782|
808       . q|6699542092286016202888340965128566396618527651"|);
809
810$x = $mbf->new(1)->bdiv(5678, 80);
811is($x, "0.00017611835153222965833039802747446283902782"
812     . "669954209228601620288834096512856639662",
813   q|$x = "0.00017611835153222965833039802747446283902782|
814       . q|669954209228601620288834096512856639662"|);
815
816###############################################################################
817
818note("rounding with already set precision/accuracy");
819
820$x = $mbf->new(1);
821$x->{_p} = -5;
822is($x, "1.00000", q|$x = "1.00000"|);
823
824note("further rounding down");
825
826is($x->bfround(-2), "1.00", q|$x->bfround(-2) = "1.00"|);
827is($x->{_p}, -2, q|$x->{_p} = -2|);
828
829$x = $mbf->new(12345);
830$x->{_a} = 5;
831is($x->bround(2), "12000", q|$x->bround(2) = "12000"|);
832is($x->{_a}, 2, q|$x->{_a} = 2|);
833
834$x = $mbf->new("1.2345");
835$x->{_a} = 5;
836is($x->bround(2), "1.2", q|$x->bround(2) = "1.2"|);
837is($x->{_a}, 2, q|$x->{_a} = 2|);
838
839note("mantissa/exponent format and A/P");
840
841$x = $mbf->new("12345.678");
842$x->accuracy(4);
843is($x, "12350", q|$x = "12350"|);
844is($x->{_a}, 4, q|$x->{_a} = 4|);
845is($x->{_p}, undef, q|$x->{_p} = undef|);
846
847#is($x->{_m}->{_a}, undef, q|$x->{_m}->{_a} = undef|);
848#is($x->{_e}->{_a}, undef, q|$x->{_e}->{_a} = undef|);
849#is($x->{_m}->{_p}, undef, q|$x->{_m}->{_p} = undef|);
850#is($x->{_e}->{_p}, undef, q|$x->{_e}->{_p} = undef|);
851
852note("check for no A/P in case of fallback result");
853
854$x = $mbf->new(100) / 3;
855is($x->{_a}, undef, q|$x->{_a} = undef|);
856is($x->{_p}, undef, q|$x->{_p} = undef|);
857
858note("result & remainder");
859
860$x = $mbf->new(100) / 3;
861($x, $y) = $x->bdiv(3);
862is($x->{_a}, undef, q|$x->{_a} = undef|);
863is($x->{_p}, undef, q|$x->{_p} = undef|);
864is($y->{_a}, undef, q|$y->{_a} = undef|);
865is($y->{_p}, undef, q|$y->{_p} = undef|);
866
867###############################################################################
868# math with two numbers with different A and P
869
870$x = $mbf->new(12345);
871$x->accuracy(4); # "12340"
872$y = $mbf->new(12345);
873$y->accuracy(2); # "12000"
874is($x+$y, 24000, q|$x+$y = 24000|);     # 12340+12000=> 24340 => 24000
875
876$x = $mbf->new(54321);
877$x->accuracy(4); # "12340"
878$y = $mbf->new(12345);
879$y->accuracy(3); # "12000"
880is($x-$y, 42000, q|$x-$y = 42000|);     # 54320+12300=> 42020 => 42000
881
882$x = $mbf->new("1.2345");
883$x->precision(-2); # "1.23"
884$y = $mbf->new("1.2345");
885$y->precision(-4); # "1.2345"
886is($x+$y, "2.46", q|$x+$y = "2.46"|);   # 1.2345+1.2300=> 2.4645 => 2.46
887
888###############################################################################
889# round should find and use proper class
890
891#$x = Foo->new();
892#is($x->round($Foo::accuracy), "a" x $Foo::accuracy);
893#is($x->round(undef, $Foo::precision), "p" x $Foo::precision);
894#is($x->bfround($Foo::precision), "p" x $Foo::precision);
895#is($x->bround($Foo::accuracy), "a" x $Foo::accuracy);
896
897###############################################################################
898# find out whether _find_round_parameters is doing what's it's supposed to do
899
900{
901    no strict 'refs';
902    ${"$mbi\::accuracy"} = undef;
903    ${"$mbi\::precision"} = undef;
904    ${"$mbi\::div_scale"} = 40;
905    ${"$mbi\::round_mode"} = 'odd';
906}
907
908$x = $mbi->new(123);
909my @params = $x->_find_round_parameters();
910is(scalar(@params), 1, q|scalar(@params) = 1|);       # nothing to round
911
912@params = $x->_find_round_parameters(1);
913is(scalar(@params), 4, q|scalar(@params) = 4|);       # a=1
914is($params[0], $x, q|$params[0] = $x|);               # self
915is($params[1], 1, q|$params[1] = 1|);                 # a
916is($params[2], undef, q|$params[2] = undef|);         # p
917is($params[3], "odd", q|$params[3] = "odd"|);         # round_mode
918
919@params = $x->_find_round_parameters(undef, 2);
920is(scalar(@params), 4, q|scalar(@params) = 4|);       # p=2
921is($params[0], $x, q|$params[0] = $x|);               # self
922is($params[1], undef, q|$params[1] = undef|);         # a
923is($params[2], 2, q|$params[2] = 2|);                 # p
924is($params[3], "odd", q|$params[3] = "odd"|);         # round_mode
925
926eval { @params = $x->_find_round_parameters(undef, 2, "foo"); };
927like($@, qr/^Unknown round mode 'foo'/,
928    q|round mode "foo" gives a warning as expected|);
929
930@params = $x->_find_round_parameters(undef, 2, "+inf");
931is(scalar(@params), 4, q|scalar(@params) = 4|);       # p=2
932is($params[0], $x, q|$params[0] = $x|);               # self
933is($params[1], undef, q|$params[1] = undef|);         # a
934is($params[2], 2, q|$params[2] = 2|);                 # p
935is($params[3], "+inf", q|$params[3] = "+inf"|);       # round_mode
936
937@params = $x->_find_round_parameters(2, -2, "+inf");
938is(scalar(@params), 1, q|scalar(@params) = 1|);       # error, A and P defined
939is($params[0], $x, q|$params[0] = $x|);               # self
940
941{
942    no strict 'refs';
943    ${"$mbi\::accuracy"} = 1;
944    @params = $x->_find_round_parameters(undef, -2);
945    is(scalar(@params), 1, q|scalar(@params) = 1|);   # error, A and P defined
946    is($params[0], $x, q|$params[0] = $x|);           # self
947    is($x->is_nan(), 1, q|$x->is_nan() = 1|);         # and must be NaN
948
949    ${"$mbi\::accuracy"} = undef;
950    ${"$mbi\::precision"} = 1;
951    @params = $x->_find_round_parameters(1, undef);
952    is(scalar(@params), 1, q|scalar(@params) = 1|);   # error, A and P defined
953    is($params[0], $x, q|$params[0] = $x|);           # self
954    is($x->is_nan(), 1, q|$x->is_nan() = 1|);         # and must be NaN
955
956    ${"$mbi\::precision"} = undef; # reset
957}
958
959###############################################################################
960# test whether bone/bzero take additional A & P, or reset it etc
961
962foreach my $class ($mbi, $mbf) {
963    $x = $class->new(2)->bzero();
964    is($x->{_a}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{_a}|);
965    is($x->{_p}, undef, qq|\$x = $class->new(2)->bzero(); \$x->{_p}|);
966
967    $x = $class->new(2)->bone();
968    is($x->{_a}, undef, qq|\$x = $class->new(2)->bone(); \$x->{_a}|);
969    is($x->{_p}, undef, qq|\$x = $class->new(2)->bone(); \$x->{_p}|);
970
971    $x = $class->new(2)->binf();
972    is($x->{_a}, undef, qq|\$x = $class->new(2)->binf(); \$x->{_a}|);
973    is($x->{_p}, undef, qq|\$x = $class->new(2)->binf(); \$x->{_p}|);
974
975    $x = $class->new(2)->bnan();
976    is($x->{_a}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{_a}|);
977    is($x->{_p}, undef, qq|\$x = $class->new(2)->bnan(); \$x->{_p}|);
978
979    note "Verify that bnan() does not delete/undefine accuracy and precision.";
980
981    $x = $class->new(2);
982    $x->{_a} = 1;
983    $x->bnan();
984    is($x->{_a}, 1, qq|\$x = $class->new(2); \$x->{_a} = 1; \$x->bnan(); \$x->{_a}|);
985
986    $x = $class->new(2);
987    $x->{_p} = 1;
988    $x->bnan();
989    is($x->{_p}, 1, qq|\$x = $class->new(2); \$x->{_p} = 1; \$x->bnan(); \$x->{_p}|);
990
991    note "Verify that binf() does not delete/undefine accuracy and precision.";
992
993    $x = $class->new(2);
994    $x->{_a} = 1;
995    $x->binf();
996    is($x->{_a}, 1, qq|\$x = $class->new(2); \$x->{_a} = 1; \$x->binf(); \$x->{_a}|);
997
998    $x = $class->new(2);
999    $x->{_p} = 1;
1000    $x->binf();
1001    is($x->{_p}, 1, qq|\$x = $class->new(2); \$x->{_p} = 1; \$x->binf(); \$x->{_p}|);
1002
1003    note "Verify that accuracy can be set as argument to new().";
1004
1005    $x = $class->new(2, 1);
1006    is($x->{_a}, 1,     qq|\$x = $class->new(2, 1); \$x->{_a}|);
1007    is($x->{_p}, undef, qq|\$x = $class->new(2, 1); \$x->{_p}|);
1008
1009    note "Verify that precision can be set as argument to new().";
1010
1011    $x = $class->new(2, undef, 1);
1012    is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1); \$x->{_a}|);
1013    is($x->{_p}, 1,     qq|\$x = $class->new(2, undef, 1); \$x->{_p}|);
1014
1015    note "Verify that accuracy set with new() is preserved after calling bzero().";
1016
1017    $x = $class->new(2, 1)->bzero();
1018    is($x->{_a}, 1,     qq|\$x = $class->new(2, 1)->bzero(); \$x->{_a}|);
1019    is($x->{_p}, undef, qq|\$x = $class->new(2, 1)->bzero(); \$x->{_p}|);
1020
1021    note "Verify that precision set with new() is preserved after calling bzero().";
1022
1023    $x = $class->new(2, undef, 1)->bzero();
1024    is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{_a}|);
1025    is($x->{_p}, 1,     qq|\$x = $class->new(2, undef, 1)->bzero(); \$x->{_p}|);
1026
1027    note "Verify that accuracy set with new() is preserved after calling bone().";
1028
1029    $x = $class->new(2, 1)->bone();
1030    is($x->{_a}, 1,     qq|\$x = $class->new(2, 1)->bone(); \$x->{_a}|);
1031    is($x->{_p}, undef, qq|\$x = $class->new(2, 1)->bone(); \$x->{_p}|);
1032
1033    note "Verify that precision set with new() is preserved after calling bone().";
1034
1035    $x = $class->new(2, undef, 1)->bone();
1036    is($x->{_a}, undef, qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{_a}|);
1037    is($x->{_p}, 1,     qq|\$x = $class->new(2, undef, 1)->bone(); \$x->{_p}|);
1038
1039    note "Verify that accuracy can be set with instance method bone('+').";
1040
1041    $x = $class->new(2);
1042    $x->bone('+', 2, undef);
1043    is($x->{_a}, 2,     qq|\$x = $class->new(2); \$x->{_a}|);
1044    is($x->{_p}, undef, qq|\$x = $class->new(2); \$x->{_p}|);
1045
1046    note "Verify that precision can be set with instance method bone('+').";
1047
1048    $x = $class->new(2);
1049    $x->bone('+', undef, 2);
1050    is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{_a}|);
1051    is($x->{_p}, 2,     qq|\$x = $class->new(2); \$x->bone('+', undef, 2); \$x->{_p}|);
1052
1053    note "Verify that accuracy can be set with instance method bone('-').";
1054
1055    $x = $class->new(2);
1056    $x->bone('-', 2, undef);
1057    is($x->{_a}, 2,     qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{_a}|);
1058    is($x->{_p}, undef, qq|\$x = $class->new(2); \$x->bone('-', 2, undef); \$x->{_p}|);
1059
1060    note "Verify that precision can be set with instance method bone('-').";
1061
1062    $x = $class->new(2);
1063    $x->bone('-', undef, 2);
1064    is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{_a}|);
1065    is($x->{_p}, 2,     qq|\$x = $class->new(2); \$x->bone('-', undef, 2); \$x->{_p}|);
1066
1067    note "Verify that accuracy can be set with instance method bzero().";
1068
1069    $x = $class->new(2);
1070    $x->bzero(2, undef);
1071    is($x->{_a}, 2,     qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{_a}|);
1072    is($x->{_p}, undef, qq|\$x = $class->new(2);\$x->bzero(2, undef); \$x->{_p}|);
1073
1074    note "Verify that precision can be set with instance method bzero().";
1075
1076    $x = $class->new(2);
1077    $x->bzero(undef, 2);
1078    is($x->{_a}, undef, qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{_a}|);
1079    is($x->{_p}, 2,     qq|\$x = $class->new(2); \$x->bzero(undef, 2); \$x->{_p}|);
1080}
1081
1082###############################################################################
1083# test whether bone/bzero honour class variables
1084
1085for my $class ($mbi, $mbf) {
1086
1087    note "Verify that class accuracy is copied into new objects.";
1088
1089    $class->accuracy(3);                # set
1090
1091    $x = $class->bzero();
1092    is($x->accuracy(), 3,
1093       qq|$class->accuracy(3); \$x = $class->bzero(); \$x->accuracy()|);
1094
1095    $x = $class->bone();
1096    is($x->accuracy(), 3,
1097       qq|$class->accuracy(3); \$x = $class->bone(); \$x->accuracy()|);
1098
1099    $x = $class->new(2);
1100    is($x->accuracy(), 3,
1101       qq|$class->accuracy(3); \$x = $class->new(2); \$x->accuracy()|);
1102
1103    $class->accuracy(undef);            # reset
1104
1105    note "Verify that class precision is copied into new objects.";
1106
1107    $class->precision(-4);              # set
1108
1109    $x = $class->bzero();
1110    is($x->precision(), -4,
1111       qq|$class->precision(-4); \$x = $class->bzero(); \$x->precision()|);
1112
1113    $x = $class->bone();
1114    is($x->precision(), -4,
1115       qq|$class->precision(-4); \$x = $class->bone(); \$x->precision()|);
1116
1117    $x = $class->new(2);
1118    is($x->precision(), -4,
1119       qq|$class->precision(-4); \$x = $class->new(2); \$x->precision()|);
1120
1121    $class->precision(undef);           # reset
1122
1123    note "Verify that setting accuracy as method argument overrides class variable";
1124
1125    $class->accuracy(2);                # set
1126
1127    $x = $class->bzero(5);
1128    is($x->accuracy(), 5,
1129       qq|$class->accuracy(2); \$x = $class->bzero(5); \$x->accuracy()|);
1130
1131    SKIP: {
1132          skip 1, "this won't work until we have a better OO implementation";
1133
1134          $x = $class->bzero(undef);
1135          is($x->accuracy(), undef,
1136             qq|$class->accuracy(2); \$x = $class->bzero(undef); \$x->accuracy()|);
1137      }
1138
1139    $x = $class->bone("+", 5);
1140    is($x->accuracy(), 5,
1141       qq|$class->accuracy(2); \$x = $class->bone("+", 5); \$x->accuracy()|);
1142
1143    SKIP: {
1144          skip 1, "this won't work until we have a better OO implementation";
1145
1146          $x = $class->bone("+", undef);
1147          is($x->accuracy(), undef,
1148             qq|$class->accuracy(2); \$x = $class->bone("+", undef); \$x->accuracy()|);
1149      }
1150
1151    $x = $class->new(2, 5);
1152    is($x->accuracy(), 5,
1153       qq|$class->accuracy(2); \$x = $class->new(2, 5); \$x->accuracy()|);
1154
1155    SKIP: {
1156          skip 1, "this won't work until we have a better OO implementation";
1157
1158          $x = $class->new(2, undef);
1159          is($x->accuracy(), undef,
1160             qq|$class->accuracy(2); \$x = $class->new(2, undef); \$x->accuracy()|);
1161      }
1162
1163    $class->accuracy(undef);            # reset
1164
1165    note "Verify that setting precision as method argument overrides class variable";
1166
1167    $class->precision(-2);              # set
1168
1169    $x = $class->bzero(undef, -6);
1170    is($x->precision(), -6,
1171       qq|$class->precision(-2); \$x = $class->bzero(undef, -6); \$x->precision()|);
1172
1173    SKIP: {
1174          skip 1, "this won't work until we have a better OO implementation";
1175
1176          $x = $class->bzero(undef, undef);
1177          is($x->precision(), undef,
1178             qq|$class->precision(-2); \$x = $class->bzero(undef, undef); \$x->precision()|);
1179      }
1180
1181    $x = $class->bone("+", undef, -6);
1182    is($x->precision(), -6,
1183       qq|$class->precision(-2); \$x = $class->bone("+", undef, -6); \$x->precision()|);
1184
1185    SKIP: {
1186          skip 1, "this won't work until we have a better OO implementation";
1187
1188          $x = $class->bone("+", undef, undef);
1189          is($x->precision(), undef,
1190             qq|$class->precision(-2); \$x = $class->bone("+", undef, undef); \$x->precision()|);
1191      }
1192
1193    $x = $class->new(2, undef, -6);
1194    is($x->precision(), -6,
1195       qq|$class->precision(-2); \$x = $class->new(2, undef, -6); \$x->precision()|);
1196
1197    SKIP: {
1198          skip 1, "this won't work until we have a better OO implementation";
1199
1200          $x = $class->new(2, undef, undef);
1201          is($x->precision(), undef,
1202             qq|$class->precision(-2); \$x = $class->new(2, undef, undef); \$x->precision()|);
1203      }
1204
1205    $class->precision(undef);           # reset
1206}
1207
1208###############################################################################
1209# check whether mixing A and P creates a NaN
1210
1211# new with set accuracy/precision and with parameters
1212{
1213    no strict 'refs';
1214    foreach my $class ($mbi, $mbf) {
1215        is($class->new(123, 4, -3), 'NaN',      # with parameters
1216           "mixing A and P creates a NaN");
1217        ${"$class\::accuracy"} = 42;
1218        ${"$class\::precision"} = 2;
1219        is($class->new(123), "NaN",             # with globals
1220           q|$class->new(123) = "NaN"|);
1221        ${"$class\::accuracy"} = undef;
1222        ${"$class\::precision"} = undef;
1223    }
1224}
1225
1226# binary ops
1227foreach my $class ($mbi, $mbf) {
1228    #foreach (qw/add sub mul div pow mod/) {
1229    foreach my $method (qw/add sub mul pow mod/) {
1230        my $try = "my \$x = $class->new(1234); \$x->accuracy(5);";
1231        $try .= " my \$y = $class->new(12); \$y->precision(-3);";
1232        $try .= " \$x->b$method(\$y);";
1233        $rc = eval $try;
1234        is($rc, "NaN", $try);
1235    }
1236}
1237
1238# unary ops
1239foreach my $method (qw/new bsqrt/) {
1240    my $try = "my \$x = $mbi->$method(1234, 5, -3);";
1241    $rc = eval $try;
1242    is($rc, "NaN", $try);
1243}
1244
1245# see if $x->bsub(0) and $x->badd(0) really round
1246foreach my $class ($mbi, $mbf) {
1247    $x = $class->new(123);
1248    $class->accuracy(2);
1249    $x->bsub(0);
1250    is($x, 120, q|$x = 120|);
1251
1252    $class->accuracy(undef);            # reset
1253
1254    $x = $class->new(123);
1255    $class->accuracy(2);
1256    $x->badd(0);
1257    is($x, 120, q|$x = 120|);
1258
1259    $class->accuracy(undef);            # reset
1260}
1261
1262###############################################################################
1263# test whether shortcuts returning zero/one preserve A and P
1264
1265my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args);
1266
1267my $LIB = Math::BigInt->config('lib');
1268
1269while (<DATA>) {
1270    s/#.*$//;                   # remove comments
1271    s/\s+$//;                   # remove trailing whitespace
1272    next unless length;         # skip empty lines
1273
1274    if (s/^&//) {
1275        $f = $_;                # function
1276        next;
1277    }
1278
1279    @args = split(/:/, $_);
1280    my $want = pop(@args);
1281
1282    ($x, $xa, $xp) = split (/,/, $args[0]);
1283    $xa = $xa || '';
1284    $xp = $xp || '';
1285    $try  = qq|\$x = $mbi->new("$x");|;
1286    $try .= qq| \$x->accuracy($xa);|  if $xa ne '';
1287    $try .= qq| \$x->precision($xp);| if $xp ne '';
1288
1289    ($y, $ya, $yp) = split (/,/, $args[1]);
1290    $ya = $ya || '';
1291    $yp = $yp || '';
1292    $try .= qq| \$y = $mbi->new("$y");|;
1293    $try .= qq| \$y->accuracy($ya);|  if $ya ne '';
1294    $try .= qq| \$y->precision($yp);| if $yp ne '';
1295
1296    $try .= ' $x->$f($y);';
1297
1298    # print "trying $try\n";
1299    $rc = eval $try;
1300    print "# Error: $@\n" if $@;
1301
1302    # convert hex/binary targets to decimal
1303    if ($want =~ /^(0x0x|0b0b)/) {
1304        $want =~ s/^0[xb]//;
1305        $want = $mbi->new($want)->bstr();
1306    }
1307    is($rc, $want, $try);
1308    # check internal state of number objects
1309    is_valid($rc, $f) if ref $rc;
1310
1311    # now check whether A and P are set correctly
1312    # only one of $a or $p will be set (no crossing here)
1313    $a = $xa || $ya;
1314    $p = $xp || $yp;
1315
1316    # print "Check a=$a p=$p\n";
1317    # print "# Tried: '$try'\n";
1318    if ($a ne '') {
1319        unless (is($x->{_a}, $a,    qq|\$x->{_a} == $a|) &&
1320                is($x->{_p}, undef, qq|\$x->{_p} is undef|))
1321        {
1322            print "# Check: A = $a and P = undef\n";
1323            print "# Tried: $try\n";
1324        }
1325    }
1326    if ($p ne '') {
1327        unless (is($x->{_p}, $p,    qq|\$x->{_p} == $p|) &&
1328                is($x->{_a}, undef, qq|\$x->{_a} is undef|))
1329        {
1330            print "# Check: A = undef and P = $p\n";
1331            print "# Tried: $try\n";
1332        }
1333    }
1334}
1335
1336# all done
13371;
1338
1339###############################################################################
1340# sub to check validity of a Math::BigInt object internally, to ensure that no
1341# op leaves a number object in an invalid state (f.i. "-0")
1342
1343sub is_valid {
1344    my ($x, $f) = @_;
1345
1346    my $e = 0;                  # error?
1347
1348    # ok as reference?
1349    $e = 'Not a reference' if !ref($x);
1350
1351    # has ok sign?
1352    $e = qq|Illegal sign $x->{sign}|
1353      . q| (expected: "+", "-", "-inf", "+inf" or "NaN")|
1354        if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
1355
1356    $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
1357    $e = $LIB->_check($x->{value}) if $e eq '0';
1358
1359    # test done, see if error did crop up
1360    if ($e eq '0') {
1361        pass('is a valid object');
1362        return;
1363    }
1364
1365    fail($e . qq| after op "$f"|);
1366}
1367
1368# format is:
1369# x,A,P:x,A,P:result
1370# 123,,3 means 123 with precision 3 (A is undef)
1371# the A or P of the result is calculated automatically
1372__DATA__
1373&badd
1374123,,:123,,:246
1375123,3,:0,,:123
1376123,,-3:0,,:123
1377123,,:0,3,:123
1378123,,:0,,-3:123
1379&bmul
1380123,,:1,,:123
1381123,3,:0,,:0
1382123,,-3:0,,:0
1383123,,:0,3,:0
1384123,,:0,,-3:0
1385123,3,:1,,:123
1386123,,-3:1,,:123
1387123,,:1,3,:123
1388123,,:1,,-3:123
13891,3,:123,,:123
13901,,-3:123,,:123
13911,,:123,3,:123
13921,,:123,,-3:123
1393&bdiv
1394123,,:1,,:123
1395123,4,:1,,:123
1396123,,:1,4,:123
1397123,,:1,,-4:123
1398123,,-4:1,,:123
13991,4,:123,,:0
14001,,:123,4,:0
14011,,:123,,-4:0
14021,,-4:123,,:0
1403&band
14041,,:3,,:1
14051234,1,:0,,:0
14061234,,:0,1,:0
14071234,,-1:0,,:0
14081234,,:0,,-1:0
14090xFF,,:0x10,,:0x0x10
14100xFF,2,:0xFF,,:250
14110xFF,,:0xFF,2,:250
14120xFF,,1:0xFF,,:250
14130xFF,,:0xFF,,1:250
1414&bxor
14151,,:3,,:2
14161234,1,:0,,:1000
14171234,,:0,1,:1000
14181234,,3:0,,:1000
14191234,,:0,,3:1000
14200xFF,,:0x10,,:239
1421# 250 ^ 255 => 5
14220xFF,2,:0xFF,,:5
14230xFF,,:0xFF,2,:5
14240xFF,,1:0xFF,,:5
14250xFF,,:0xFF,,1:5
1426# 250 ^ 4095 = 3845 => 3800
14270xFF,2,:0xFFF,,:3800
1428# 255 ^ 4100 = 4347 => 4300
14290xFF,,:0xFFF,2,:4300
14300xFF,,2:0xFFF,,:3800
1431# 255 ^ 4100 = 10fb => 4347 => 4300
14320xFF,,:0xFFF,,2:4300
1433&bior
14341,,:3,,:3
14351234,1,:0,,:1000
14361234,,:0,1,:1000
14371234,,3:0,,:1000
14381234,,:0,,3:1000
14390xFF,,:0x10,,:0x0xFF
1440# FF | FA = FF => 250
1441250,2,:0xFF,,:250
14420xFF,,:250,2,:250
14430xFF,,1:0xFF,,:250
14440xFF,,:0xFF,,1:250
1445&bpow
14462,,:3,,:8
14472,,:0,,:1
14482,2,:0,,:1
14492,,:0,2,:1
1450