This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_sv_vcatpvfn_flags: %p and Inf/Nan
[perl5.git] / t / op / infnan.t
CommitLineData
8c12dc63 1#!./perl -w
313d3d89
JH
2
3BEGIN {
4 chdir 't' if -d 't';
313d3d89 5 require './test.pl';
624c42e2 6 set_up_inc('../lib');
313d3d89
JH
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 }
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
24my $PInf = "Inf" + 0;
25my $NInf = "-Inf" + 0;
6b322424
JH
26my $NaN;
27{
28 local $^W = 0; # warning-ness tested later.
29 $NaN = "NaN" + 0;
30}
313d3d89 31
8c12dc63 32my @PInf = ("Inf", "inf", "INF", "+Inf",
b8974fcb 33 "Infinity",
fae4db12 34 "1.#INF", "1#INF", "1.#INF00");
8c12dc63 35my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
313d3d89
JH
36
37my @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 41my @printf_fmt = qw(e f g a d u o i b x);
354b74ae 42my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
0c7df902 43my @packf_fmt = qw(f d F);
354b74ae 44my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
540a63d6 45
0c7df902
JH
46if ($Config{ivsize} == 8) {
47 push @packi_fmt, qw(q Q);
48}
38e1c50b 49
3e3c2fa4 50if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
0c7df902
JH
51 push @packf_fmt, 'D';
52}
313d3d89 53
0c7df902 54# === Inf tests ===
313d3d89 55
0c7df902
JH
56cmp_ok($PInf, '>', 0, "positive infinity");
57cmp_ok($NInf, '<', 0, "negative infinity");
313d3d89 58
0c7df902
JH
59cmp_ok($PInf, '>', $NInf, "positive > negative");
60cmp_ok($NInf, '==', -$PInf, "negative == -positive");
61cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
313d3d89 62
0c7df902
JH
63is($PInf, "Inf", "$PInf value stringifies as Inf");
64is($NInf, "-Inf", "$NInf value stringifies as -Inf");
8c12dc63 65
5bf8b78e
JH
66cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
67cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
68
69cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
70cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
71
72cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
73cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
74
0c7df902
JH
75cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
76cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
313d3d89 77
00c6bd38
JH
78cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
79cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
80cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
5bf8b78e 81cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
313d3d89 82
0c7df902
JH
83is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
84is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
d06c1c80 85
0c7df902
JH
86for my $f (@printf_fmt) {
87 is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
88}
d1877901 89
5d801ef3
JH
90is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g");
91is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g");
92
93is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g");
94is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g");
95
96is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g");
97is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g");
98
99is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g");
100is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g");
101
0c7df902
JH
102ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
103like($@, qr/Cannot printf/, "$PInf sprintf fails");
354b74ae
FC
104ok(!defined eval { $a = sprintf("%c", "Inf")},
105 "stringy sprintf %c +Inf undef");
c1554ae1 106like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
313d3d89 107
0c7df902
JH
108ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
109like($@, qr/Cannot chr/, "+Inf chr() fails");
354b74ae
FC
110ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
111like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
540a63d6 112
0c7df902
JH
113ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
114like($@, qr/Cannot printf/, "$NInf sprintf fails");
354b74ae
FC
115ok(!defined eval { $a = sprintf("%c", "-Inf")},
116 "sprintf %c stringy -Inf undef");
c1554ae1 117like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
1cd88304 118
0c7df902
JH
119ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
120like($@, qr/Cannot chr/, "-Inf chr() fails");
354b74ae
FC
121ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
122like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
1cd88304 123
0c7df902 124for 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 145for 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 159for 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
169is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
170is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
171is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
172is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
173
0c7df902 174for 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 180for 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
186is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
187is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
313d3d89 188
0c7df902
JH
189is(1/$PInf, 0, "one per +Inf is zero");
190is(1/$NInf, 0, "one per -Inf is zero");
87821667 191
0c7df902
JH
192my ($PInfPP, $PInfMM) = ($PInf, $PInf);
193my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
194$PInfPP++;
195$PInfMM--;
196$NInfPP++;
197$NInfMM--;
198is($PInfPP, $PInf, "+Inf++ is +Inf");
199is($PInfMM, $PInf, "+Inf-- is +Inf");
200is($NInfPP, $NInf, "-Inf++ is -Inf");
201is($NInfMM, $NInf, "-Inf-- is -Inf");
38e1c50b 202
0c7df902
JH
203ok($PInf, "+Inf is true");
204ok($NInf, "-Inf is true");
38e1c50b 205
5bf8b78e
JH
206is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
207is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
208
209# One could argue of NaN as the result.
210is(int($PInf), $PInf, "int(+Inf) is +Inf");
211is(int($NInf), $NInf, "int(-Inf) is -Inf");
212
0c7df902 213is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
5bf8b78e
JH
214# sqrt $NInf doesn't work because negative is caught
215
0c7df902
JH
216is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
217is(exp($NInf), 0, "exp(-Inf) is zero");
38e1c50b 218
0c7df902 219SKIP: {
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
227is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
228is(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
242TODO: {
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 250SKIP: {
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
279cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
280ok($NaN eq $NaN, "NaN is NaN stringifically");
313d3d89 281
0c7df902 282is("$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
290is($NaN + 0, $NaN, "NaN + zero is NaN");
291
292is($NaN + 1, $NaN, "NaN + one is NaN");
293
0c7df902
JH
294is($NaN * 2, $NaN, "twice NaN is NaN");
295is($NaN / 2, $NaN, "half of NaN is NaN");
8c12dc63 296
5bf8b78e 297is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
db0562f0
JH
298SKIP: {
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
305for my $f (@printf_fmt) {
306 is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
307}
d1877901 308
5d801ef3
JH
309is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g");
310
311is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g");
312is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g");
313
314is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g");
315is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g");
316
0c7df902
JH
317ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
318like($@, qr/Cannot printf/, "$NaN sprintf fails");
354b74ae
FC
319ok(!defined eval { $a = sprintf("%c", "NaN")},
320 "sprintf %c stringy NaN undef");
c1554ae1 321like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
313d3d89 322
0c7df902
JH
323ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
324like($@, qr/Cannot chr/, "NaN chr() fails");
354b74ae
FC
325ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
326like($@, qr/Cannot chr/, "stringy NaN chr() fails");
1cd88304 327
0c7df902
JH
328for 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
338for 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
344for 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
349is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
350is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
351
0c7df902 352for 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
357ok(!($NaN < 0), "NaN is not lt zero");
358ok(!($NaN == 0), "NaN is not == zero");
359ok(!($NaN > 0), "NaN is not gt zero");
38e1c50b 360
0c7df902
JH
361ok(!($NaN < $NaN), "NaN is not lt NaN");
362ok(!($NaN > $NaN), "NaN is not gt NaN");
38e1c50b 363
0c7df902
JH
364# is() okay with $NaN because it uses eq.
365is($NaN * 0, $NaN, "NaN times zero is NaN");
366is($NaN * 2, $NaN, "NaN times two is NaN");
87821667 367
0c7df902
JH
368my ($NaNPP, $NaNMM) = ($NaN, $NaN);
369$NaNPP++;
370$NaNMM--;
5bf8b78e
JH
371is($NaNPP, $NaN, "+NaN++ is NaN");
372is($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.
376ok($NaN, "NaN is true");
38e1c50b 377
5bf8b78e
JH
378is(abs($NaN), $NaN, "abs(NaN) is NaN");
379is(int($NaN), $NaN, "int(NaN) is NaN");
0c7df902
JH
380is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
381is(exp($NaN), $NaN, "exp(NaN) is NaN");
5bf8b78e
JH
382
383SKIP: {
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 390is(sin($NaN), $NaN, "sin(NaN) is NaN");
5bf8b78e 391is(rand($NaN), $NaN, "rand(NaN) is NaN");
38e1c50b 392
98efe49c
JH
393TODO: {
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
401SKIP: {
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.
419is($PInf * 0, $NaN, "Inf times zero is NaN");
420is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
421is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
422is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
423is($PInf / $PInf, $NaN, "Inf div inf is NaN");
424is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
313d3d89 425
0c7df902
JH
426ok(!($NaN < $PInf), "NaN is not lt +Inf");
427ok(!($NaN == $PInf), "NaN is not eq +Inf");
428ok(!($NaN > $PInf), "NaN is not gt +Inf");
38e1c50b 429
5bf8b78e 430ok(!($NaN < $NInf), "NaN is not lt -Inf");
0c7df902 431ok(!($NaN == $NInf), "NaN is not eq -Inf");
5bf8b78e 432ok(!($NaN > $NInf), "NaN is not gt -Inf");
38e1c50b 433
0c7df902 434is(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
449cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
450cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
451cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
452cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
453cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
454cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
455cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
456cmp_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)) {
559a021f
DM
543 # skip unportable: j
544 for my $size (qw(hh h l q L ll t z)) {
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 565done_testing();