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
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
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 }
20
21 my $PInf = "Inf"  + 0;
22 my $NInf = "-Inf" + 0;
23 my $NaN;
24 {
25     local $^W = 0; # warning-ness tested later.
26     $NaN  = "NaN" + 0;
27 }
28
29 my @PInf = ("Inf", "inf", "INF", "+Inf",
30             "Infinity",
31             "1.#INF", "1#INF", "1.#INF00");
32 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
33
34 my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
35            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
36            "NAN(123)");
37
38 my @printf_fmt = qw(e f g a d u o i b x p);
39 my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
40 my @packf_fmt = qw(f d F);
41 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
42
43 if ($Config{ivsize} == 8) {
44     push @packi_fmt, qw(q Q);
45 }
46
47 if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
48     push @packf_fmt, 'D';
49 }
50
51 # === Inf tests ===
52
53 cmp_ok($PInf, '>', 0, "positive infinity");
54 cmp_ok($NInf, '<', 0, "negative infinity");
55
56 cmp_ok($PInf, '>', $NInf, "positive > negative");
57 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
58 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
59
60 is($PInf,  "Inf", "$PInf value stringifies as Inf");
61 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
62
63 cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
64 cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
65
66 cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
67 cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
68
69 cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
70 cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
71
72 cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
73 cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
74
75 cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
76 cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
77 cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
78 cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
79
80 is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
81 is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
82
83 for my $f (@printf_fmt) {
84     is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
85 }
86
87 is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g");
88 is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g");
89
90 is(sprintf("%4g",  $PInf), " Inf", "$PInf sprintf %4g");
91 is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g");
92
93 is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g");
94 is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g");
95
96 is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g");
97 is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g");
98
99 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
100 like($@, qr/Cannot printf/, "$PInf sprintf fails");
101 ok(!defined eval { $a = sprintf("%c", "Inf")},
102   "stringy sprintf %c +Inf undef");
103 like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
104
105 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
106 like($@, qr/Cannot chr/, "+Inf chr() fails");
107 ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
108 like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
109
110 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
111 like($@, qr/Cannot printf/, "$NInf sprintf fails");
112 ok(!defined eval { $a = sprintf("%c", "-Inf")},
113   "sprintf %c stringy -Inf undef");
114 like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
115
116 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
117 like($@, qr/Cannot chr/, "-Inf chr() fails");
118 ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
119 like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
120
121 for my $f (@packi_fmt) {
122     undef $a;
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");
126     undef $a;
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");
131     undef $a;
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");
135     undef $a;
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");
140 }
141
142 for my $f (@packf_fmt) {
143     undef $a;
144     undef $b;
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");
148
149     undef $a;
150     undef $b;
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 }
155
156 for my $f (@packs_fmt) {
157     undef $a;
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
161     undef $a;
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
166 is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
167 is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
168 is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
169 is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
170
171 for my $i (@PInf) {
172     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
173     cmp_ok($i, '>', 0, "$i is positive");
174     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
175 }
176
177 for my $i (@NInf) {
178     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
179     cmp_ok($i, '<', 0, "$i is negative");
180     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
181 }
182
183 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
184 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
185
186 is(1/$PInf, 0, "one per +Inf is zero");
187 is(1/$NInf, 0, "one per -Inf is zero");
188
189 my ($PInfPP, $PInfMM) = ($PInf, $PInf);
190 my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
191 $PInfPP++;
192 $PInfMM--;
193 $NInfPP++;
194 $NInfMM--;
195 is($PInfPP, $PInf, "+Inf++ is +Inf");
196 is($PInfMM, $PInf, "+Inf-- is +Inf");
197 is($NInfPP, $NInf, "-Inf++ is -Inf");
198 is($NInfMM, $NInf, "-Inf-- is -Inf");
199
200 ok($PInf, "+Inf is true");
201 ok($NInf, "-Inf is true");
202
203 is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
204 is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
205
206 # One could argue of NaN as the result.
207 is(int($PInf), $PInf, "int(+Inf) is +Inf");
208 is(int($NInf), $NInf, "int(-Inf) is -Inf");
209
210 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
211 # sqrt $NInf doesn't work because negative is caught
212
213 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
214 is(exp($NInf), 0, "exp(-Inf) is zero");
215
216 SKIP: {
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
224 is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
225 is(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
239 TODO: {
240     local $::TODO;
241     my $here = "$^O $Config{osvers}";
242     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
243         if $here =~ /^(?:hpux 10|os390)/;
244     is(9**9**9, $PInf, "9**9**9 is Inf");
245 }
246
247 SKIP: {
248     my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
249     if ($Config{usequadmath}) {
250         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
251     }
252     for my $i (@FInf) {
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");
256     }
257 }
258
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
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
274 # === NaN ===
275
276 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
277 ok($NaN eq $NaN, "NaN is NaN stringifically");
278
279 is("$NaN", "NaN", "$NaN value stringifies as NaN");
280
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 }
286
287 is($NaN + 0, $NaN, "NaN + zero is NaN");
288
289 is($NaN + 1, $NaN, "NaN + one is NaN");
290
291 is($NaN * 2, $NaN, "twice NaN is NaN");
292 is($NaN / 2, $NaN, "half of NaN is NaN");
293
294 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
295 SKIP: {
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 }
301
302 for my $f (@printf_fmt) {
303     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
304 }
305
306 is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g");
307
308 is(sprintf("%4g",  $NaN), " NaN", "$NaN sprintf %4g");
309 is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g");
310
311 is(sprintf("%+-5g", $NaN), "NaN  ", "$NaN sprintf %+-5g");
312 is(sprintf("%-+5g", $NaN), "NaN  ", "$NaN sprintf %-+5g");
313
314 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
315 like($@, qr/Cannot printf/, "$NaN sprintf fails");
316 ok(!defined eval { $a = sprintf("%c", "NaN")},
317   "sprintf %c stringy NaN undef");
318 like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
319
320 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
321 like($@, qr/Cannot chr/, "NaN chr() fails");
322 ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
323 like($@, qr/Cannot chr/, "stringy NaN chr() fails");
324
325 for 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");
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");
333 }
334
335 for 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 }
340
341 for 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
346 is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
347 is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
348
349 for my $i (@NaN) {
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     }
358 }
359
360 ok(!($NaN <  0), "NaN is not lt zero");
361 ok(!($NaN == 0), "NaN is not == zero");
362 ok(!($NaN >  0), "NaN is not gt zero");
363
364 ok(!($NaN < $NaN), "NaN is not lt NaN");
365 ok(!($NaN > $NaN), "NaN is not gt NaN");
366
367 # is() okay with $NaN because it uses eq.
368 is($NaN * 0, $NaN, "NaN times zero is NaN");
369 is($NaN * 2, $NaN, "NaN times two is NaN");
370
371 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
372 $NaNPP++;
373 $NaNMM--;
374 is($NaNPP, $NaN, "+NaN++ is NaN");
375 is($NaNMM, $NaN, "+NaN-- is NaN");
376
377 # You might find this surprising (isn't NaN kind of like of undef?)
378 # but this is how it is.
379 ok($NaN, "NaN is true");
380
381 is(abs($NaN), $NaN, "abs(NaN) is NaN");
382 is(int($NaN), $NaN, "int(NaN) is NaN");
383 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
384 is(exp($NaN), $NaN, "exp(NaN) is NaN");
385
386 SKIP: {
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
393 is(sin($NaN), $NaN, "sin(NaN) is NaN");
394 is(rand($NaN), $NaN, "rand(NaN) is NaN");
395
396 TODO: {
397     local $::TODO;
398     my $here = "$^O $Config{osvers}";
399     $::TODO = "$here: pow (9**9**9) doesn't give Inf"
400         if $here =~ /^(?:hpux 10|os390)/;
401     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
402 }
403
404 SKIP: {
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
413 {
414     # Silence "Non-finite repeat count", that is tested elsewhere.
415     local $^W = 0;
416     is("a" x $NaN, "", "x NaN");
417 }
418
419 # === Tests combining Inf and NaN ===
420
421 # is() okay with $NaN because it uses eq.
422 is($PInf * 0,     $NaN, "Inf times zero is NaN");
423 is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
424 is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
425 is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
426 is($PInf / $PInf, $NaN, "Inf div inf is NaN");
427 is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
428
429 ok(!($NaN <  $PInf), "NaN is not lt +Inf");
430 ok(!($NaN == $PInf), "NaN is not eq +Inf");
431 ok(!($NaN >  $PInf), "NaN is not gt +Inf");
432
433 ok(!($NaN <  $NInf), "NaN is not lt -Inf");
434 ok(!($NaN == $NInf), "NaN is not eq -Inf");
435 ok(!($NaN >  $NInf), "NaN is not gt -Inf");
436
437 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
438
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
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
452 cmp_ok(1e9999,     '==', $PInf, "overflow to +Inf (compile time)");
453 cmp_ok('1e9999',   '==', $PInf, "overflow to +Inf (runtime)");
454 cmp_ok(-1e9999,    '==', $NInf, "overflow to -Inf (compile time)");
455 cmp_ok('-1e9999',  '==', $NInf, "overflow to -Inf (runtime)");
456 cmp_ok(1e-9999,    '==', 0,     "underflow to 0 (compile time) from pos");
457 cmp_ok('1e-9999',  '==', 0,     "underflow to 0 (runtime) from pos");
458 cmp_ok(-1e-9999,   '==', 0,     "underflow to 0 (compile time) from neg");
459 cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
460
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 ],
470          [ "infinity",     0, $PInf ],
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 ],
477          [ " inf",         0, $PInf ],
478          [ "inf ",         0, $PInf ],
479          [ " inf ",        0, $PInf ],
480
481          [ "nan",          0, $NaN ],
482          [ "nanxy",        1, $NaN ],
483          [ "nan34",        1, $NaN ],
484          [ "nan0x34",      1, $NaN ],
485          [ "nanq",         0, $NaN ],
486          # [ "nans",         0, $NaN, $PInf ], # Odd but valid.
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 ],
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 ],
501          [ " nan",         0, $NaN ],
502          [ "nan ",         0, $NaN ],
503          [ " nan ",        0, $NaN ],
504         ];
505
506     for my $t (@$T) {
507         print "# '$t->[0]' compile time\n";
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         }
518         print "# '$t->[0]' runtime\n";
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
533 # === NaN quiet/signaling/payload ===
534
535 # The '#' or 'the alt' of printf knows how to prettyprint NaN payloads.
536
537 SKIP: {
538     # Test only on certain known platforms since the features
539     # are not that well standardized.
540     unless (
541         ((
542           $^O eq 'linux'
543           ||
544           $^O eq 'darwin' # OS X
545           ||
546           $^O eq 'freebsd'
547          )
548          &&
549         (
550          (
551           $Config{nvsize} == 8 && # double
552           $Config{doublekind} == 3 # IEEE double little-endian (x86)
553          )
554          ||
555          (
556           $Config{uselongdouble} &&
557           $Config{nvsize} == 16 && # long double
558           $Config{longdblkind} == 3 # x86 80-bit extended precision
559          )
560         ))
561         ||
562         ($^O eq 'solaris' &&
563          $Config{nvsize} == 8 && # double
564          ($Config{uvsize} == 4 # 32-bit
565           ||
566           $Config{uvsize} == 8 # 64-bit (-Duse64bitint)
567          ) &&
568          $Config{doublesize} == 8 &&
569          $Config{doublekind} == 4 # IEEE double big-endian (sparc)
570         )
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          )
585         ) {
586         my ($uselongdouble, $longdblsize, $longdblkind) =
587             $Config{uselongdouble} ?
588             ($Config{uselongdouble},
589              $Config{longdblsize},
590              $Config{longdblkind}) :
591             ('undef', 'undef', 'undef');
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);
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
600     # This weirdness brought to you courtesy of asymmetry in the IEEE spec.
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\))$/);
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
627 done_testing();