This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
infnan: test nan payload input/output
[perl5.git] / t / op / infnan.t
CommitLineData
8c12dc63 1#!./perl -w
313d3d89
JH
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
8c12dc63
JH
9use strict;
10
636a970b
JH
11use Config;
12
78c93c95
JH
13BEGIN {
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
21my $PInf = "Inf" + 0;
22my $NInf = "-Inf" + 0;
6b322424
JH
23my $NaN;
24{
25 local $^W = 0; # warning-ness tested later.
26 $NaN = "NaN" + 0;
27}
313d3d89 28
8c12dc63 29my @PInf = ("Inf", "inf", "INF", "+Inf",
b8974fcb 30 "Infinity",
fae4db12 31 "1.#INF", "1#INF", "1.#INF00");
8c12dc63 32my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
313d3d89
JH
33
34my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
fae4db12 35 "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
1e9aa12f 36 "NAN(123)");
313d3d89 37
0c7df902 38my @printf_fmt = qw(e f g a d u o i b x p);
354b74ae 39my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
0c7df902 40my @packf_fmt = qw(f d F);
354b74ae 41my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
540a63d6 42
0c7df902
JH
43if ($Config{ivsize} == 8) {
44 push @packi_fmt, qw(q Q);
45}
38e1c50b 46
3e3c2fa4 47if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
0c7df902
JH
48 push @packf_fmt, 'D';
49}
313d3d89 50
0c7df902 51# === Inf tests ===
313d3d89 52
0c7df902
JH
53cmp_ok($PInf, '>', 0, "positive infinity");
54cmp_ok($NInf, '<', 0, "negative infinity");
313d3d89 55
0c7df902
JH
56cmp_ok($PInf, '>', $NInf, "positive > negative");
57cmp_ok($NInf, '==', -$PInf, "negative == -positive");
58cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
313d3d89 59
0c7df902
JH
60is($PInf, "Inf", "$PInf value stringifies as Inf");
61is($NInf, "-Inf", "$NInf value stringifies as -Inf");
8c12dc63 62
5bf8b78e
JH
63cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
64cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
65
66cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
67cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
68
69cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
70cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
71
0c7df902
JH
72cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
73cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
313d3d89 74
00c6bd38
JH
75cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
76cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
77cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
5bf8b78e 78cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
313d3d89 79
0c7df902
JH
80is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
81is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
d06c1c80 82
0c7df902
JH
83for my $f (@printf_fmt) {
84 is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
85}
d1877901 86
5d801ef3
JH
87is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g");
88is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g");
89
90is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g");
91is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g");
92
93is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g");
94is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g");
95
96is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g");
97is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g");
98
0c7df902
JH
99ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
100like($@, qr/Cannot printf/, "$PInf sprintf fails");
354b74ae
FC
101ok(!defined eval { $a = sprintf("%c", "Inf")},
102 "stringy sprintf %c +Inf undef");
c1554ae1 103like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
313d3d89 104
0c7df902
JH
105ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
106like($@, qr/Cannot chr/, "+Inf chr() fails");
354b74ae
FC
107ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
108like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
540a63d6 109
0c7df902
JH
110ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
111like($@, qr/Cannot printf/, "$NInf sprintf fails");
354b74ae
FC
112ok(!defined eval { $a = sprintf("%c", "-Inf")},
113 "sprintf %c stringy -Inf undef");
c1554ae1 114like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
1cd88304 115
0c7df902
JH
116ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
117like($@, qr/Cannot chr/, "-Inf chr() fails");
354b74ae
FC
118ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
119like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
1cd88304 120
0c7df902 121for my $f (@packi_fmt) {
5ebb886c 122 undef $a;
0c7df902
JH
123 ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
124 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
125 "+Inf pack $f fails");
5ebb886c 126 undef $a;
354b74ae
FC
127 ok(!defined eval { $a = pack($f, "Inf") },
128 "pack $f stringy +Inf undef");
129 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
130 "stringy +Inf pack $f fails");
5ebb886c 131 undef $a;
0c7df902
JH
132 ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
133 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
134 "-Inf pack $f fails");
5ebb886c 135 undef $a;
354b74ae
FC
136 ok(!defined eval { $a = pack($f, "-Inf") },
137 "pack $f stringy -Inf undef");
138 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
139 "stringy -Inf pack $f fails");
0c7df902 140}
1f4ef0f1 141
0c7df902 142for my $f (@packf_fmt) {
5ebb886c
JH
143 undef $a;
144 undef $b;
0c7df902
JH
145 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
146 eval { $b = unpack($f, $a) };
147 cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
1f4ef0f1 148
5ebb886c
JH
149 undef $a;
150 undef $b;
0c7df902
JH
151 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
152 eval { $b = unpack($f, $a) };
153 cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
154}
1cd88304 155
354b74ae 156for my $f (@packs_fmt) {
5ebb886c 157 undef $a;
354b74ae
FC
158 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
159 is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'");
160
5ebb886c 161 undef $a;
354b74ae
FC
162 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
163 is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'");
164}
165
166is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
167is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
168is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
169is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
170
0c7df902 171for my $i (@PInf) {
8c12dc63
JH
172 cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
173 cmp_ok($i, '>', 0, "$i is positive");
313d3d89 174 is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
0c7df902 175}
313d3d89 176
0c7df902 177for my $i (@NInf) {
8c12dc63
JH
178 cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
179 cmp_ok($i, '<', 0, "$i is negative");
313d3d89 180 is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
0c7df902 181}
313d3d89 182
0c7df902
JH
183is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
184is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
313d3d89 185
0c7df902
JH
186is(1/$PInf, 0, "one per +Inf is zero");
187is(1/$NInf, 0, "one per -Inf is zero");
87821667 188
0c7df902
JH
189my ($PInfPP, $PInfMM) = ($PInf, $PInf);
190my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
191$PInfPP++;
192$PInfMM--;
193$NInfPP++;
194$NInfMM--;
195is($PInfPP, $PInf, "+Inf++ is +Inf");
196is($PInfMM, $PInf, "+Inf-- is +Inf");
197is($NInfPP, $NInf, "-Inf++ is -Inf");
198is($NInfMM, $NInf, "-Inf-- is -Inf");
38e1c50b 199
0c7df902
JH
200ok($PInf, "+Inf is true");
201ok($NInf, "-Inf is true");
38e1c50b 202
5bf8b78e
JH
203is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
204is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
205
206# One could argue of NaN as the result.
207is(int($PInf), $PInf, "int(+Inf) is +Inf");
208is(int($NInf), $NInf, "int(-Inf) is -Inf");
209
0c7df902 210is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
5bf8b78e
JH
211# sqrt $NInf doesn't work because negative is caught
212
0c7df902
JH
213is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
214is(exp($NInf), 0, "exp(-Inf) is zero");
38e1c50b 215
0c7df902 216SKIP: {
5bf8b78e
JH
217 if ($PInf == 0) {
218 skip "if +Inf == 0 cannot log(+Inf)", 1;
219 }
220 is(log($PInf), $PInf, "log(+Inf) is +Inf");
221}
222# log $NInf doesn't work because negative is caught
223
224is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
225is(rand($NInf), $NInf, "rand(-Inf) is -Inf");
226
227# XXX Bit operations?
228# +Inf & 1 == +Inf?
229# +Inf | 1 == +Inf?
230# +Inf ^ 1 == +Inf?
231# ~+Inf == 0? or NaN?
232# -Inf ... ???
233# NaN & 1 == NaN?
234# NaN | 1 == NaN?
235# NaN ^ 1 == NaN?
236# ~NaN == NaN???
237# Or just declare insanity and die?
238
98efe49c
JH
239TODO: {
240 local $::TODO;
0c7df902 241 my $here = "$^O $Config{osvers}";
98efe49c
JH
242 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
243 if $here =~ /^(?:hpux 10|os390)/;
0c7df902 244 is(9**9**9, $PInf, "9**9**9 is Inf");
313d3d89
JH
245}
246
3ff98fcf 247SKIP: {
b8974fcb 248 my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
3ff98fcf
JH
249 if ($Config{usequadmath}) {
250 skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
251 }
3ff98fcf 252 for my $i (@FInf) {
3396ed30
JH
253 # Silence "isn't numeric in addition", that's kind of the point.
254 local $^W = 0;
255 cmp_ok("$i" + 0, '==', $PInf, "false infinity $i");
0ec38c0a
JH
256 }
257}
258
8d2f77d8
JH
259{
260 # Silence "Non-finite repeat count", that is tested elsewhere.
261 local $^W = 0;
262 is("a" x $PInf, "", "x +Inf");
263 is("a" x $NInf, "", "x -Inf");
264}
265
34c2b396
JH
266{
267 eval 'for my $x (0..$PInf) { last }';
268 like($@, qr/Range iterator outside integer range/, "0..+Inf fails");
269
270 eval 'for my $x ($NInf..0) { last }';
271 like($@, qr/Range iterator outside integer range/, "-Inf..0 fails");
272}
273
0c7df902 274# === NaN ===
38e1c50b 275
0c7df902
JH
276cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
277ok($NaN eq $NaN, "NaN is NaN stringifically");
313d3d89 278
0c7df902 279is("$NaN", "NaN", "$NaN value stringifies as NaN");
313d3d89 280
6b322424
JH
281{
282 local $^W = 0; # warning-ness tested later.
283 is("+NaN" + 0, "NaN", "+NaN is NaN");
284 is("-NaN" + 0, "NaN", "-NaN is NaN");
285}
313d3d89 286
5bf8b78e
JH
287is($NaN + 0, $NaN, "NaN + zero is NaN");
288
289is($NaN + 1, $NaN, "NaN + one is NaN");
290
0c7df902
JH
291is($NaN * 2, $NaN, "twice NaN is NaN");
292is($NaN / 2, $NaN, "half of NaN is NaN");
8c12dc63 293
5bf8b78e 294is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
db0562f0
JH
295SKIP: {
296 if ($NaN == 0) {
297 skip "NaN looks like zero, avoiding dividing by it", 1;
298 }
299 is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
300}
d06c1c80 301
0c7df902
JH
302for my $f (@printf_fmt) {
303 is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
304}
d1877901 305
5d801ef3
JH
306is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g");
307
308is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g");
309is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g");
310
311is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g");
312is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g");
313
0c7df902
JH
314ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
315like($@, qr/Cannot printf/, "$NaN sprintf fails");
354b74ae
FC
316ok(!defined eval { $a = sprintf("%c", "NaN")},
317 "sprintf %c stringy NaN undef");
c1554ae1 318like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
313d3d89 319
0c7df902
JH
320ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
321like($@, qr/Cannot chr/, "NaN chr() fails");
354b74ae
FC
322ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
323like($@, qr/Cannot chr/, "stringy NaN chr() fails");
1cd88304 324
0c7df902
JH
325for my $f (@packi_fmt) {
326 ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
327 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
328 "NaN pack $f fails");
354b74ae
FC
329 ok(!defined eval { $a = pack($f, "NaN") },
330 "pack $f stringy NaN undef");
331 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
332 "stringy NaN pack $f fails");
0c7df902 333}
1f4ef0f1 334
0c7df902
JH
335for my $f (@packf_fmt) {
336 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
337 eval { $b = unpack($f, $a) };
338 cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
339}
1cd88304 340
354b74ae
FC
341for my $f (@packs_fmt) {
342 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
343 is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'");
344}
345
346is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
347is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
348
0c7df902 349for my $i (@NaN) {
c2ea8a88
JH
350 if (($i =~ /snan/i || $i =~ /nans/i) &&
351 (($i + 0) eq $PInf || ($i + 0 eq $NInf))) {
352 # Crazy but apparently true: signaling nan with zero payload
353 # can be Inf or -Inf on some platforms (like x86).
354 } else {
355 cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
356 is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
357 }
0c7df902 358}
313d3d89 359
0c7df902
JH
360ok(!($NaN < 0), "NaN is not lt zero");
361ok(!($NaN == 0), "NaN is not == zero");
362ok(!($NaN > 0), "NaN is not gt zero");
38e1c50b 363
0c7df902
JH
364ok(!($NaN < $NaN), "NaN is not lt NaN");
365ok(!($NaN > $NaN), "NaN is not gt NaN");
38e1c50b 366
0c7df902
JH
367# is() okay with $NaN because it uses eq.
368is($NaN * 0, $NaN, "NaN times zero is NaN");
369is($NaN * 2, $NaN, "NaN times two is NaN");
87821667 370
0c7df902
JH
371my ($NaNPP, $NaNMM) = ($NaN, $NaN);
372$NaNPP++;
373$NaNMM--;
5bf8b78e
JH
374is($NaNPP, $NaN, "+NaN++ is NaN");
375is($NaNMM, $NaN, "+NaN-- is NaN");
38e1c50b 376
0c7df902
JH
377# You might find this surprising (isn't NaN kind of like of undef?)
378# but this is how it is.
379ok($NaN, "NaN is true");
38e1c50b 380
5bf8b78e
JH
381is(abs($NaN), $NaN, "abs(NaN) is NaN");
382is(int($NaN), $NaN, "int(NaN) is NaN");
0c7df902
JH
383is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
384is(exp($NaN), $NaN, "exp(NaN) is NaN");
5bf8b78e
JH
385
386SKIP: {
387 if ($NaN == 0) {
388 skip "if +NaN == 0 cannot log(+NaN)", 1;
389 }
390 is(log($NaN), $NaN, "log(NaN) is NaN");
391}
392
0c7df902 393is(sin($NaN), $NaN, "sin(NaN) is NaN");
5bf8b78e 394is(rand($NaN), $NaN, "rand(NaN) is NaN");
38e1c50b 395
98efe49c
JH
396TODO: {
397 local $::TODO;
0c7df902 398 my $here = "$^O $Config{osvers}";
98efe49c
JH
399 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
400 if $here =~ /^(?:hpux 10|os390)/;
0c7df902 401 is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
313d3d89
JH
402}
403
e855f543
JH
404SKIP: {
405 my @FNaN = qw(NaX XNAN Ind Inx);
406 # Silence "isn't numeric in addition", that's kind of the point.
407 local $^W = 0;
408 for my $i (@FNaN) {
409 cmp_ok("$i" + 0, '==', 0, "false nan $i");
410 }
411}
412
8d2f77d8
JH
413{
414 # Silence "Non-finite repeat count", that is tested elsewhere.
415 local $^W = 0;
416 is("a" x $NaN, "", "x NaN");
417}
418
0c7df902 419# === Tests combining Inf and NaN ===
38e1c50b 420
0c7df902
JH
421# is() okay with $NaN because it uses eq.
422is($PInf * 0, $NaN, "Inf times zero is NaN");
423is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
424is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
425is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
426is($PInf / $PInf, $NaN, "Inf div inf is NaN");
427is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
313d3d89 428
0c7df902
JH
429ok(!($NaN < $PInf), "NaN is not lt +Inf");
430ok(!($NaN == $PInf), "NaN is not eq +Inf");
431ok(!($NaN > $PInf), "NaN is not gt +Inf");
38e1c50b 432
5bf8b78e 433ok(!($NaN < $NInf), "NaN is not lt -Inf");
0c7df902 434ok(!($NaN == $NInf), "NaN is not eq -Inf");
5bf8b78e 435ok(!($NaN > $NInf), "NaN is not gt -Inf");
38e1c50b 436
0c7df902 437is(sin($PInf), $NaN, "sin(+Inf) is NaN");
38e1c50b 438
25a8018c
JH
439{
440 eval 'for my $x (0..$NaN) { last }';
441 like($@, qr/Range iterator outside integer range/, "0..NaN fails");
442
443 eval 'for my $x ($NaN..0) { last }';
444 like($@, qr/Range iterator outside integer range/, "NaN..0 fails");
445}
446
7bb1ed39
JH
447# === Overflows and Underflows ===
448
449# 1e9999 (and 1e-9999) are large (and small) enough for even
450# IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
451
452cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
453cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
454cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
455cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
456cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
457cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
458cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
459cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
460
75a57a38
JH
461# === Warnings triggered when and only when appropriate ===
462{
463 my $w;
464 local $SIG{__WARN__} = sub { $w = shift };
465 local $^W = 1;
466
467 my $T =
468 [
469 [ "inf", 0, $PInf ],
b8974fcb 470 [ "infinity", 0, $PInf ],
75a57a38
JH
471 [ "infxy", 1, $PInf ],
472 [ "inf34", 1, $PInf ],
473 [ "1.#INF", 0, $PInf ],
474 [ "1.#INFx", 1, $PInf ],
475 [ "1.#INF00", 0, $PInf ],
476 [ "1.#INFxy", 1, $PInf ],
b489e20f
JH
477 [ " inf", 0, $PInf ],
478 [ "inf ", 0, $PInf ],
479 [ " inf ", 0, $PInf ],
75a57a38
JH
480
481 [ "nan", 0, $NaN ],
482 [ "nanxy", 1, $NaN ],
483 [ "nan34", 1, $NaN ],
c2ea8a88 484 [ "nan0x34", 1, $NaN ],
75a57a38 485 [ "nanq", 0, $NaN ],
c2ea8a88 486 # [ "nans", 0, $NaN, $PInf ], # Odd but valid.
75a57a38
JH
487 [ "nanx", 1, $NaN ],
488 [ "nanqy", 1, $NaN ],
489 [ "nan(123)", 0, $NaN ],
490 [ "nan(0x123)", 0, $NaN ],
491 [ "nan(123xy)", 1, $NaN ],
492 [ "nan(0x123xy)", 1, $NaN ],
493 [ "nanq(123)", 0, $NaN ],
75a57a38
JH
494 [ "1.#NANQ", 0, $NaN ],
495 [ "1.#QNAN", 0, $NaN ],
496 [ "1.#NANQx", 1, $NaN ],
497 [ "1.#QNANx", 1, $NaN ],
498 [ "1.#IND", 0, $NaN ],
499 [ "1.#IND00", 0, $NaN ],
500 [ "1.#INDxy", 1, $NaN ],
b489e20f
JH
501 [ " nan", 0, $NaN ],
502 [ "nan ", 0, $NaN ],
503 [ " nan ", 0, $NaN ],
75a57a38
JH
504 ];
505
506 for my $t (@$T) {
b489e20f 507 print "# '$t->[0]' compile time\n";
75a57a38
JH
508 my $a;
509 $w = '';
510 eval '$a = "'.$t->[0].'" + 1';
511 is("$a", "$t->[2]", "$t->[0] plus one is $t->[2]");
512 if ($t->[1]) {
513 like($w, qr/^Argument \Q"$t->[0]"\E isn't numeric/,
514 "$t->[2] numify warn");
515 } else {
516 is($w, "", "no warning expected");
517 }
b489e20f 518 print "# '$t->[0]' runtime\n";
75a57a38
JH
519 my $n = $t->[0];
520 my $b;
521 $w = '';
522 eval '$b = $n + 1';
523 is("$b", "$t->[2]", "$n plus one is $t->[2]");
524 if ($t->[1]) {
525 like($w, qr/^Argument \Q"$n"\E isn't numeric/,
526 "$n numify warn");
527 } else {
528 is($w, "", "no warning expected");
529 }
530 }
531}
532
29b62199
JH
533# === NaN quiet/signaling/payload ===
534
535# The '#' or 'the alt' of printf knows how to prettyprint NaN payloads.
536
537SKIP: {
538 # Test only on certain known platforms since the features
539 # are not that well standardized.
540 unless (
c2ea8a88 541 ((
29b62199
JH
542 $^O eq 'linux'
543 ||
544 $^O eq 'darwin' # OS X
545 ||
546 $^O eq 'freebsd'
547 )
548 &&
549 (
550 (
c2ea8a88 551 $Config{nvsize} == 8 && # double
29b62199
JH
552 $Config{doublekind} == 3 # IEEE double little-endian (x86)
553 )
554 ||
555 (
c2ea8a88
JH
556 $Config{uselongdouble} &&
557 $Config{nvsize} == 16 && # long double
29b62199
JH
558 $Config{longdblkind} == 3 # x86 80-bit extended precision
559 )
c2ea8a88 560 ))
29b62199 561 ||
c2ea8a88 562 ($^O eq 'solaris' &&
29b62199 563 $Config{nvsize} == 8 && # double
c2ea8a88 564 ($Config{uvsize} == 4 # 32-bit
29b62199
JH
565 ||
566 $Config{uvsize} == 8 # 64-bit (-Duse64bitint)
567 ) &&
568 $Config{doublesize} == 8 &&
569 $Config{doublekind} == 4 # IEEE double big-endian (sparc)
570 )
c2ea8a88
JH
571 ||
572 ($^O eq 'hpux' &&
573 $Config{nvsize} == 8 && # double
574 $Config{uvsize} == 4 && # 32-bit
575 $Config{doublesize} == 8 &&
576 $Config{doublekind} == 4 # IEEE double big-endian (hppa)
577 )
578 ||
579 ($^O eq 'dec_osf' && # Digital UNIX aka Tru64
580 $Config{nvsize} == 8 && # double
581 $Config{uvsize} == 8 && # 32-bit
582 $Config{doublesize} == 8 &&
583 $Config{doublekind} == 3 # IEEE double little-endian (alpha)
584 )
29b62199
JH
585 ) {
586 my ($uselongdouble, $longdblsize, $longdblkind) =
587 $Config{uselongdouble} ?
588 ($Config{uselongdouble},
589 $Config{longdblsize},
590 $Config{longdblkind}) :
591 ('undef', 'undef', 'undef');
c2ea8a88 592 skip("skipping NaN specials testing on os=$^O, uvsize=$Config{uvsize}, nvsize=$Config{nvsize}, doublesize=$Config{doublesize}, doublekind=$Config{doublekind}, uselongdouble=$uselongdouble, longdblsize=$longdblsize, longdblkind=$longdblkind", 16);
29b62199
JH
593 }
594
595 is(sprintf("%#g", $NaN), "NaN(0x0)", "sprintf %#g");
596 is(sprintf("%#g", "nan"), "NaN(0x0)");
597 is(sprintf("%#g", "nanq"), "NaN(0x0)");
598 is(sprintf("%#g", "qnan"), "NaN(0x0)");
599
29b62199 600 # This weirdness brought to you courtesy of asymmetry in the IEEE spec.
c2ea8a88
JH
601 # In x86 style nans, nans(0) is equal to infinity or -infinity.
602 # In mips/hppa style, nans(0) is nans(0).
603 like(sprintf("%#g", "nans"), qr/^(?:-?Inf|NaNs\(0x0\))$/);
604 like(sprintf("%#g", "snan"), qr/^(?:-?Inf|NaNs\(0x0\))$/);
29b62199
JH
605
606 is(sprintf("%#g", "nan(12345)"), "NaN(0x3039)");
607 is(sprintf("%#g", "nan(0b101101)"), "NaN(0x2d)");
608 is(sprintf("%#g", "nan(0x12345)"), "NaN(0x12345)");
609 is(sprintf("%#g", "nanq(0x123EF)"), "NaN(0x123ef)");
610 is(sprintf("%#g", "nans(0x12345)"), "NaNs(0x12345)");
611 is(sprintf("%#g", "snan(0x12345)"), "NaNs(0x12345)");
612
613 is(sprintf("%#G", "nanq(0x123ef)"), "NaN(0X123EF)");
614
615 SKIP: {
616 if (ord('A') == 65) { # ASCII
617 is(sprintf("%#g", "nan('obot')"), "NaN(0x6f626f74)", "nanobot");
618 } elsif (ord('A') == 193) { # EBCDIC
619 is(sprintf("%#g", "nan('obot')"), "NaN(0x968296a3)", "nanobot");
620 } else {
621 skip "unknown encoding", 1;
622 }
623}
624
625}
626
0c7df902 627done_testing();