1# -*- mode: perl; -*-
2
3# test inf/NaN handling all in one place
4
5use strict;
6use warnings;
7use lib 't';
8
9use Test::More tests => 1044;
10
11use Math::BigInt;
12use Math::BigFloat;
13use Math::BigInt::Subclass;
14use Math::BigFloat::Subclass;
15
16my @biclasses = qw/ Math::BigInt   Math::BigInt::Subclass   /;
17my @bfclasses = qw/ Math::BigFloat Math::BigFloat::Subclass /;
18
19my (@args, $x, $y, $z, $test);
20
21# +
22
23foreach (qw/
24
25    -inf:-inf:-inf
26    -1:-inf:-inf
27    -0:-inf:-inf
28    0:-inf:-inf
29    1:-inf:-inf
30    inf:-inf:NaN
31    NaN:-inf:NaN
32
33    -inf:-1:-inf
34    -1:-1:-2
35    -0:-1:-1
36    0:-1:-1
37    1:-1:0
38    inf:-1:inf
39    NaN:-1:NaN
40
41    -inf:0:-inf
42    -1:0:-1
43    -0:0:0
44    0:0:0
45    1:0:1
46    inf:0:inf
47    NaN:0:NaN
48
49    -inf:1:-inf
50    -1:1:0
51    -0:1:1
52    0:1:1
53    1:1:2
54    inf:1:inf
55    NaN:1:NaN
56
57    -inf:inf:NaN
58    -1:inf:inf
59    -0:inf:inf
60    0:inf:inf
61    1:inf:inf
62    inf:inf:inf
63    NaN:inf:NaN
64
65    -inf:NaN:NaN
66    -1:NaN:NaN
67    -0:NaN:NaN
68    0:NaN:NaN
69    1:NaN:NaN
70    inf:NaN:NaN
71    NaN:NaN:NaN
72
73  /)
74{
75    @args = split /:/, $_;
76    for my $class (@biclasses, @bfclasses) {
77        $args[2] = '0' if $args[2] eq '-0';     # Math::Big* has no -0
78        $x = $class->new($args[0]);
79        $y = $class->new($args[1]);
80        $z = $x->badd($y);
81
82        $test = qq|\$x = $class->new("$args[0]"); |
83              . qq|\$y = $class->new("$args[1]"); |
84              . qq|\$z = \$x->badd(\$y);|;
85
86        subtest $test => sub {
87            plan tests => 6;
88
89            is(ref($x), $class, "\$x is a $class");
90            is(ref($y), $class, "\$y is still a $class");
91            is(ref($z), $class, "\$z is a $class");
92            is($x->bstr(), $args[2], 'value of $x');
93            is($y->bstr(), $args[1], 'value of $y');
94            is($z->bstr(), $args[2], 'value of $z');
95        };
96    }
97}
98
99# -
100
101foreach (qw/
102
103    -inf:-inf:NaN
104    -1:-inf:inf
105    -0:-inf:inf
106    0:-inf:inf
107    1:-inf:inf
108    inf:-inf:inf
109    NaN:-inf:NaN
110
111    -inf:-1:-inf
112    -1:-1:0
113    -0:-1:1
114    0:-1:1
115    1:-1:2
116    inf:-1:inf
117    NaN:-1:NaN
118
119    -inf:0:-inf
120    -1:0:-1
121    -0:0:-0
122    0:0:0
123    1:0:1
124    inf:0:inf
125    NaN:0:NaN
126
127    -inf:1:-inf
128    -1:1:-2
129    -0:1:-1
130    0:1:-1
131    1:1:0
132    inf:1:inf
133    NaN:1:NaN
134
135    -inf:inf:-inf
136    -1:inf:-inf
137    -0:inf:-inf
138    0:inf:-inf
139    1:inf:-inf
140    inf:inf:NaN
141    NaN:inf:NaN
142
143    -inf:NaN:NaN
144    -1:NaN:NaN
145    -0:NaN:NaN
146    0:NaN:NaN
147    1:NaN:NaN
148    inf:NaN:NaN
149    NaN:NaN:NaN
150
151  /)
152{
153    @args = split /:/, $_;
154    for my $class (@biclasses, @bfclasses) {
155        $args[2] = '0' if $args[2] eq '-0';     # Math::Big* has no -0
156        $x = $class->new($args[0]);
157        $y = $class->new($args[1]);
158        $z = $x->bsub($y);
159
160        $test = qq|\$x = $class->new("$args[0]"); |
161              . qq|\$y = $class->new("$args[1]"); |
162              . qq|\$z = \$x->bsub(\$y);|;
163
164        subtest $test => sub {
165            plan tests => 6;
166
167            is(ref($x), $class, "\$x is a $class");
168            is(ref($y), $class, "\$y is still a $class");
169            is(ref($z), $class, "\$z is a $class");
170            is($x->bstr(), $args[2], 'value of $x');
171            is($y->bstr(), $args[1], 'value of $y');
172            is($z->bstr(), $args[2], 'value of $z');
173        };
174    }
175}
176
177# *
178
179foreach (qw/
180
181    -inf:-inf:inf
182    -1:-inf:inf
183    -0:-inf:NaN
184    0:-inf:NaN
185    1:-inf:-inf
186    inf:-inf:-inf
187    NaN:-inf:NaN
188
189    -inf:-1:inf
190    -1:-1:1
191    -0:-1:0
192    0:-1:-0
193    1:-1:-1
194    inf:-1:-inf
195    NaN:-1:NaN
196
197    -inf:0:NaN
198    -1:0:-0
199    -0:0:-0
200    0:0:0
201    1:0:0
202    inf:0:NaN
203    NaN:0:NaN
204
205    -inf:1:-inf
206    -1:1:-1
207    -0:1:-0
208    0:1:0
209    1:1:1
210    inf:1:inf
211    NaN:1:NaN
212
213    -inf:inf:-inf
214    -1:inf:-inf
215    -0:inf:NaN
216    0:inf:NaN
217    1:inf:inf
218    inf:inf:inf
219    NaN:inf:NaN
220
221    -inf:NaN:NaN
222    -1:NaN:NaN
223    -0:NaN:NaN
224    0:NaN:NaN
225    1:NaN:NaN
226    inf:NaN:NaN
227    NaN:NaN:NaN
228
229    /)
230{
231    @args = split /:/, $_;
232    for my $class (@biclasses, @bfclasses) {
233        $args[2] = '0' if $args[2] eq '-0';     # Math::Big* has no -0
234        $x = $class->new($args[0]);
235        $y = $class->new($args[1]);
236        $z = $x->bmul($y);
237
238        $test = qq|\$x = $class->new("$args[0]"); |
239              . qq|\$y = $class->new("$args[1]"); |
240              . qq|\$z = \$x->bmul(\$y);|;
241
242        subtest $test => sub {
243            plan tests => 6;
244
245            is(ref($x), $class, "\$x is a $class");
246            is(ref($y), $class, "\$y is still a $class");
247            is(ref($z), $class, "\$z is a $class");
248            is($x->bstr(), $args[2], 'value of $x');
249            is($y->bstr(), $args[1], 'value of $y');
250            is($z->bstr(), $args[2], 'value of $z');
251        };
252    }
253}
254
255# /
256
257foreach (qw/
258
259    -inf:-inf:NaN
260    -1:-inf:0
261    -0:-inf:0
262    0:-inf:-0
263    1:-inf:-1
264    inf:-inf:NaN
265    NaN:-inf:NaN
266
267    -inf:-1:inf
268    -1:-1:1
269    -0:-1:0
270    0:-1:-0
271    1:-1:-1
272    inf:-1:-inf
273    NaN:-1:NaN
274
275    -inf:0:-inf
276    -1:0:-inf
277    -0:0:NaN
278    0:0:NaN
279    1:0:inf
280    inf:0:inf
281    NaN:0:NaN
282
283    -inf:1:-inf
284    -1:1:-1
285    -0:1:-0
286    0:1:0
287    1:1:1
288    inf:1:inf
289    NaN:1:NaN
290
291    -inf:inf:NaN
292    -1:inf:-1
293    -0:inf:-0
294    0:inf:0
295    1:inf:0
296    inf:inf:NaN
297    NaN:inf:NaN
298
299    -inf:NaN:NaN
300    -1:NaN:NaN
301    -0:NaN:NaN
302    0:NaN:NaN
303    1:NaN:NaN
304    inf:NaN:NaN
305    NaN:NaN:NaN
306
307    /)
308{
309    @args = split /:/, $_;
310    for my $class (@biclasses, @bfclasses) {
311        $args[2] = '0' if $args[2] eq '-0';     # Math::Big* has no -0
312
313        my ($q, $r);
314
315        # bdiv in scalar context
316
317        $x = $class->new($args[0]);
318        $y = $class->new($args[1]);
319
320        unless ($class =~ /^Math::BigFloat/) {
321            $q = $x->bdiv($y);
322
323            $test = qq|\$x = $class->new("$args[0]"); |
324                  . qq|\$y = $class->new("$args[1]"); |
325                  . qq|\$q = \$x->bdiv(\$y);|;
326
327            subtest $test => sub {
328                plan tests => 6;
329
330                is(ref($x), $class, "\$x is a $class");
331                is(ref($y), $class, "\$y is still a $class");
332                is(ref($q), $class, "\$q is a $class");
333                is($x->bstr(), $args[2], 'value of $x');
334                is($y->bstr(), $args[1], 'value of $y');
335                is($q->bstr(), $args[2], 'value of $q');
336            };
337        }
338
339        # bmod and bdiv in list context
340
341        $x = $class->new($args[0]);
342        $y = $class->new($args[1]);
343
344        ($q, $r) = $x->bdiv($y);
345
346        # bdiv in list context
347
348        $test = qq|\$x = $class->new("$args[0]"); |
349              . qq|\$y = $class->new("$args[1]"); |
350              . qq|(\$q, \$r) = \$x->bdiv(\$y);|;
351
352        subtest $test => sub {
353            plan tests => 7;
354
355            is(ref($x), $class, "\$x is a $class");
356            is(ref($y), $class, "\$y is still a $class");
357            is(ref($q), $class, "\$q is a $class");
358            is(ref($r), $class, "\$r is a $class");
359            is($x->bstr(), $args[2], 'value of $x');
360            is($y->bstr(), $args[1], 'value of $y');
361            is($q->bstr(), $args[2], 'value of $q');
362        };
363
364        # bmod
365
366        $x = $class->new($args[0]);
367        $y = $class->new($args[1]);
368
369        my $m = $x->bmod($y);
370
371        $test = qq|\$x = $class->new("$args[0]"); |
372              . qq|\$y = $class->new("$args[1]"); |
373              . qq|\$m = \$x->bmod(\$y);|;
374
375        subtest $test => sub {
376            plan tests => 6;
377
378            is(ref($x), $class, "\$x is a $class");
379            is(ref($y), $class, "\$y is still a $class");
380            is(ref($m), $class, "\$m is a $class");
381            is($x->bstr(), $r->bstr(), 'value of $x');
382            is($y->bstr(), $args[1], 'value of $y');
383            is($m->bstr(), $r->bstr(), 'value of $m');
384        };
385    }
386}
387
388# /
389
390foreach (qw/
391
392    -inf:-inf:NaN
393    -1:-inf:0
394    -0:-inf:0
395    0:-inf:-0
396    1:-inf:-0
397    inf:-inf:NaN
398    NaN:-inf:NaN
399
400    -inf:-1:inf
401    -1:-1:1
402    -0:-1:0
403    0:-1:-0
404    1:-1:-1
405    inf:-1:-inf
406    NaN:-1:NaN
407
408    -inf:0:-inf
409    -1:0:-inf
410    -0:0:NaN
411    0:0:NaN
412    1:0:inf
413    inf:0:inf
414    NaN:0:NaN
415
416    -inf:1:-inf
417    -1:1:-1
418    -0:1:-0
419    0:1:0
420    1:1:1
421    inf:1:inf
422    NaN:1:NaN
423
424    -inf:inf:NaN
425    -1:inf:-0
426    -0:inf:-0
427    0:inf:0
428    1:inf:0
429    inf:inf:NaN
430    NaN:inf:NaN
431
432    -inf:NaN:NaN
433    -1:NaN:NaN
434    -0:NaN:NaN
435    0:NaN:NaN
436    1:NaN:NaN
437    inf:NaN:NaN
438    NaN:NaN:NaN
439
440    /)
441{
442    @args = split /:/, $_;
443    for my $class (@bfclasses) {
444        $args[2] = '0' if $args[2] eq '-0';     # Math::Big* has no -0
445        $x = $class->new($args[0]);
446        $y = $class->new($args[1]);
447        $z = $x->bdiv($y);
448
449        $test = qq|\$x = $class->new("$args[0]"); |
450              . qq|\$y = $class->new("$args[1]"); |
451              . qq|\$z = \$x->bdiv(\$y);|;
452
453        subtest $test => sub {
454            plan tests => 6;
455
456            is(ref($x), $class, "\$x is a $class");
457            is(ref($y), $class, "\$y is still a $class");
458            is(ref($z), $class, "\$z is a $class");
459            is($x->bstr(), $args[2], 'value of $x');
460            is($y->bstr(), $args[1], 'value of $y');
461            is($z->bstr(), $args[2], 'value of $z');
462        };
463    }
464}
465
466#############################################################################
467# overloaded comparisons
468
469foreach my $c (@biclasses, @bfclasses) {
470    $x = $c->bnan();
471    $y = $c->bnan();            # test with two different objects, too
472    $z = $c->bzero();
473
474    is($x == $y, '', 'NaN == NaN: ""');
475    is($x != $y, 1,  'NaN != NaN: 1');
476
477    is($x == $x, '', 'NaN == NaN: ""');
478    is($x != $x, 1,  'NaN != NaN: 1');
479
480    is($z != $x, 1,  '0 != NaN: 1');
481    is($z == $x, '', '0 == NaN: ""');
482
483    is($z < $x,  '', '0 < NaN: ""');
484    is($z <= $x, '', '0 <= NaN: ""');
485    is($z >= $x, '', '0 >= NaN: ""');
486    #is($z > $x,  '', '0 > NaN: ""');   # Bug! Todo: fix it!
487}
488
489# All done.
490