Commit | Line | Data |
---|---|---|
8c12dc63 | 1 | #!./perl -w |
313d3d89 JH |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
8c12dc63 JH |
9 | use strict; |
10 | ||
636a970b JH |
11 | use Config; |
12 | ||
78c93c95 JH |
13 | BEGIN { |
14 | if ($^O eq 'aix' && $Config{uselongdouble}) { | |
15 | # FWIW: NaN actually seems to be working decently, | |
16 | # but Inf is completely broken (e.g. Inf + 0 -> NaN). | |
17 | skip_all "$^O with long doubles does not have sane inf/nan"; | |
18 | } | |
19 | } | |
20 | ||
313d3d89 JH |
21 | my $PInf = "Inf" + 0; |
22 | my $NInf = "-Inf" + 0; | |
23 | my $NaN = "NaN" + 0; | |
24 | ||
8c12dc63 JH |
25 | my @PInf = ("Inf", "inf", "INF", "+Inf", |
26 | "Infinity", "INFINITE", | |
313d3d89 | 27 | "1.#INF", "1#INF"); |
8c12dc63 | 28 | my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf; |
313d3d89 JH |
29 | |
30 | my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS", | |
8c12dc63 | 31 | "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", |
313d3d89 JH |
32 | "NaN123", "NAN(123)", "nan%", |
33 | "nanonano"); # RIP, Robin Williams. | |
34 | ||
0c7df902 | 35 | my @printf_fmt = qw(e f g a d u o i b x p); |
354b74ae | 36 | my @packi_fmt = qw(c C s S l L i I n N v V j J w W U); |
0c7df902 | 37 | my @packf_fmt = qw(f d F); |
354b74ae | 38 | my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u); |
540a63d6 | 39 | |
0c7df902 JH |
40 | if ($Config{ivsize} == 8) { |
41 | push @packi_fmt, qw(q Q); | |
42 | } | |
38e1c50b | 43 | |
0c7df902 JH |
44 | if ($Config{uselongdouble}) { |
45 | push @packf_fmt, 'D'; | |
46 | } | |
313d3d89 | 47 | |
0c7df902 | 48 | # === Inf tests === |
313d3d89 | 49 | |
0c7df902 JH |
50 | cmp_ok($PInf, '>', 0, "positive infinity"); |
51 | cmp_ok($NInf, '<', 0, "negative infinity"); | |
313d3d89 | 52 | |
0c7df902 JH |
53 | cmp_ok($PInf, '>', $NInf, "positive > negative"); |
54 | cmp_ok($NInf, '==', -$PInf, "negative == -positive"); | |
55 | cmp_ok(-$NInf, '==', $PInf, "--negative == positive"); | |
313d3d89 | 56 | |
0c7df902 JH |
57 | is($PInf, "Inf", "$PInf value stringifies as Inf"); |
58 | is($NInf, "-Inf", "$NInf value stringifies as -Inf"); | |
8c12dc63 | 59 | |
5bf8b78e JH |
60 | cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf"); |
61 | cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf"); | |
62 | ||
63 | cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf"); | |
64 | cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); | |
65 | ||
66 | cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf"); | |
67 | cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf"); | |
68 | ||
0c7df902 JH |
69 | cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); |
70 | cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); | |
313d3d89 | 71 | |
5bf8b78e JH |
72 | cmp_ok($PInf * $PInf, '==', $PInf, "-Inf * +Inf is +Inf"); |
73 | cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf"); | |
313d3d89 | 74 | |
0c7df902 JH |
75 | is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); |
76 | is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); | |
d06c1c80 | 77 | |
0c7df902 JH |
78 | for my $f (@printf_fmt) { |
79 | is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf"); | |
80 | } | |
d1877901 | 81 | |
0c7df902 JH |
82 | ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef"); |
83 | like($@, qr/Cannot printf/, "$PInf sprintf fails"); | |
354b74ae FC |
84 | ok(!defined eval { $a = sprintf("%c", "Inf")}, |
85 | "stringy sprintf %c +Inf undef"); | |
86 | like($@, qr/Cannot printf/, "stringy $PInf sprintf fails"); | |
313d3d89 | 87 | |
0c7df902 JH |
88 | ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef"); |
89 | like($@, qr/Cannot chr/, "+Inf chr() fails"); | |
354b74ae FC |
90 | ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef"); |
91 | like($@, qr/Cannot chr/, "stringy +Inf chr() fails"); | |
540a63d6 | 92 | |
0c7df902 JH |
93 | ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef"); |
94 | like($@, qr/Cannot printf/, "$NInf sprintf fails"); | |
354b74ae FC |
95 | ok(!defined eval { $a = sprintf("%c", "-Inf")}, |
96 | "sprintf %c stringy -Inf undef"); | |
97 | like($@, qr/Cannot printf/, "stringy $NInf sprintf fails"); | |
1cd88304 | 98 | |
0c7df902 JH |
99 | ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef"); |
100 | like($@, qr/Cannot chr/, "-Inf chr() fails"); | |
354b74ae FC |
101 | ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef"); |
102 | like($@, qr/Cannot chr/, "stringy -Inf chr() fails"); | |
1cd88304 | 103 | |
0c7df902 JH |
104 | for my $f (@packi_fmt) { |
105 | ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef"); | |
106 | like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/, | |
107 | "+Inf pack $f fails"); | |
354b74ae FC |
108 | ok(!defined eval { $a = pack($f, "Inf") }, |
109 | "pack $f stringy +Inf undef"); | |
110 | like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/, | |
111 | "stringy +Inf pack $f fails"); | |
0c7df902 JH |
112 | ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef"); |
113 | like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/, | |
114 | "-Inf pack $f fails"); | |
354b74ae FC |
115 | ok(!defined eval { $a = pack($f, "-Inf") }, |
116 | "pack $f stringy -Inf undef"); | |
117 | like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/, | |
118 | "stringy -Inf pack $f fails"); | |
0c7df902 | 119 | } |
1f4ef0f1 | 120 | |
0c7df902 JH |
121 | for my $f (@packf_fmt) { |
122 | ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined"); | |
123 | eval { $b = unpack($f, $a) }; | |
124 | cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf"); | |
1f4ef0f1 | 125 | |
0c7df902 JH |
126 | ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined"); |
127 | eval { $b = unpack($f, $a) }; | |
128 | cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf"); | |
129 | } | |
1cd88304 | 130 | |
354b74ae FC |
131 | for my $f (@packs_fmt) { |
132 | ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined"); | |
133 | is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'"); | |
134 | ||
135 | ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined"); | |
136 | is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'"); | |
137 | } | |
138 | ||
139 | is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf"; | |
140 | is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf"; | |
141 | is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf"; | |
142 | is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf"; | |
143 | ||
0c7df902 | 144 | for my $i (@PInf) { |
8c12dc63 JH |
145 | cmp_ok($i + 0 , '==', $PInf, "$i is +Inf"); |
146 | cmp_ok($i, '>', 0, "$i is positive"); | |
313d3d89 | 147 | is("@{[$i+0]}", "Inf", "$i value stringifies as Inf"); |
0c7df902 | 148 | } |
313d3d89 | 149 | |
0c7df902 | 150 | for my $i (@NInf) { |
8c12dc63 JH |
151 | cmp_ok($i + 0, '==', $NInf, "$i is -Inf"); |
152 | cmp_ok($i, '<', 0, "$i is negative"); | |
313d3d89 | 153 | is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf"); |
0c7df902 | 154 | } |
313d3d89 | 155 | |
0c7df902 JH |
156 | is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf"); |
157 | is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf"); | |
313d3d89 | 158 | |
0c7df902 JH |
159 | is(1/$PInf, 0, "one per +Inf is zero"); |
160 | is(1/$NInf, 0, "one per -Inf is zero"); | |
87821667 | 161 | |
0c7df902 JH |
162 | my ($PInfPP, $PInfMM) = ($PInf, $PInf); |
163 | my ($NInfPP, $NInfMM) = ($NInf, $NInf);; | |
164 | $PInfPP++; | |
165 | $PInfMM--; | |
166 | $NInfPP++; | |
167 | $NInfMM--; | |
168 | is($PInfPP, $PInf, "+Inf++ is +Inf"); | |
169 | is($PInfMM, $PInf, "+Inf-- is +Inf"); | |
170 | is($NInfPP, $NInf, "-Inf++ is -Inf"); | |
171 | is($NInfMM, $NInf, "-Inf-- is -Inf"); | |
38e1c50b | 172 | |
0c7df902 JH |
173 | ok($PInf, "+Inf is true"); |
174 | ok($NInf, "-Inf is true"); | |
38e1c50b | 175 | |
5bf8b78e JH |
176 | is(abs($PInf), $PInf, "abs(+Inf) is +Inf"); |
177 | is(abs($NInf), $PInf, "abs(-Inf) is +Inf"); | |
178 | ||
179 | # One could argue of NaN as the result. | |
180 | is(int($PInf), $PInf, "int(+Inf) is +Inf"); | |
181 | is(int($NInf), $NInf, "int(-Inf) is -Inf"); | |
182 | ||
0c7df902 | 183 | is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf"); |
5bf8b78e JH |
184 | # sqrt $NInf doesn't work because negative is caught |
185 | ||
0c7df902 JH |
186 | is(exp($PInf), $PInf, "exp(+Inf) is +Inf"); |
187 | is(exp($NInf), 0, "exp(-Inf) is zero"); | |
38e1c50b | 188 | |
0c7df902 | 189 | SKIP: { |
5bf8b78e JH |
190 | if ($PInf == 0) { |
191 | skip "if +Inf == 0 cannot log(+Inf)", 1; | |
192 | } | |
193 | is(log($PInf), $PInf, "log(+Inf) is +Inf"); | |
194 | } | |
195 | # log $NInf doesn't work because negative is caught | |
196 | ||
197 | is(rand($PInf), $PInf, "rand(+Inf) is +Inf"); | |
198 | is(rand($NInf), $NInf, "rand(-Inf) is -Inf"); | |
199 | ||
200 | # XXX Bit operations? | |
201 | # +Inf & 1 == +Inf? | |
202 | # +Inf | 1 == +Inf? | |
203 | # +Inf ^ 1 == +Inf? | |
204 | # ~+Inf == 0? or NaN? | |
205 | # -Inf ... ??? | |
206 | # NaN & 1 == NaN? | |
207 | # NaN | 1 == NaN? | |
208 | # NaN ^ 1 == NaN? | |
209 | # ~NaN == NaN??? | |
210 | # Or just declare insanity and die? | |
211 | ||
212 | SKIP: { | |
0c7df902 JH |
213 | my $here = "$^O $Config{osvers}"; |
214 | if ($here =~ /^hpux 10/) { | |
215 | skip "$here: pow doesn't generate Inf", 1; | |
216 | } | |
217 | is(9**9**9, $PInf, "9**9**9 is Inf"); | |
313d3d89 JH |
218 | } |
219 | ||
3ff98fcf JH |
220 | SKIP: { |
221 | my @FInf = qw(Info Infiniti Infinityz); | |
222 | if ($Config{usequadmath}) { | |
223 | skip "quadmath strtoflt128() accepts false infinities", scalar @FInf; | |
224 | } | |
0ec38c0a JH |
225 | # Silence "isn't numeric in addition", that's kind of the point. |
226 | local $^W = 0; | |
3ff98fcf | 227 | for my $i (@FInf) { |
0ec38c0a JH |
228 | cmp_ok("$i" + 0, '==', 0, "false infinity $i"); |
229 | } | |
230 | } | |
231 | ||
0c7df902 | 232 | # === NaN === |
38e1c50b | 233 | |
0c7df902 JH |
234 | cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)"); |
235 | ok($NaN eq $NaN, "NaN is NaN stringifically"); | |
313d3d89 | 236 | |
0c7df902 | 237 | is("$NaN", "NaN", "$NaN value stringifies as NaN"); |
313d3d89 | 238 | |
0c7df902 JH |
239 | is("+NaN" + 0, "NaN", "+NaN is NaN"); |
240 | is("-NaN" + 0, "NaN", "-NaN is NaN"); | |
313d3d89 | 241 | |
5bf8b78e JH |
242 | is($NaN + 0, $NaN, "NaN + zero is NaN"); |
243 | ||
244 | is($NaN + 1, $NaN, "NaN + one is NaN"); | |
245 | ||
0c7df902 JH |
246 | is($NaN * 2, $NaN, "twice NaN is NaN"); |
247 | is($NaN / 2, $NaN, "half of NaN is NaN"); | |
8c12dc63 | 248 | |
5bf8b78e JH |
249 | is($NaN * $NaN, $NaN, "NaN * NaN is NaN"); |
250 | is($NaN / $NaN, $NaN, "NaN / NaN is NaN"); | |
d06c1c80 | 251 | |
0c7df902 JH |
252 | for my $f (@printf_fmt) { |
253 | is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); | |
254 | } | |
d1877901 | 255 | |
0c7df902 JH |
256 | ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef"); |
257 | like($@, qr/Cannot printf/, "$NaN sprintf fails"); | |
354b74ae FC |
258 | ok(!defined eval { $a = sprintf("%c", "NaN")}, |
259 | "sprintf %c stringy NaN undef"); | |
260 | like($@, qr/Cannot printf/, "stringy $NaN sprintf fails"); | |
313d3d89 | 261 | |
0c7df902 JH |
262 | ok(!defined eval { $a = chr($NaN) }, "chr NaN undef"); |
263 | like($@, qr/Cannot chr/, "NaN chr() fails"); | |
354b74ae FC |
264 | ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef"); |
265 | like($@, qr/Cannot chr/, "stringy NaN chr() fails"); | |
1cd88304 | 266 | |
0c7df902 JH |
267 | for my $f (@packi_fmt) { |
268 | ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef"); | |
269 | like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/, | |
270 | "NaN pack $f fails"); | |
354b74ae FC |
271 | ok(!defined eval { $a = pack($f, "NaN") }, |
272 | "pack $f stringy NaN undef"); | |
273 | like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/, | |
274 | "stringy NaN pack $f fails"); | |
0c7df902 | 275 | } |
1f4ef0f1 | 276 | |
0c7df902 JH |
277 | for my $f (@packf_fmt) { |
278 | ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined"); | |
279 | eval { $b = unpack($f, $a) }; | |
280 | cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN"); | |
281 | } | |
1cd88304 | 282 | |
354b74ae FC |
283 | for my $f (@packs_fmt) { |
284 | ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined"); | |
285 | is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'"); | |
286 | } | |
287 | ||
288 | is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN"; | |
289 | is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN"; | |
290 | ||
0c7df902 | 291 | for my $i (@NaN) { |
8c12dc63 | 292 | cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)"); |
313d3d89 | 293 | is("@{[$i+0]}", "NaN", "$i value stringifies as NaN"); |
0c7df902 | 294 | } |
313d3d89 | 295 | |
0c7df902 JH |
296 | ok(!($NaN < 0), "NaN is not lt zero"); |
297 | ok(!($NaN == 0), "NaN is not == zero"); | |
298 | ok(!($NaN > 0), "NaN is not gt zero"); | |
38e1c50b | 299 | |
0c7df902 JH |
300 | ok(!($NaN < $NaN), "NaN is not lt NaN"); |
301 | ok(!($NaN > $NaN), "NaN is not gt NaN"); | |
38e1c50b | 302 | |
0c7df902 JH |
303 | # is() okay with $NaN because it uses eq. |
304 | is($NaN * 0, $NaN, "NaN times zero is NaN"); | |
305 | is($NaN * 2, $NaN, "NaN times two is NaN"); | |
87821667 | 306 | |
0c7df902 JH |
307 | my ($NaNPP, $NaNMM) = ($NaN, $NaN); |
308 | $NaNPP++; | |
309 | $NaNMM--; | |
5bf8b78e JH |
310 | is($NaNPP, $NaN, "+NaN++ is NaN"); |
311 | is($NaNMM, $NaN, "+NaN-- is NaN"); | |
38e1c50b | 312 | |
0c7df902 JH |
313 | # You might find this surprising (isn't NaN kind of like of undef?) |
314 | # but this is how it is. | |
315 | ok($NaN, "NaN is true"); | |
38e1c50b | 316 | |
5bf8b78e JH |
317 | is(abs($NaN), $NaN, "abs(NaN) is NaN"); |
318 | is(int($NaN), $NaN, "int(NaN) is NaN"); | |
0c7df902 JH |
319 | is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN"); |
320 | is(exp($NaN), $NaN, "exp(NaN) is NaN"); | |
5bf8b78e JH |
321 | |
322 | SKIP: { | |
323 | if ($NaN == 0) { | |
324 | skip "if +NaN == 0 cannot log(+NaN)", 1; | |
325 | } | |
326 | is(log($NaN), $NaN, "log(NaN) is NaN"); | |
327 | } | |
328 | ||
0c7df902 | 329 | is(sin($NaN), $NaN, "sin(NaN) is NaN"); |
5bf8b78e | 330 | is(rand($NaN), $NaN, "rand(NaN) is NaN"); |
38e1c50b | 331 | |
0c7df902 JH |
332 | SKIP: { |
333 | my $here = "$^O $Config{osvers}"; | |
334 | if ($here =~ /^hpux 10/) { | |
335 | skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1; | |
336 | } | |
337 | is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN"); | |
313d3d89 JH |
338 | } |
339 | ||
0c7df902 | 340 | # === Tests combining Inf and NaN === |
38e1c50b | 341 | |
0c7df902 JH |
342 | # is() okay with $NaN because it uses eq. |
343 | is($PInf * 0, $NaN, "Inf times zero is NaN"); | |
344 | is($PInf * $NaN, $NaN, "Inf times NaN is NaN"); | |
345 | is($PInf + $NaN, $NaN, "Inf plus NaN is NaN"); | |
346 | is($PInf - $PInf, $NaN, "Inf minus inf is NaN"); | |
347 | is($PInf / $PInf, $NaN, "Inf div inf is NaN"); | |
348 | is($PInf % $PInf, $NaN, "Inf mod inf is NaN"); | |
313d3d89 | 349 | |
0c7df902 JH |
350 | ok(!($NaN < $PInf), "NaN is not lt +Inf"); |
351 | ok(!($NaN == $PInf), "NaN is not eq +Inf"); | |
352 | ok(!($NaN > $PInf), "NaN is not gt +Inf"); | |
38e1c50b | 353 | |
5bf8b78e | 354 | ok(!($NaN < $NInf), "NaN is not lt -Inf"); |
0c7df902 | 355 | ok(!($NaN == $NInf), "NaN is not eq -Inf"); |
5bf8b78e | 356 | ok(!($NaN > $NInf), "NaN is not gt -Inf"); |
38e1c50b | 357 | |
0c7df902 | 358 | is(sin($PInf), $NaN, "sin(+Inf) is NaN"); |
38e1c50b | 359 | |
7bb1ed39 JH |
360 | # === Overflows and Underflows === |
361 | ||
362 | # 1e9999 (and 1e-9999) are large (and small) enough for even | |
363 | # IEEE quadruple precision (magnitude 10**4932, and 10**-4932). | |
364 | ||
365 | cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)"); | |
366 | cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)"); | |
367 | cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)"); | |
368 | cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)"); | |
369 | cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos"); | |
370 | cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos"); | |
371 | cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg"); | |
372 | cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg"); | |
373 | ||
0c7df902 | 374 | done_testing(); |