Commit | Line | Data |
---|---|---|
8c12dc63 | 1 | #!./perl -w |
313d3d89 JH |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
313d3d89 | 5 | require './test.pl'; |
624c42e2 | 6 | set_up_inc('../lib'); |
313d3d89 JH |
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 | } | |
85272d31 | 19 | unless ($Config{d_double_has_inf} && $Config{d_double_has_nan}) { |
15899733 JH |
20 | skip_all "the doublekind $Config{doublekind} does not have inf/nan"; |
21 | } | |
78c93c95 JH |
22 | } |
23 | ||
313d3d89 JH |
24 | my $PInf = "Inf" + 0; |
25 | my $NInf = "-Inf" + 0; | |
6b322424 JH |
26 | my $NaN; |
27 | { | |
28 | local $^W = 0; # warning-ness tested later. | |
29 | $NaN = "NaN" + 0; | |
30 | } | |
313d3d89 | 31 | |
8c12dc63 | 32 | my @PInf = ("Inf", "inf", "INF", "+Inf", |
b8974fcb | 33 | "Infinity", |
fae4db12 | 34 | "1.#INF", "1#INF", "1.#INF00"); |
8c12dc63 | 35 | my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf; |
313d3d89 JH |
36 | |
37 | my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS", | |
fae4db12 | 38 | "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00", |
1e9aa12f | 39 | "NAN(123)"); |
313d3d89 | 40 | |
84a826ef | 41 | my @printf_fmt = qw(e f g a d u o i b x); |
354b74ae | 42 | my @packi_fmt = qw(c C s S l L i I n N v V j J w W U); |
0c7df902 | 43 | my @packf_fmt = qw(f d F); |
354b74ae | 44 | my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u); |
540a63d6 | 45 | |
0c7df902 JH |
46 | if ($Config{ivsize} == 8) { |
47 | push @packi_fmt, qw(q Q); | |
48 | } | |
38e1c50b | 49 | |
3e3c2fa4 | 50 | if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) { |
0c7df902 JH |
51 | push @packf_fmt, 'D'; |
52 | } | |
313d3d89 | 53 | |
0c7df902 | 54 | # === Inf tests === |
313d3d89 | 55 | |
0c7df902 JH |
56 | cmp_ok($PInf, '>', 0, "positive infinity"); |
57 | cmp_ok($NInf, '<', 0, "negative infinity"); | |
313d3d89 | 58 | |
0c7df902 JH |
59 | cmp_ok($PInf, '>', $NInf, "positive > negative"); |
60 | cmp_ok($NInf, '==', -$PInf, "negative == -positive"); | |
61 | cmp_ok(-$NInf, '==', $PInf, "--negative == positive"); | |
313d3d89 | 62 | |
0c7df902 JH |
63 | is($PInf, "Inf", "$PInf value stringifies as Inf"); |
64 | is($NInf, "-Inf", "$NInf value stringifies as -Inf"); | |
8c12dc63 | 65 | |
5bf8b78e JH |
66 | cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf"); |
67 | cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf"); | |
68 | ||
69 | cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf"); | |
70 | cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); | |
71 | ||
72 | cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf"); | |
73 | cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf"); | |
74 | ||
0c7df902 JH |
75 | cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); |
76 | cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); | |
313d3d89 | 77 | |
00c6bd38 JH |
78 | cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf"); |
79 | cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf"); | |
80 | cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf"); | |
5bf8b78e | 81 | cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf"); |
313d3d89 | 82 | |
0c7df902 JH |
83 | is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); |
84 | is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); | |
d06c1c80 | 85 | |
0c7df902 JH |
86 | for my $f (@printf_fmt) { |
87 | is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf"); | |
88 | } | |
d1877901 | 89 | |
5d801ef3 JH |
90 | is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g"); |
91 | is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g"); | |
92 | ||
93 | is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g"); | |
94 | is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g"); | |
95 | ||
96 | is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g"); | |
97 | is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g"); | |
98 | ||
99 | is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g"); | |
100 | is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g"); | |
101 | ||
0c7df902 JH |
102 | ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef"); |
103 | like($@, qr/Cannot printf/, "$PInf sprintf fails"); | |
354b74ae FC |
104 | ok(!defined eval { $a = sprintf("%c", "Inf")}, |
105 | "stringy sprintf %c +Inf undef"); | |
c1554ae1 | 106 | like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails"); |
313d3d89 | 107 | |
0c7df902 JH |
108 | ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef"); |
109 | like($@, qr/Cannot chr/, "+Inf chr() fails"); | |
354b74ae FC |
110 | ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef"); |
111 | like($@, qr/Cannot chr/, "stringy +Inf chr() fails"); | |
540a63d6 | 112 | |
0c7df902 JH |
113 | ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef"); |
114 | like($@, qr/Cannot printf/, "$NInf sprintf fails"); | |
354b74ae FC |
115 | ok(!defined eval { $a = sprintf("%c", "-Inf")}, |
116 | "sprintf %c stringy -Inf undef"); | |
c1554ae1 | 117 | like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails"); |
1cd88304 | 118 | |
0c7df902 JH |
119 | ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef"); |
120 | like($@, qr/Cannot chr/, "-Inf chr() fails"); | |
354b74ae FC |
121 | ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef"); |
122 | like($@, qr/Cannot chr/, "stringy -Inf chr() fails"); | |
1cd88304 | 123 | |
0c7df902 | 124 | for my $f (@packi_fmt) { |
5ebb886c | 125 | undef $a; |
0c7df902 JH |
126 | ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef"); |
127 | like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/, | |
128 | "+Inf pack $f fails"); | |
5ebb886c | 129 | undef $a; |
354b74ae FC |
130 | ok(!defined eval { $a = pack($f, "Inf") }, |
131 | "pack $f stringy +Inf undef"); | |
132 | like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/, | |
133 | "stringy +Inf pack $f fails"); | |
5ebb886c | 134 | undef $a; |
0c7df902 JH |
135 | ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef"); |
136 | like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/, | |
137 | "-Inf pack $f fails"); | |
5ebb886c | 138 | undef $a; |
354b74ae FC |
139 | ok(!defined eval { $a = pack($f, "-Inf") }, |
140 | "pack $f stringy -Inf undef"); | |
141 | like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/, | |
142 | "stringy -Inf pack $f fails"); | |
0c7df902 | 143 | } |
1f4ef0f1 | 144 | |
0c7df902 | 145 | for my $f (@packf_fmt) { |
5ebb886c JH |
146 | undef $a; |
147 | undef $b; | |
0c7df902 JH |
148 | ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined"); |
149 | eval { $b = unpack($f, $a) }; | |
150 | cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf"); | |
1f4ef0f1 | 151 | |
5ebb886c JH |
152 | undef $a; |
153 | undef $b; | |
0c7df902 JH |
154 | ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined"); |
155 | eval { $b = unpack($f, $a) }; | |
156 | cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf"); | |
157 | } | |
1cd88304 | 158 | |
354b74ae | 159 | for my $f (@packs_fmt) { |
5ebb886c | 160 | undef $a; |
354b74ae FC |
161 | ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined"); |
162 | is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'"); | |
163 | ||
5ebb886c | 164 | undef $a; |
354b74ae FC |
165 | ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined"); |
166 | is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'"); | |
167 | } | |
168 | ||
169 | is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf"; | |
170 | is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf"; | |
171 | is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf"; | |
172 | is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf"; | |
173 | ||
0c7df902 | 174 | for my $i (@PInf) { |
8c12dc63 JH |
175 | cmp_ok($i + 0 , '==', $PInf, "$i is +Inf"); |
176 | cmp_ok($i, '>', 0, "$i is positive"); | |
313d3d89 | 177 | is("@{[$i+0]}", "Inf", "$i value stringifies as Inf"); |
0c7df902 | 178 | } |
313d3d89 | 179 | |
0c7df902 | 180 | for my $i (@NInf) { |
8c12dc63 JH |
181 | cmp_ok($i + 0, '==', $NInf, "$i is -Inf"); |
182 | cmp_ok($i, '<', 0, "$i is negative"); | |
313d3d89 | 183 | is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf"); |
0c7df902 | 184 | } |
313d3d89 | 185 | |
0c7df902 JH |
186 | is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf"); |
187 | is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf"); | |
313d3d89 | 188 | |
0c7df902 JH |
189 | is(1/$PInf, 0, "one per +Inf is zero"); |
190 | is(1/$NInf, 0, "one per -Inf is zero"); | |
87821667 | 191 | |
0c7df902 JH |
192 | my ($PInfPP, $PInfMM) = ($PInf, $PInf); |
193 | my ($NInfPP, $NInfMM) = ($NInf, $NInf);; | |
194 | $PInfPP++; | |
195 | $PInfMM--; | |
196 | $NInfPP++; | |
197 | $NInfMM--; | |
198 | is($PInfPP, $PInf, "+Inf++ is +Inf"); | |
199 | is($PInfMM, $PInf, "+Inf-- is +Inf"); | |
200 | is($NInfPP, $NInf, "-Inf++ is -Inf"); | |
201 | is($NInfMM, $NInf, "-Inf-- is -Inf"); | |
38e1c50b | 202 | |
0c7df902 JH |
203 | ok($PInf, "+Inf is true"); |
204 | ok($NInf, "-Inf is true"); | |
38e1c50b | 205 | |
5bf8b78e JH |
206 | is(abs($PInf), $PInf, "abs(+Inf) is +Inf"); |
207 | is(abs($NInf), $PInf, "abs(-Inf) is +Inf"); | |
208 | ||
209 | # One could argue of NaN as the result. | |
210 | is(int($PInf), $PInf, "int(+Inf) is +Inf"); | |
211 | is(int($NInf), $NInf, "int(-Inf) is -Inf"); | |
212 | ||
0c7df902 | 213 | is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf"); |
5bf8b78e JH |
214 | # sqrt $NInf doesn't work because negative is caught |
215 | ||
0c7df902 JH |
216 | is(exp($PInf), $PInf, "exp(+Inf) is +Inf"); |
217 | is(exp($NInf), 0, "exp(-Inf) is zero"); | |
38e1c50b | 218 | |
0c7df902 | 219 | SKIP: { |
5bf8b78e JH |
220 | if ($PInf == 0) { |
221 | skip "if +Inf == 0 cannot log(+Inf)", 1; | |
222 | } | |
223 | is(log($PInf), $PInf, "log(+Inf) is +Inf"); | |
224 | } | |
225 | # log $NInf doesn't work because negative is caught | |
226 | ||
227 | is(rand($PInf), $PInf, "rand(+Inf) is +Inf"); | |
228 | is(rand($NInf), $NInf, "rand(-Inf) is -Inf"); | |
229 | ||
230 | # XXX Bit operations? | |
231 | # +Inf & 1 == +Inf? | |
232 | # +Inf | 1 == +Inf? | |
233 | # +Inf ^ 1 == +Inf? | |
234 | # ~+Inf == 0? or NaN? | |
235 | # -Inf ... ??? | |
236 | # NaN & 1 == NaN? | |
237 | # NaN | 1 == NaN? | |
238 | # NaN ^ 1 == NaN? | |
239 | # ~NaN == NaN??? | |
240 | # Or just declare insanity and die? | |
241 | ||
98efe49c JH |
242 | TODO: { |
243 | local $::TODO; | |
0c7df902 | 244 | my $here = "$^O $Config{osvers}"; |
98efe49c JH |
245 | $::TODO = "$here: pow (9**9**9) doesn't give Inf" |
246 | if $here =~ /^(?:hpux 10|os390)/; | |
0c7df902 | 247 | is(9**9**9, $PInf, "9**9**9 is Inf"); |
313d3d89 JH |
248 | } |
249 | ||
3ff98fcf | 250 | SKIP: { |
b8974fcb | 251 | my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz); |
3ff98fcf JH |
252 | if ($Config{usequadmath}) { |
253 | skip "quadmath strtoflt128() accepts false infinities", scalar @FInf; | |
254 | } | |
3ff98fcf | 255 | for my $i (@FInf) { |
3396ed30 JH |
256 | # Silence "isn't numeric in addition", that's kind of the point. |
257 | local $^W = 0; | |
258 | cmp_ok("$i" + 0, '==', $PInf, "false infinity $i"); | |
0ec38c0a JH |
259 | } |
260 | } | |
261 | ||
8d2f77d8 JH |
262 | { |
263 | # Silence "Non-finite repeat count", that is tested elsewhere. | |
264 | local $^W = 0; | |
265 | is("a" x $PInf, "", "x +Inf"); | |
266 | is("a" x $NInf, "", "x -Inf"); | |
267 | } | |
268 | ||
34c2b396 JH |
269 | { |
270 | eval 'for my $x (0..$PInf) { last }'; | |
271 | like($@, qr/Range iterator outside integer range/, "0..+Inf fails"); | |
272 | ||
273 | eval 'for my $x ($NInf..0) { last }'; | |
274 | like($@, qr/Range iterator outside integer range/, "-Inf..0 fails"); | |
275 | } | |
276 | ||
0c7df902 | 277 | # === NaN === |
38e1c50b | 278 | |
0c7df902 JH |
279 | cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)"); |
280 | ok($NaN eq $NaN, "NaN is NaN stringifically"); | |
313d3d89 | 281 | |
0c7df902 | 282 | is("$NaN", "NaN", "$NaN value stringifies as NaN"); |
313d3d89 | 283 | |
6b322424 JH |
284 | { |
285 | local $^W = 0; # warning-ness tested later. | |
286 | is("+NaN" + 0, "NaN", "+NaN is NaN"); | |
287 | is("-NaN" + 0, "NaN", "-NaN is NaN"); | |
288 | } | |
313d3d89 | 289 | |
5bf8b78e JH |
290 | is($NaN + 0, $NaN, "NaN + zero is NaN"); |
291 | ||
292 | is($NaN + 1, $NaN, "NaN + one is NaN"); | |
293 | ||
0c7df902 JH |
294 | is($NaN * 2, $NaN, "twice NaN is NaN"); |
295 | is($NaN / 2, $NaN, "half of NaN is NaN"); | |
8c12dc63 | 296 | |
5bf8b78e | 297 | is($NaN * $NaN, $NaN, "NaN * NaN is NaN"); |
db0562f0 JH |
298 | SKIP: { |
299 | if ($NaN == 0) { | |
300 | skip "NaN looks like zero, avoiding dividing by it", 1; | |
301 | } | |
302 | is($NaN / $NaN, $NaN, "NaN / NaN is NaN"); | |
303 | } | |
d06c1c80 | 304 | |
0c7df902 JH |
305 | for my $f (@printf_fmt) { |
306 | is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); | |
307 | } | |
d1877901 | 308 | |
5d801ef3 JH |
309 | is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g"); |
310 | ||
311 | is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g"); | |
312 | is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g"); | |
313 | ||
314 | is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g"); | |
315 | is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g"); | |
316 | ||
0c7df902 JH |
317 | ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef"); |
318 | like($@, qr/Cannot printf/, "$NaN sprintf fails"); | |
354b74ae FC |
319 | ok(!defined eval { $a = sprintf("%c", "NaN")}, |
320 | "sprintf %c stringy NaN undef"); | |
c1554ae1 | 321 | like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails"); |
313d3d89 | 322 | |
0c7df902 JH |
323 | ok(!defined eval { $a = chr($NaN) }, "chr NaN undef"); |
324 | like($@, qr/Cannot chr/, "NaN chr() fails"); | |
354b74ae FC |
325 | ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef"); |
326 | like($@, qr/Cannot chr/, "stringy NaN chr() fails"); | |
1cd88304 | 327 | |
0c7df902 JH |
328 | for my $f (@packi_fmt) { |
329 | ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef"); | |
330 | like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/, | |
331 | "NaN pack $f fails"); | |
354b74ae FC |
332 | ok(!defined eval { $a = pack($f, "NaN") }, |
333 | "pack $f stringy NaN undef"); | |
334 | like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/, | |
335 | "stringy NaN pack $f fails"); | |
0c7df902 | 336 | } |
1f4ef0f1 | 337 | |
0c7df902 JH |
338 | for my $f (@packf_fmt) { |
339 | ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined"); | |
340 | eval { $b = unpack($f, $a) }; | |
341 | cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN"); | |
342 | } | |
1cd88304 | 343 | |
354b74ae FC |
344 | for my $f (@packs_fmt) { |
345 | ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined"); | |
346 | is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'"); | |
347 | } | |
348 | ||
349 | is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN"; | |
350 | is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN"; | |
351 | ||
0c7df902 | 352 | for my $i (@NaN) { |
3823048b JH |
353 | cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)"); |
354 | is("@{[$i+0]}", "NaN", "$i value stringifies as NaN"); | |
0c7df902 | 355 | } |
313d3d89 | 356 | |
0c7df902 JH |
357 | ok(!($NaN < 0), "NaN is not lt zero"); |
358 | ok(!($NaN == 0), "NaN is not == zero"); | |
359 | ok(!($NaN > 0), "NaN is not gt zero"); | |
38e1c50b | 360 | |
0c7df902 JH |
361 | ok(!($NaN < $NaN), "NaN is not lt NaN"); |
362 | ok(!($NaN > $NaN), "NaN is not gt NaN"); | |
38e1c50b | 363 | |
0c7df902 JH |
364 | # is() okay with $NaN because it uses eq. |
365 | is($NaN * 0, $NaN, "NaN times zero is NaN"); | |
366 | is($NaN * 2, $NaN, "NaN times two is NaN"); | |
87821667 | 367 | |
0c7df902 JH |
368 | my ($NaNPP, $NaNMM) = ($NaN, $NaN); |
369 | $NaNPP++; | |
370 | $NaNMM--; | |
5bf8b78e JH |
371 | is($NaNPP, $NaN, "+NaN++ is NaN"); |
372 | is($NaNMM, $NaN, "+NaN-- is NaN"); | |
38e1c50b | 373 | |
0c7df902 JH |
374 | # You might find this surprising (isn't NaN kind of like of undef?) |
375 | # but this is how it is. | |
376 | ok($NaN, "NaN is true"); | |
38e1c50b | 377 | |
5bf8b78e JH |
378 | is(abs($NaN), $NaN, "abs(NaN) is NaN"); |
379 | is(int($NaN), $NaN, "int(NaN) is NaN"); | |
0c7df902 JH |
380 | is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN"); |
381 | is(exp($NaN), $NaN, "exp(NaN) is NaN"); | |
5bf8b78e JH |
382 | |
383 | SKIP: { | |
384 | if ($NaN == 0) { | |
385 | skip "if +NaN == 0 cannot log(+NaN)", 1; | |
386 | } | |
387 | is(log($NaN), $NaN, "log(NaN) is NaN"); | |
388 | } | |
389 | ||
0c7df902 | 390 | is(sin($NaN), $NaN, "sin(NaN) is NaN"); |
5bf8b78e | 391 | is(rand($NaN), $NaN, "rand(NaN) is NaN"); |
38e1c50b | 392 | |
98efe49c JH |
393 | TODO: { |
394 | local $::TODO; | |
0c7df902 | 395 | my $here = "$^O $Config{osvers}"; |
98efe49c JH |
396 | $::TODO = "$here: pow (9**9**9) doesn't give Inf" |
397 | if $here =~ /^(?:hpux 10|os390)/; | |
0c7df902 | 398 | is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN"); |
313d3d89 JH |
399 | } |
400 | ||
e855f543 JH |
401 | SKIP: { |
402 | my @FNaN = qw(NaX XNAN Ind Inx); | |
403 | # Silence "isn't numeric in addition", that's kind of the point. | |
404 | local $^W = 0; | |
405 | for my $i (@FNaN) { | |
406 | cmp_ok("$i" + 0, '==', 0, "false nan $i"); | |
407 | } | |
408 | } | |
409 | ||
8d2f77d8 JH |
410 | { |
411 | # Silence "Non-finite repeat count", that is tested elsewhere. | |
412 | local $^W = 0; | |
413 | is("a" x $NaN, "", "x NaN"); | |
414 | } | |
415 | ||
0c7df902 | 416 | # === Tests combining Inf and NaN === |
38e1c50b | 417 | |
0c7df902 JH |
418 | # is() okay with $NaN because it uses eq. |
419 | is($PInf * 0, $NaN, "Inf times zero is NaN"); | |
420 | is($PInf * $NaN, $NaN, "Inf times NaN is NaN"); | |
421 | is($PInf + $NaN, $NaN, "Inf plus NaN is NaN"); | |
422 | is($PInf - $PInf, $NaN, "Inf minus inf is NaN"); | |
423 | is($PInf / $PInf, $NaN, "Inf div inf is NaN"); | |
424 | is($PInf % $PInf, $NaN, "Inf mod inf is NaN"); | |
313d3d89 | 425 | |
0c7df902 JH |
426 | ok(!($NaN < $PInf), "NaN is not lt +Inf"); |
427 | ok(!($NaN == $PInf), "NaN is not eq +Inf"); | |
428 | ok(!($NaN > $PInf), "NaN is not gt +Inf"); | |
38e1c50b | 429 | |
5bf8b78e | 430 | ok(!($NaN < $NInf), "NaN is not lt -Inf"); |
0c7df902 | 431 | ok(!($NaN == $NInf), "NaN is not eq -Inf"); |
5bf8b78e | 432 | ok(!($NaN > $NInf), "NaN is not gt -Inf"); |
38e1c50b | 433 | |
0c7df902 | 434 | is(sin($PInf), $NaN, "sin(+Inf) is NaN"); |
38e1c50b | 435 | |
25a8018c JH |
436 | { |
437 | eval 'for my $x (0..$NaN) { last }'; | |
438 | like($@, qr/Range iterator outside integer range/, "0..NaN fails"); | |
439 | ||
440 | eval 'for my $x ($NaN..0) { last }'; | |
441 | like($@, qr/Range iterator outside integer range/, "NaN..0 fails"); | |
442 | } | |
443 | ||
7bb1ed39 JH |
444 | # === Overflows and Underflows === |
445 | ||
446 | # 1e9999 (and 1e-9999) are large (and small) enough for even | |
447 | # IEEE quadruple precision (magnitude 10**4932, and 10**-4932). | |
448 | ||
449 | cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)"); | |
450 | cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)"); | |
451 | cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)"); | |
452 | cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)"); | |
453 | cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos"); | |
454 | cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos"); | |
455 | cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg"); | |
456 | cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg"); | |
457 | ||
75a57a38 JH |
458 | # === Warnings triggered when and only when appropriate === |
459 | { | |
460 | my $w; | |
461 | local $SIG{__WARN__} = sub { $w = shift }; | |
462 | local $^W = 1; | |
463 | ||
464 | my $T = | |
465 | [ | |
466 | [ "inf", 0, $PInf ], | |
b8974fcb | 467 | [ "infinity", 0, $PInf ], |
75a57a38 JH |
468 | [ "infxy", 1, $PInf ], |
469 | [ "inf34", 1, $PInf ], | |
470 | [ "1.#INF", 0, $PInf ], | |
471 | [ "1.#INFx", 1, $PInf ], | |
472 | [ "1.#INF00", 0, $PInf ], | |
473 | [ "1.#INFxy", 1, $PInf ], | |
b489e20f JH |
474 | [ " inf", 0, $PInf ], |
475 | [ "inf ", 0, $PInf ], | |
476 | [ " inf ", 0, $PInf ], | |
75a57a38 JH |
477 | |
478 | [ "nan", 0, $NaN ], | |
479 | [ "nanxy", 1, $NaN ], | |
480 | [ "nan34", 1, $NaN ], | |
481 | [ "nanq", 0, $NaN ], | |
3823048b | 482 | [ "nans", 0, $NaN ], |
75a57a38 JH |
483 | [ "nanx", 1, $NaN ], |
484 | [ "nanqy", 1, $NaN ], | |
485 | [ "nan(123)", 0, $NaN ], | |
486 | [ "nan(0x123)", 0, $NaN ], | |
487 | [ "nan(123xy)", 1, $NaN ], | |
488 | [ "nan(0x123xy)", 1, $NaN ], | |
489 | [ "nanq(123)", 0, $NaN ], | |
99fcdd4d | 490 | [ "nan(123", 1, $NaN ], |
3823048b | 491 | [ "nan(", 1, $NaN ], |
75a57a38 JH |
492 | [ "1.#NANQ", 0, $NaN ], |
493 | [ "1.#QNAN", 0, $NaN ], | |
494 | [ "1.#NANQx", 1, $NaN ], | |
495 | [ "1.#QNANx", 1, $NaN ], | |
496 | [ "1.#IND", 0, $NaN ], | |
497 | [ "1.#IND00", 0, $NaN ], | |
498 | [ "1.#INDxy", 1, $NaN ], | |
b489e20f JH |
499 | [ " nan", 0, $NaN ], |
500 | [ "nan ", 0, $NaN ], | |
501 | [ " nan ", 0, $NaN ], | |
75a57a38 JH |
502 | ]; |
503 | ||
504 | for my $t (@$T) { | |
b489e20f | 505 | print "# '$t->[0]' compile time\n"; |
75a57a38 JH |
506 | my $a; |
507 | $w = ''; | |
508 | eval '$a = "'.$t->[0].'" + 1'; | |
509 | is("$a", "$t->[2]", "$t->[0] plus one is $t->[2]"); | |
510 | if ($t->[1]) { | |
511 | like($w, qr/^Argument \Q"$t->[0]"\E isn't numeric/, | |
3823048b | 512 | "$t->[2] numify warn"); |
75a57a38 JH |
513 | } else { |
514 | is($w, "", "no warning expected"); | |
515 | } | |
b489e20f | 516 | print "# '$t->[0]' runtime\n"; |
75a57a38 JH |
517 | my $n = $t->[0]; |
518 | my $b; | |
519 | $w = ''; | |
520 | eval '$b = $n + 1'; | |
521 | is("$b", "$t->[2]", "$n plus one is $t->[2]"); | |
522 | if ($t->[1]) { | |
523 | like($w, qr/^Argument \Q"$n"\E isn't numeric/, | |
3823048b | 524 | "$n numify warn"); |
75a57a38 JH |
525 | } else { |
526 | is($w, "", "no warning expected"); | |
527 | } | |
528 | } | |
529 | } | |
530 | ||
559a021f DM |
531 | # Size qualifiers shouldn't affect printing Inf/Nan |
532 | # | |
533 | # Prior to the commit which introduced these tests and the fix, | |
534 | # the code path taken when int-ish formats saw an Inf/Nan was to | |
535 | # jump to the floating-point handler, but then that would | |
536 | # warn about (valid) qualifiers. | |
537 | ||
538 | { | |
539 | my @w; | |
540 | local $SIG{__WARN__} = sub { push @w, $_[0] }; | |
541 | ||
84a826ef | 542 | for my $format (qw(B b c D d i O o U u X x)) { |
1fe4f5e9 DM |
543 | # skip unportable: j L q |
544 | for my $size (qw(hh h l ll t z)) { | |
559a021f DM |
545 | for my $num ($NInf, $PInf, $NaN) { |
546 | @w = (); | |
547 | my $res = eval { sprintf "%${size}${format}", $num; }; | |
548 | my $desc = "sprintf(\"%${size}${format}\", $num)"; | |
549 | if ($format eq 'c') { | |
550 | like($@, qr/Cannot printf $num with 'c'/, "$desc: like"); | |
551 | } | |
552 | else { | |
553 | is($res, $num, "$desc: equality"); | |
554 | } | |
555 | ||
556 | is (@w, 0, "$desc: warnings") | |
557 | or do { | |
558 | diag("got warning: [$_]") for map { chomp; $_} @w; | |
559 | }; | |
560 | } | |
561 | } | |
562 | } | |
563 | } | |
564 | ||
0c7df902 | 565 | done_testing(); |