Commit | Line | Data |
b3abae2a |
1 | #!/usr/bin/perl -w |
2 | |
13a12e00 |
3 | # test inf/NaN handling all in one place |
4 | # Thanx to Jarkko for the excellent explanations and the tables |
5 | |
b3abae2a |
6 | use Test; |
7 | use strict; |
8 | |
9 | BEGIN |
10 | { |
b3abae2a |
11 | chdir 't' if -d 't'; |
12 | unshift @INC, '../lib'; |
13 | } |
f9a08e12 |
14 | BEGIN |
15 | { |
16 | $| = 1; |
17 | # to locate the testing files |
18 | my $location = $0; $location =~ s/inf_nan.t//i; |
19 | if ($ENV{PERL_CORE}) |
20 | { |
21 | @INC = qw(../t/lib); # testing with the core distribution |
22 | } |
23 | unshift @INC, '../lib'; # for testing manually |
24 | if (-d 't') |
25 | { |
26 | chdir 't'; |
27 | require File::Spec; |
28 | unshift @INC, File::Spec->catdir(File::Spec->updir, $location); |
29 | } |
30 | else |
31 | { |
32 | unshift @INC, $location; |
33 | } |
34 | print "# INC = @INC\n"; |
35 | |
990fb837 |
36 | # values groups operators classes tests |
37 | plan tests => 7 * 6 * 5 * 4 * 2 + |
38 | 7 * 6 * 2 * 4 * 1; # bmod |
f9a08e12 |
39 | } |
b3abae2a |
40 | |
41 | use Math::BigInt; |
13a12e00 |
42 | use Math::BigFloat; |
f9a08e12 |
43 | use Math::BigInt::Subclass; |
44 | use Math::BigFloat::Subclass; |
45 | |
46 | my @classes = |
47 | qw/Math::BigInt Math::BigFloat |
48 | Math::BigInt::Subclass Math::BigFloat::Subclass |
49 | /; |
b3abae2a |
50 | |
51 | my (@args,$x,$y,$z); |
52 | |
53 | # + |
54 | foreach (qw/ |
55 | -inf:-inf:-inf |
56 | -1:-inf:-inf |
57 | -0:-inf:-inf |
58 | 0:-inf:-inf |
59 | 1:-inf:-inf |
60 | inf:-inf:NaN |
61 | NaN:-inf:NaN |
62 | |
63 | -inf:-1:-inf |
64 | -1:-1:-2 |
65 | -0:-1:-1 |
66 | 0:-1:-1 |
67 | 1:-1:0 |
68 | inf:-1:inf |
69 | NaN:-1:NaN |
70 | |
71 | -inf:0:-inf |
72 | -1:0:-1 |
73 | -0:0:0 |
74 | 0:0:0 |
75 | 1:0:1 |
76 | inf:0:inf |
77 | NaN:0:NaN |
78 | |
79 | -inf:1:-inf |
80 | -1:1:0 |
81 | -0:1:1 |
82 | 0:1:1 |
83 | 1:1:2 |
84 | inf:1:inf |
85 | NaN:1:NaN |
86 | |
87 | -inf:inf:NaN |
88 | -1:inf:inf |
89 | -0:inf:inf |
90 | 0:inf:inf |
91 | 1:inf:inf |
92 | inf:inf:inf |
93 | NaN:inf:NaN |
94 | |
95 | -inf:NaN:NaN |
96 | -1:NaN:NaN |
97 | -0:NaN:NaN |
98 | 0:NaN:NaN |
99 | 1:NaN:NaN |
100 | inf:NaN:NaN |
101 | NaN:NaN:NaN |
102 | /) |
103 | { |
104 | @args = split /:/,$_; |
f9a08e12 |
105 | for my $class (@classes) |
13a12e00 |
106 | { |
107 | $x = $class->new($args[0]); |
108 | $y = $class->new($args[1]); |
109 | $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 |
f9a08e12 |
110 | my $r = $x->badd($y); |
111 | |
112 | print "# x $class $args[0] + $args[1] should be $args[2] but is $x\n", |
113 | if !ok ($x->bstr(),$args[2]); |
114 | print "# r $class $args[0] + $args[1] should be $args[2] but is $r\n", |
115 | if !ok ($x->bstr(),$args[2]); |
13a12e00 |
116 | } |
b3abae2a |
117 | } |
118 | |
119 | # - |
120 | foreach (qw/ |
121 | -inf:-inf:NaN |
122 | -1:-inf:inf |
123 | -0:-inf:inf |
124 | 0:-inf:inf |
125 | 1:-inf:inf |
126 | inf:-inf:inf |
127 | NaN:-inf:NaN |
128 | |
129 | -inf:-1:-inf |
130 | -1:-1:0 |
131 | -0:-1:1 |
132 | 0:-1:1 |
133 | 1:-1:2 |
134 | inf:-1:inf |
135 | NaN:-1:NaN |
136 | |
137 | -inf:0:-inf |
138 | -1:0:-1 |
139 | -0:0:-0 |
140 | 0:0:0 |
141 | 1:0:1 |
142 | inf:0:inf |
143 | NaN:0:NaN |
144 | |
145 | -inf:1:-inf |
146 | -1:1:-2 |
147 | -0:1:-1 |
148 | 0:1:-1 |
149 | 1:1:0 |
150 | inf:1:inf |
151 | NaN:1:NaN |
152 | |
153 | -inf:inf:-inf |
154 | -1:inf:-inf |
155 | -0:inf:-inf |
156 | 0:inf:-inf |
157 | 1:inf:-inf |
158 | inf:inf:NaN |
159 | NaN:inf:NaN |
160 | |
161 | -inf:NaN:NaN |
162 | -1:NaN:NaN |
163 | -0:NaN:NaN |
164 | 0:NaN:NaN |
165 | 1:NaN:NaN |
166 | inf:NaN:NaN |
167 | NaN:NaN:NaN |
168 | /) |
169 | { |
170 | @args = split /:/,$_; |
f9a08e12 |
171 | for my $class (@classes) |
13a12e00 |
172 | { |
173 | $x = $class->new($args[0]); |
174 | $y = $class->new($args[1]); |
175 | $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 |
f9a08e12 |
176 | my $r = $x->bsub($y); |
177 | |
178 | print "# x $class $args[0] - $args[1] should be $args[2] but is $x\n" |
179 | if !ok ($x->bstr(),$args[2]); |
180 | print "# r $class $args[0] - $args[1] should be $args[2] but is $r\n" |
181 | if !ok ($r->bstr(),$args[2]); |
13a12e00 |
182 | } |
b3abae2a |
183 | } |
184 | |
185 | # * |
186 | foreach (qw/ |
187 | -inf:-inf:inf |
188 | -1:-inf:inf |
189 | -0:-inf:NaN |
190 | 0:-inf:NaN |
191 | 1:-inf:-inf |
192 | inf:-inf:-inf |
193 | NaN:-inf:NaN |
194 | |
195 | -inf:-1:inf |
196 | -1:-1:1 |
197 | -0:-1:0 |
198 | 0:-1:-0 |
199 | 1:-1:-1 |
200 | inf:-1:-inf |
201 | NaN:-1:NaN |
202 | |
203 | -inf:0:NaN |
204 | -1:0:-0 |
205 | -0:0:-0 |
206 | 0:0:0 |
207 | 1:0:0 |
208 | inf:0:NaN |
209 | NaN:0:NaN |
210 | |
211 | -inf:1:-inf |
212 | -1:1:-1 |
213 | -0:1:-0 |
214 | 0:1:0 |
215 | 1:1:1 |
216 | inf:1:inf |
217 | NaN:1:NaN |
218 | |
219 | -inf:inf:-inf |
220 | -1:inf:-inf |
221 | -0:inf:NaN |
222 | 0:inf:NaN |
223 | 1:inf:inf |
224 | inf:inf:inf |
225 | NaN:inf:NaN |
226 | |
227 | -inf:NaN:NaN |
228 | -1:NaN:NaN |
229 | -0:NaN:NaN |
230 | 0:NaN:NaN |
231 | 1:NaN:NaN |
232 | inf:NaN:NaN |
233 | NaN:NaN:NaN |
234 | /) |
235 | { |
236 | @args = split /:/,$_; |
f9a08e12 |
237 | for my $class (@classes) |
13a12e00 |
238 | { |
239 | $x = $class->new($args[0]); |
240 | $y = $class->new($args[1]); |
241 | $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 |
242 | $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 |
f9a08e12 |
243 | my $r = $x->bmul($y); |
244 | |
245 | print "# x $class $args[0] * $args[1] should be $args[2] but is $x\n" |
246 | if !ok ($x->bstr(),$args[2]); |
247 | print "# r $class $args[0] * $args[1] should be $args[2] but is $r\n" |
248 | if !ok ($r->bstr(),$args[2]); |
13a12e00 |
249 | } |
b3abae2a |
250 | } |
251 | |
252 | # / |
253 | foreach (qw/ |
254 | -inf:-inf:NaN |
255 | -1:-inf:0 |
256 | -0:-inf:0 |
257 | 0:-inf:-0 |
258 | 1:-inf:-0 |
259 | inf:-inf:NaN |
260 | NaN:-inf:NaN |
261 | |
262 | -inf:-1:inf |
263 | -1:-1:1 |
264 | -0:-1:0 |
265 | 0:-1:-0 |
266 | 1:-1:-1 |
267 | inf:-1:-inf |
268 | NaN:-1:NaN |
269 | |
270 | -inf:0:-inf |
271 | -1:0:-inf |
272 | -0:0:NaN |
273 | 0:0:NaN |
274 | 1:0:inf |
275 | inf:0:inf |
276 | NaN:0:NaN |
277 | |
278 | -inf:1:-inf |
279 | -1:1:-1 |
280 | -0:1:-0 |
281 | 0:1:0 |
282 | 1:1:1 |
283 | inf:1:inf |
284 | NaN:1:NaN |
285 | |
286 | -inf:inf:NaN |
287 | -1:inf:-0 |
288 | -0:inf:-0 |
289 | 0:inf:0 |
290 | 1:inf:0 |
291 | inf:inf:NaN |
292 | NaN:inf:NaN |
293 | |
294 | -inf:NaN:NaN |
295 | -1:NaN:NaN |
296 | -0:NaN:NaN |
297 | 0:NaN:NaN |
298 | 1:NaN:NaN |
299 | inf:NaN:NaN |
300 | NaN:NaN:NaN |
301 | /) |
302 | { |
303 | @args = split /:/,$_; |
f9a08e12 |
304 | for my $class (@classes) |
13a12e00 |
305 | { |
306 | $x = $class->new($args[0]); |
307 | $y = $class->new($args[1]); |
308 | $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 |
f9a08e12 |
309 | |
310 | my $t = $x->copy(); |
311 | my $tmod = $t->copy(); |
312 | |
313 | # bdiv in scalar context |
314 | my $r = $x->bdiv($y); |
315 | print "# x $class $args[0] / $args[1] should be $args[2] but is $x\n" |
316 | if !ok ($x->bstr(),$args[2]); |
317 | print "# r $class $args[0] / $args[1] should be $args[2] but is $r\n" |
318 | if !ok ($r->bstr(),$args[2]); |
319 | |
320 | # bmod and bdiv in list context |
321 | my ($d,$rem) = $t->bdiv($y); |
322 | |
323 | # bdiv in list context |
324 | print "# t $class $args[0] / $args[1] should be $args[2] but is $t\n" |
325 | if !ok ($t->bstr(),$args[2]); |
326 | print "# d $class $args[0] / $args[1] should be $args[2] but is $d\n" |
327 | if !ok ($d->bstr(),$args[2]); |
328 | |
329 | # bmod |
330 | my $m = $tmod->bmod($y); |
331 | |
332 | # bmod() agrees with bdiv? |
333 | print "# m $class $args[0] % $args[1] should be $rem but is $m\n" |
334 | if !ok ($m->bstr(),$rem->bstr()); |
335 | # bmod() return agrees with set value? |
336 | print "# o $class $args[0] % $args[1] should be $m ($rem) but is $tmod\n" |
337 | if !ok ($tmod->bstr(),$m->bstr()); |
338 | |
13a12e00 |
339 | } |
b3abae2a |
340 | } |
341 | |