my $PInf = "Inf" + 0;
my $NInf = "-Inf" + 0;
-my $NaN = "NaN" + 0;
+my $NaN;
+{
+ local $^W = 0; # warning-ness tested later.
+ $NaN = "NaN" + 0;
+}
my @PInf = ("Inf", "inf", "INF", "+Inf",
- "Infinity", "INFINITE",
- "1.#INF", "1#INF");
+ "Infinity",
+ "1.#INF", "1#INF", "1.#INF00");
my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
- "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND",
- "NaN123", "NAN(123)", "nan%",
- "nanonano"); # RIP, Robin Williams.
+ "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
+ "NAN(123)");
my @printf_fmt = qw(e f g a d u o i b x p);
-my @packi_fmt = qw(a A Z b B h H c C s S l L i I n N v V j J w W p P u U);
+my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
my @packf_fmt = qw(f d F);
+my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
if ($Config{ivsize} == 8) {
push @packi_fmt, qw(q Q);
}
-if ($Config{uselongdouble}) {
+if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
push @packf_fmt, 'D';
}
cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
-cmp_ok($PInf * $PInf, '==', $PInf, "-Inf * +Inf is +Inf");
+cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
+cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
+cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
}
+is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g");
+is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g");
+
+is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g");
+is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g");
+
+is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g");
+is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g");
+
+is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g");
+is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g");
+
ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
like($@, qr/Cannot printf/, "$PInf sprintf fails");
+ok(!defined eval { $a = sprintf("%c", "Inf")},
+ "stringy sprintf %c +Inf undef");
+like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
like($@, qr/Cannot chr/, "+Inf chr() fails");
+ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
+like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
like($@, qr/Cannot printf/, "$NInf sprintf fails");
+ok(!defined eval { $a = sprintf("%c", "-Inf")},
+ "sprintf %c stringy -Inf undef");
+like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
like($@, qr/Cannot chr/, "-Inf chr() fails");
+ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
+like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
for my $f (@packi_fmt) {
+ undef $a;
ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
"+Inf pack $f fails");
+ undef $a;
+ ok(!defined eval { $a = pack($f, "Inf") },
+ "pack $f stringy +Inf undef");
+ like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
+ "stringy +Inf pack $f fails");
+ undef $a;
ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
"-Inf pack $f fails");
+ undef $a;
+ ok(!defined eval { $a = pack($f, "-Inf") },
+ "pack $f stringy -Inf undef");
+ like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
+ "stringy -Inf pack $f fails");
}
for my $f (@packf_fmt) {
+ undef $a;
+ undef $b;
ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
eval { $b = unpack($f, $a) };
cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
+ undef $a;
+ undef $b;
ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
eval { $b = unpack($f, $a) };
cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
}
+for my $f (@packs_fmt) {
+ undef $a;
+ ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
+ is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'");
+
+ undef $a;
+ ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
+ is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'");
+}
+
+is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
+is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
+is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
+is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
+
for my $i (@PInf) {
cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
cmp_ok($i, '>', 0, "$i is positive");
# ~NaN == NaN???
# Or just declare insanity and die?
-SKIP: {
+TODO: {
+ local $::TODO;
my $here = "$^O $Config{osvers}";
- if ($here =~ /^hpux 10/) {
- skip "$here: pow doesn't generate Inf", 1;
- }
+ $::TODO = "$here: pow (9**9**9) doesn't give Inf"
+ if $here =~ /^(?:hpux 10|os390)/;
is(9**9**9, $PInf, "9**9**9 is Inf");
}
SKIP: {
- my @FInf = qw(Info Infiniti Infinityz);
+ my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
if ($Config{usequadmath}) {
skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
}
- # Silence "isn't numeric in addition", that's kind of the point.
- local $^W = 0;
for my $i (@FInf) {
- cmp_ok("$i" + 0, '==', 0, "false infinity $i");
+ # Silence "isn't numeric in addition", that's kind of the point.
+ local $^W = 0;
+ cmp_ok("$i" + 0, '==', $PInf, "false infinity $i");
}
}
+{
+ # Silence "Non-finite repeat count", that is tested elsewhere.
+ local $^W = 0;
+ is("a" x $PInf, "", "x +Inf");
+ is("a" x $NInf, "", "x -Inf");
+}
+
+{
+ eval 'for my $x (0..$PInf) { last }';
+ like($@, qr/Range iterator outside integer range/, "0..+Inf fails");
+
+ eval 'for my $x ($NInf..0) { last }';
+ like($@, qr/Range iterator outside integer range/, "-Inf..0 fails");
+}
+
# === NaN ===
cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
is("$NaN", "NaN", "$NaN value stringifies as NaN");
-is("+NaN" + 0, "NaN", "+NaN is NaN");
-is("-NaN" + 0, "NaN", "-NaN is NaN");
+{
+ local $^W = 0; # warning-ness tested later.
+ is("+NaN" + 0, "NaN", "+NaN is NaN");
+ is("-NaN" + 0, "NaN", "-NaN is NaN");
+}
is($NaN + 0, $NaN, "NaN + zero is NaN");
is($NaN / 2, $NaN, "half of NaN is NaN");
is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
-is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
+SKIP: {
+ if ($NaN == 0) {
+ skip "NaN looks like zero, avoiding dividing by it", 1;
+ }
+ is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
+}
for my $f (@printf_fmt) {
is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
}
+is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g");
+
+is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g");
+is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g");
+
+is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g");
+is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g");
+
ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
like($@, qr/Cannot printf/, "$NaN sprintf fails");
+ok(!defined eval { $a = sprintf("%c", "NaN")},
+ "sprintf %c stringy NaN undef");
+like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
like($@, qr/Cannot chr/, "NaN chr() fails");
+ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
+like($@, qr/Cannot chr/, "stringy NaN chr() fails");
for my $f (@packi_fmt) {
ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
"NaN pack $f fails");
+ ok(!defined eval { $a = pack($f, "NaN") },
+ "pack $f stringy NaN undef");
+ like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
+ "stringy NaN pack $f fails");
}
for my $f (@packf_fmt) {
cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
}
+for my $f (@packs_fmt) {
+ ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
+ is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'");
+}
+
+is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
+is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
+
for my $i (@NaN) {
- cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
- is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
+ if (($i =~ /snan/i || $i =~ /nans/i) &&
+ (($i + 0) eq $PInf || ($i + 0 eq $NInf))) {
+ # Crazy but apparently true: signaling nan with zero payload
+ # can be Inf or -Inf on some platforms (like x86).
+ } else {
+ cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
+ is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
+ }
}
ok(!($NaN < 0), "NaN is not lt zero");
is(sin($NaN), $NaN, "sin(NaN) is NaN");
is(rand($NaN), $NaN, "rand(NaN) is NaN");
-SKIP: {
+TODO: {
+ local $::TODO;
my $here = "$^O $Config{osvers}";
- if ($here =~ /^hpux 10/) {
- skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
- }
+ $::TODO = "$here: pow (9**9**9) doesn't give Inf"
+ if $here =~ /^(?:hpux 10|os390)/;
is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
}
+SKIP: {
+ my @FNaN = qw(NaX XNAN Ind Inx);
+ # Silence "isn't numeric in addition", that's kind of the point.
+ local $^W = 0;
+ for my $i (@FNaN) {
+ cmp_ok("$i" + 0, '==', 0, "false nan $i");
+ }
+}
+
+{
+ # Silence "Non-finite repeat count", that is tested elsewhere.
+ local $^W = 0;
+ is("a" x $NaN, "", "x NaN");
+}
+
# === Tests combining Inf and NaN ===
# is() okay with $NaN because it uses eq.
is(sin($PInf), $NaN, "sin(+Inf) is NaN");
+{
+ eval 'for my $x (0..$NaN) { last }';
+ like($@, qr/Range iterator outside integer range/, "0..NaN fails");
+
+ eval 'for my $x ($NaN..0) { last }';
+ like($@, qr/Range iterator outside integer range/, "NaN..0 fails");
+}
+
+# === Overflows and Underflows ===
+
+# 1e9999 (and 1e-9999) are large (and small) enough for even
+# IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
+
+cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
+cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
+cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
+cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
+cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
+cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
+cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
+cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
+
+# === Warnings triggered when and only when appropriate ===
+{
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ local $^W = 1;
+
+ my $T =
+ [
+ [ "inf", 0, $PInf ],
+ [ "infinity", 0, $PInf ],
+ [ "infxy", 1, $PInf ],
+ [ "inf34", 1, $PInf ],
+ [ "1.#INF", 0, $PInf ],
+ [ "1.#INFx", 1, $PInf ],
+ [ "1.#INF00", 0, $PInf ],
+ [ "1.#INFxy", 1, $PInf ],
+ [ " inf", 0, $PInf ],
+ [ "inf ", 0, $PInf ],
+ [ " inf ", 0, $PInf ],
+
+ [ "nan", 0, $NaN ],
+ [ "nanxy", 1, $NaN ],
+ [ "nan34", 1, $NaN ],
+ [ "nan0x34", 1, $NaN ],
+ [ "nanq", 0, $NaN ],
+ # [ "nans", 0, $NaN, $PInf ], # Odd but valid.
+ [ "nanx", 1, $NaN ],
+ [ "nanqy", 1, $NaN ],
+ [ "nan(123)", 0, $NaN ],
+ [ "nan(0x123)", 0, $NaN ],
+ [ "nan(123xy)", 1, $NaN ],
+ [ "nan(0x123xy)", 1, $NaN ],
+ [ "nanq(123)", 0, $NaN ],
+ [ "1.#NANQ", 0, $NaN ],
+ [ "1.#QNAN", 0, $NaN ],
+ [ "1.#NANQx", 1, $NaN ],
+ [ "1.#QNANx", 1, $NaN ],
+ [ "1.#IND", 0, $NaN ],
+ [ "1.#IND00", 0, $NaN ],
+ [ "1.#INDxy", 1, $NaN ],
+ [ " nan", 0, $NaN ],
+ [ "nan ", 0, $NaN ],
+ [ " nan ", 0, $NaN ],
+ ];
+
+ for my $t (@$T) {
+ print "# '$t->[0]' compile time\n";
+ my $a;
+ $w = '';
+ eval '$a = "'.$t->[0].'" + 1';
+ is("$a", "$t->[2]", "$t->[0] plus one is $t->[2]");
+ if ($t->[1]) {
+ like($w, qr/^Argument \Q"$t->[0]"\E isn't numeric/,
+ "$t->[2] numify warn");
+ } else {
+ is($w, "", "no warning expected");
+ }
+ print "# '$t->[0]' runtime\n";
+ my $n = $t->[0];
+ my $b;
+ $w = '';
+ eval '$b = $n + 1';
+ is("$b", "$t->[2]", "$n plus one is $t->[2]");
+ if ($t->[1]) {
+ like($w, qr/^Argument \Q"$n"\E isn't numeric/,
+ "$n numify warn");
+ } else {
+ is($w, "", "no warning expected");
+ }
+ }
+}
+
+# === NaN quiet/signaling/payload ===
+
+# The '#' or 'the alt' of printf knows how to prettyprint NaN payloads.
+
+SKIP: {
+ # Test only on certain known platforms since the features
+ # are not that well standardized.
+ unless (
+ ((
+ $^O eq 'linux'
+ ||
+ $^O eq 'darwin' # OS X
+ ||
+ $^O eq 'freebsd'
+ )
+ &&
+ (
+ (
+ $Config{nvsize} == 8 && # double
+ $Config{doublekind} == 3 # IEEE double little-endian (x86)
+ )
+ ||
+ (
+ $Config{uselongdouble} &&
+ $Config{nvsize} == 16 && # long double
+ $Config{longdblkind} == 3 # x86 80-bit extended precision
+ )
+ ))
+ ||
+ ($^O eq 'solaris' &&
+ $Config{nvsize} == 8 && # double
+ ($Config{uvsize} == 4 # 32-bit
+ ||
+ $Config{uvsize} == 8 # 64-bit (-Duse64bitint)
+ ) &&
+ $Config{doublesize} == 8 &&
+ $Config{doublekind} == 4 # IEEE double big-endian (sparc)
+ )
+ ||
+ ($^O eq 'hpux' &&
+ $Config{nvsize} == 8 && # double
+ $Config{uvsize} == 4 && # 32-bit
+ $Config{doublesize} == 8 &&
+ $Config{doublekind} == 4 # IEEE double big-endian (hppa)
+ )
+ ||
+ ($^O eq 'dec_osf' && # Digital UNIX aka Tru64
+ $Config{nvsize} == 8 && # double
+ $Config{uvsize} == 8 && # 32-bit
+ $Config{doublesize} == 8 &&
+ $Config{doublekind} == 3 # IEEE double little-endian (alpha)
+ )
+ ) {
+ my ($uselongdouble, $longdblsize, $longdblkind) =
+ $Config{uselongdouble} ?
+ ($Config{uselongdouble},
+ $Config{longdblsize},
+ $Config{longdblkind}) :
+ ('undef', 'undef', 'undef');
+ 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);
+ }
+
+ is(sprintf("%#g", $NaN), "NaN(0x0)", "sprintf %#g");
+ is(sprintf("%#g", "nan"), "NaN(0x0)");
+ is(sprintf("%#g", "nanq"), "NaN(0x0)");
+ is(sprintf("%#g", "qnan"), "NaN(0x0)");
+
+ # This weirdness brought to you courtesy of asymmetry in the IEEE spec.
+ # In x86 style nans, nans(0) is equal to infinity or -infinity.
+ # In mips/hppa style, nans(0) is nans(0).
+ like(sprintf("%#g", "nans"), qr/^(?:-?Inf|NaNs\(0x0\))$/);
+ like(sprintf("%#g", "snan"), qr/^(?:-?Inf|NaNs\(0x0\))$/);
+
+ is(sprintf("%#g", "nan(12345)"), "NaN(0x3039)");
+ is(sprintf("%#g", "nan(0b101101)"), "NaN(0x2d)");
+ is(sprintf("%#g", "nan(0x12345)"), "NaN(0x12345)");
+ is(sprintf("%#g", "nanq(0x123EF)"), "NaN(0x123ef)");
+ is(sprintf("%#g", "nans(0x12345)"), "NaNs(0x12345)");
+ is(sprintf("%#g", "snan(0x12345)"), "NaNs(0x12345)");
+
+ is(sprintf("%#G", "nanq(0x123ef)"), "NaN(0X123EF)");
+
+ SKIP: {
+ if (ord('A') == 65) { # ASCII
+ is(sprintf("%#g", "nan('obot')"), "NaN(0x6f626f74)", "nanobot");
+ } elsif (ord('A') == 193) { # EBCDIC
+ is(sprintf("%#g", "nan('obot')"), "NaN(0x968296a3)", "nanobot");
+ } else {
+ skip "unknown encoding", 1;
+ }
+}
+
+}
+
done_testing();