Test new hexfp fixes also on (x86 80-bit) long doubles.

(cherry picked from commit e3f7a67e8485950fdf5fd9c7131d0a78b6c8cf32)

1 files changed, 95 insertions, 74 deletions

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 15469397fe..3dfbb8dfee 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -21,6 +21,7 @@ print "# uvsize = $Config{uvsize}\n";
 print "# nvsize = $Config{nvsize}\n";
 print "# nv_preserves_uv_bits = $Config{nv_preserves_uv_bits}\n";
 print "# d_quad = $Config{d_quad}\n";
+print "# uselongdouble = $Config{uselongdouble}\n";
 if ($Config{nvsize} == 8 &&
     (
      # IEEE-754 64-bit ("double precision"), the most common out there
@@ -262,8 +263,6 @@ if ($Config{nvsize} == 8 &&
     print "# no hexfloat tests\n";
 }
 
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 71;
-
 use strict;
 use Config;
 
@@ -751,41 +750,43 @@ SKIP: {
     }
 }
 
-# [rt.perl.org #128843]
-SKIP: {
-    my @subnormals = (
-	# Keep these as strings so that non-IEEE-754 don't trip over them.
-	[ '1e-320', '%a', '0x1.fap-1064' ],
-	[ '1e-321', '%a', '0x1.94p-1067' ],
-	[ '1e-322', '%a', '0x1.4p-1070' ],
-	[ '1e-323', '%a', '0x1p-1073' ],
-	[ '1e-324', '%a', '0x0p+0' ],  # underflow
-	[ '3e-320', '%a', '0x1.7b8p-1062' ],
-	[ '3e-321', '%a', '0x1.2f8p-1065' ],
-	[ '3e-322', '%a', '0x1.e8p-1069' ],
-	[ '3e-323', '%a', '0x1.8p-1072' ],
-	[ '3e-324', '%a', '0x1p-1074' ], # the smallest possible value
-	[ '7e-320', '%a', '0x1.bacp-1061' ],
-	[ '7e-321', '%a', '0x1.624p-1064' ],
-	[ '7e-322', '%a', '0x1.1cp-1067' ],
-	[ '7e-323', '%a', '0x1.cp-1071' ],
-	[ '7e-324', '%a', '0x1p-1074' ], # the smallest possible value, again
-	[ '3e-320', '%.4a', '0x1.7b80p-1062' ],
-	[ '3e-321', '%.4a', '0x1.2f80p-1065' ],
-	[ '3e-322', '%.4a', '0x1.e800p-1069' ],
-	[ '3e-323', '%.4a', '0x1.8000p-1072' ],
-	[ '3e-324', '%.4a', '0x1.0000p-1074' ],
-	[ '3e-320', '%.1a', '0x1.8p-1062' ],
-	[ '3e-321', '%.1a', '0x1.3p-1065' ],
-	[ '3e-322', '%.1a', '0x1.ep-1069' ],
-	[ '3e-323', '%.1a', '0x1.8p-1072' ],
-	[ '3e-324', '%.1a', '0x1.0p-1074' ],
-	);
+# These are IEEE 754 64-bit subnormals (formerly known as denormals).
+# Keep these as strings so that non-IEEE-754 don't trip over them.
+my @subnormals = (
+    [ '1e-320', '%a', '0x1.fap-1064' ],
+    [ '1e-321', '%a', '0x1.94p-1067' ],
+    [ '1e-322', '%a', '0x1.4p-1070' ],
+    [ '1e-323', '%a', '0x1p-1073' ],
+    [ '1e-324', '%a', '0x0p+0' ],  # underflow
+    [ '3e-320', '%a', '0x1.7b8p-1062' ],
+    [ '3e-321', '%a', '0x1.2f8p-1065' ],
+    [ '3e-322', '%a', '0x1.e8p-1069' ],
+    [ '3e-323', '%a', '0x1.8p-1072' ],
+    [ '3e-324', '%a', '0x1p-1074' ], # the smallest possible value
+    [ '7e-320', '%a', '0x1.bacp-1061' ],
+    [ '7e-321', '%a', '0x1.624p-1064' ],
+    [ '7e-322', '%a', '0x1.1cp-1067' ],
+    [ '7e-323', '%a', '0x1.cp-1071' ],
+    [ '7e-324', '%a', '0x1p-1074' ], # the smallest possible value, again
+    [ '3e-320', '%.4a', '0x1.7b80p-1062' ],
+    [ '3e-321', '%.4a', '0x1.2f80p-1065' ],
+    [ '3e-322', '%.4a', '0x1.e800p-1069' ],
+    [ '3e-323', '%.4a', '0x1.8000p-1072' ],
+    [ '3e-324', '%.4a', '0x1.0000p-1074' ],
+    [ '3e-320', '%.1a', '0x1.8p-1062' ],
+    [ '3e-321', '%.1a', '0x1.3p-1065' ],
+    [ '3e-322', '%.1a', '0x1.ep-1069' ],
+    [ '3e-323', '%.1a', '0x1.8p-1072' ],
+    [ '3e-324', '%.1a', '0x1.0p-1074' ],
+    );
 
-    # IEEE 754 64-bit
-    skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits}, not 53",
-         scalar @subnormals + 34)
-        unless $Config{nv_preserves_uv_bits} == 53;
+SKIP: {
+    # [rt.perl.org #128843]
+    skip("non-IEEE-754-non-64-bit", scalar @subnormals + 34)
+        unless ($Config{nvsize} == 8 &&
+		$Config{nv_preserves_uv_bits} == 53 &&
+		($Config{doublekind} == 3 ||
+		 $Config{doublekind} == 4));
 
     for my $t (@subnormals) {
         my $s = sprintf($t->[1], $t->[0]);
@@ -797,42 +798,62 @@ SKIP: {
     is(sprintf("%.1a", 1.03125), "0x1.0p+0");
     is(sprintf("%.0a", 1.03125), "0x1p+0", "[rt.perl.org #128888]");
 
-   # [rt.perl.org #128889]
-   is(sprintf("%.*a", -1, 1.03125), "0x1.08p+0", "[rt.perl.org #128889]");
-
-   # [rt.perl.org #128890]
-   is(sprintf("%a", 0x1.18p+0), "0x1.18p+0");
-   is(sprintf("%.1a", 0x1.08p+0), "0x1.0p+0");
-   is(sprintf("%.1a", 0x1.18p+0), "0x1.2p+0", "[rt.perl.org #128890]");
-   is(sprintf("%.1a", 0x1.28p+0), "0x1.2p+0");
-   is(sprintf("%.1a", 0x1.38p+0), "0x1.4p+0");
-   is(sprintf("%.1a", 0x1.48p+0), "0x1.4p+0");
-   is(sprintf("%.1a", 0x1.58p+0), "0x1.6p+0");
-   is(sprintf("%.1a", 0x1.68p+0), "0x1.6p+0");
-   is(sprintf("%.1a", 0x1.78p+0), "0x1.8p+0");
-   is(sprintf("%.1a", 0x1.88p+0), "0x1.8p+0");
-   is(sprintf("%.1a", 0x1.98p+0), "0x1.ap+0");
-   is(sprintf("%.1a", 0x1.a8p+0), "0x1.ap+0");
-   is(sprintf("%.1a", 0x1.b8p+0), "0x1.cp+0");
-   is(sprintf("%.1a", 0x1.c8p+0), "0x1.cp+0");
-   is(sprintf("%.1a", 0x1.d8p+0), "0x1.ep+0");
-   is(sprintf("%.1a", 0x1.e8p+0), "0x1.ep+0");
-   is(sprintf("%.1a", 0x1.f8p+0), "0x2.0p+0");
-
-   is(sprintf("%.1a", 0x1.10p+0), "0x1.1p+0");
-   is(sprintf("%.1a", 0x1.17p+0), "0x1.1p+0");
-   is(sprintf("%.1a", 0x1.19p+0), "0x1.2p+0");
-   is(sprintf("%.1a", 0x1.1fp+0), "0x1.2p+0");
-
-   is(sprintf("%.2a", 0x1.fffp+0), "0x2.00p+0");
-   is(sprintf("%.2a", 0xf.fffp+0), "0x2.00p+3");
-
-   # [rt.perl.org #128893]
-   is(sprintf("%020a", 1.5), "0x0000000000001.8p+0");
-   is(sprintf("%020a", -1.5), "-0x000000000001.8p+0", "[rt.perl.org #128893]");
-   is(sprintf("%+020a", 1.5), "+0x000000000001.8p+0", "[rt.perl.org #128893]");
-   is(sprintf("% 020a", 1.5), " 0x000000000001.8p+0", "[rt.perl.org #128893]");
-   is(sprintf("%20a", -1.5), "           -0x1.8p+0");
-   is(sprintf("%+20a", 1.5), "           +0x1.8p+0");
-   is(sprintf("% 20a", 1.5), "            0x1.8p+0");
+    # [rt.perl.org #128889]
+    is(sprintf("%.*a", -1, 1.03125), "0x1.08p+0", "[rt.perl.org #128889]");
+
+    # [rt.perl.org #128890]
+    is(sprintf("%a", 0x1.18p+0), "0x1.18p+0");
+    is(sprintf("%.1a", 0x1.08p+0), "0x1.0p+0");
+    is(sprintf("%.1a", 0x1.18p+0), "0x1.2p+0", "[rt.perl.org #128890]");
+    is(sprintf("%.1a", 0x1.28p+0), "0x1.2p+0");
+    is(sprintf("%.1a", 0x1.38p+0), "0x1.4p+0");
+    is(sprintf("%.1a", 0x1.48p+0), "0x1.4p+0");
+    is(sprintf("%.1a", 0x1.58p+0), "0x1.6p+0");
+    is(sprintf("%.1a", 0x1.68p+0), "0x1.6p+0");
+    is(sprintf("%.1a", 0x1.78p+0), "0x1.8p+0");
+    is(sprintf("%.1a", 0x1.88p+0), "0x1.8p+0");
+    is(sprintf("%.1a", 0x1.98p+0), "0x1.ap+0");
+    is(sprintf("%.1a", 0x1.a8p+0), "0x1.ap+0");
+    is(sprintf("%.1a", 0x1.b8p+0), "0x1.cp+0");
+    is(sprintf("%.1a", 0x1.c8p+0), "0x1.cp+0");
+    is(sprintf("%.1a", 0x1.d8p+0), "0x1.ep+0");
+    is(sprintf("%.1a", 0x1.e8p+0), "0x1.ep+0");
+    is(sprintf("%.1a", 0x1.f8p+0), "0x2.0p+0");
+
+    is(sprintf("%.1a", 0x1.10p+0), "0x1.1p+0");
+    is(sprintf("%.1a", 0x1.17p+0), "0x1.1p+0");
+    is(sprintf("%.1a", 0x1.19p+0), "0x1.2p+0");
+    is(sprintf("%.1a", 0x1.1fp+0), "0x1.2p+0");
+
+    is(sprintf("%.2a", 0x1.fffp+0), "0x2.00p+0");
+    is(sprintf("%.2a", 0xf.fffp+0), "0x2.00p+3");
+
+    # [rt.perl.org #128893]
+    is(sprintf("%020a", 1.5), "0x0000000000001.8p+0");
+    is(sprintf("%020a", -1.5), "-0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("%+020a", 1.5), "+0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("% 020a", 1.5), " 0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("%20a", -1.5), "           -0x1.8p+0");
+    is(sprintf("%+20a", 1.5), "           +0x1.8p+0");
+    is(sprintf("% 20a", 1.5), "            0x1.8p+0");
 }
+
+# x86 80-bit long-double tests for
+# rt.perl.org #128843, #128888, #128889, #128890, #128893
+SKIP: {
+    skip("non-80-bit-long-double", scalar @subnormals + 34)
+        unless ($Config{uselongdouble} &&
+		($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
+		($Config{longdblkind} == 3 ||
+		 $Config{longdblkind} == 4));
+
+    is(sprintf("%.4a", 3e-320), "0xb.dc09p-1065", "[rt.perl.org #128843]");
+    is(sprintf("%.0a", 1.03125), "0x8p-3", "[rt.perl.org #128888]");
+    is(sprintf("%.*a", -1, 1.03125), "0x8.4p-3", "[rt.perl.org #128889]");
+    is(sprintf("%.1a", 0x8.18p+0), "0x8.2p+0", "[rt.perl.org #128890]");
+    is(sprintf("%020a", -1.5), "-0x0000000000000cp-3", "[rt.perl.org #128893]");
+    is(sprintf("%+020a", 1.5), "+0x0000000000000cp-3", "[rt.perl.org #128893]");
+    is(sprintf("% 020a", 1.5), " 0x0000000000000cp-3", "[rt.perl.org #128893]");
+}
+
+done_testing();