Update Time-HiRes Changes for 1.9760
[perl.git] / t / op / infnan.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use strict;
10
11 use Config;
12
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     unless ($Config{d_double_has_inf} && $Config{d_double_has_nan}) {
20         skip_all "the doublekind $Config{doublekind} does not have inf/nan";
21     }
22 }
23
24 my $PInf = "Inf"  + 0;
25 my $NInf = "-Inf" + 0;
26 my $NaN;
27 {
28     local $^W = 0; # warning-ness tested later.
29     $NaN  = "NaN" + 0;
30 }
31
32 my @PInf = ("Inf", "inf", "INF", "+Inf",
33             "Infinity",
34             "1.#INF", "1#INF", "1.#INF00");
35 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
36
37 my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
38            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
39            "NAN(123)");
40
41 my @printf_fmt = qw(e f g a d u o i b x);
42 my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
43 my @packf_fmt = qw(f d F);
44 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
45
46 if ($Config{ivsize} == 8) {
47     push @packi_fmt, qw(q Q);
48 }
49
50 if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
51     push @packf_fmt, 'D';
52 }
53
54 # === Inf tests ===
55
56 cmp_ok($PInf, '>', 0, "positive infinity");
57 cmp_ok($NInf, '<', 0, "negative infinity");
58
59 cmp_ok($PInf, '>', $NInf, "positive > negative");
60 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
61 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
62
63 is($PInf,  "Inf", "$PInf value stringifies as Inf");
64 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
65
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
75 cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
76 cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
77
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");
81 cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
82
83 is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
84 is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
85
86 for my $f (@printf_fmt) {
87     is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
88 }
89
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
102 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
103 like($@, qr/Cannot printf/, "$PInf sprintf fails");
104 ok(!defined eval { $a = sprintf("%c", "Inf")},
105   "stringy sprintf %c +Inf undef");
106 like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
107
108 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
109 like($@, qr/Cannot chr/, "+Inf chr() fails");
110 ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
111 like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
112
113 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
114 like($@, qr/Cannot printf/, "$NInf sprintf fails");
115 ok(!defined eval { $a = sprintf("%c", "-Inf")},
116   "sprintf %c stringy -Inf undef");
117 like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
118
119 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
120 like($@, qr/Cannot chr/, "-Inf chr() fails");
121 ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
122 like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
123
124 for my $f (@packi_fmt) {
125     undef $a;
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");
129     undef $a;
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");
134     undef $a;
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");
138     undef $a;
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");
143 }
144
145 for my $f (@packf_fmt) {
146     undef $a;
147     undef $b;
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");
151
152     undef $a;
153     undef $b;
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 }
158
159 for my $f (@packs_fmt) {
160     undef $a;
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
164     undef $a;
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
174 for my $i (@PInf) {
175     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
176     cmp_ok($i, '>', 0, "$i is positive");
177     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
178 }
179
180 for my $i (@NInf) {
181     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
182     cmp_ok($i, '<', 0, "$i is negative");
183     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
184 }
185
186 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
187 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
188
189 is(1/$PInf, 0, "one per +Inf is zero");
190 is(1/$NInf, 0, "one per -Inf is zero");
191
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");
202
203 ok($PInf, "+Inf is true");
204 ok($NInf, "-Inf is true");
205
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
213 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
214 # sqrt $NInf doesn't work because negative is caught
215
216 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
217 is(exp($NInf), 0, "exp(-Inf) is zero");
218
219 SKIP: {
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
242 TODO: {
243     local $::TODO;
244     my $here = "$^O $Config{osvers}";
245     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
246         if $here =~ /^(?:hpux 10|os390)/;
247     is(9**9**9, $PInf, "9**9**9 is Inf");
248 }
249
250 SKIP: {
251     my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
252     if ($Config{usequadmath}) {
253         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
254     }
255     for my $i (@FInf) {
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");
259     }
260 }
261
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
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
277 # === NaN ===
278
279 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
280 ok($NaN eq $NaN, "NaN is NaN stringifically");
281
282 is("$NaN", "NaN", "$NaN value stringifies as NaN");
283
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 }
289
290 is($NaN + 0, $NaN, "NaN + zero is NaN");
291
292 is($NaN + 1, $NaN, "NaN + one is NaN");
293
294 is($NaN * 2, $NaN, "twice NaN is NaN");
295 is($NaN / 2, $NaN, "half of NaN is NaN");
296
297 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
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 }
304
305 for my $f (@printf_fmt) {
306     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
307 }
308
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
317 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
318 like($@, qr/Cannot printf/, "$NaN sprintf fails");
319 ok(!defined eval { $a = sprintf("%c", "NaN")},
320   "sprintf %c stringy NaN undef");
321 like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
322
323 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
324 like($@, qr/Cannot chr/, "NaN chr() fails");
325 ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
326 like($@, qr/Cannot chr/, "stringy NaN chr() fails");
327
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");
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");
336 }
337
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 }
343
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
352 for my $i (@NaN) {
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");
355 }
356
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");
360
361 ok(!($NaN < $NaN), "NaN is not lt NaN");
362 ok(!($NaN > $NaN), "NaN is not gt NaN");
363
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");
367
368 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
369 $NaNPP++;
370 $NaNMM--;
371 is($NaNPP, $NaN, "+NaN++ is NaN");
372 is($NaNMM, $NaN, "+NaN-- is NaN");
373
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");
377
378 is(abs($NaN), $NaN, "abs(NaN) is NaN");
379 is(int($NaN), $NaN, "int(NaN) is NaN");
380 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
381 is(exp($NaN), $NaN, "exp(NaN) is NaN");
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
390 is(sin($NaN), $NaN, "sin(NaN) is NaN");
391 is(rand($NaN), $NaN, "rand(NaN) is NaN");
392
393 TODO: {
394     local $::TODO;
395     my $here = "$^O $Config{osvers}";
396     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
397         if $here =~ /^(?:hpux 10|os390)/;
398     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
399 }
400
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
410 {
411     # Silence "Non-finite repeat count", that is tested elsewhere.
412     local $^W = 0;
413     is("a" x $NaN, "", "x NaN");
414 }
415
416 # === Tests combining Inf and NaN ===
417
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");
425
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");
429
430 ok(!($NaN <  $NInf), "NaN is not lt -Inf");
431 ok(!($NaN == $NInf), "NaN is not eq -Inf");
432 ok(!($NaN >  $NInf), "NaN is not gt -Inf");
433
434 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
435
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
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
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 ],
467          [ "infinity",     0, $PInf ],
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 ],
474          [ " inf",         0, $PInf ],
475          [ "inf ",         0, $PInf ],
476          [ " inf ",        0, $PInf ],
477
478          [ "nan",          0, $NaN ],
479          [ "nanxy",        1, $NaN ],
480          [ "nan34",        1, $NaN ],
481          [ "nanq",         0, $NaN ],
482          [ "nans",         0, $NaN ],
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 ],
490          [ "nan(123",      1, $NaN ],
491          [ "nan(",         1, $NaN ],
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 ],
499          [ " nan",         0, $NaN ],
500          [ "nan ",         0, $NaN ],
501          [ " nan ",        0, $NaN ],
502         ];
503
504     for my $t (@$T) {
505         print "# '$t->[0]' compile time\n";
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/,
512                  "$t->[2] numify warn");
513         } else {
514             is($w, "", "no warning expected");
515         }
516         print "# '$t->[0]' runtime\n";
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/,
524                  "$n numify warn");
525         } else {
526             is($w, "", "no warning expected");
527         }
528     }
529 }
530
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
542     for my $format (qw(B b c D d i O o U u X x)) {
543         # skip unportable: j L q
544         for my $size (qw(hh h 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
565 done_testing();