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