This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Test subnormals with quadmath
[perl5.git] / t / op / sprintf2.t
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index d281850..016a2d6 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }   
 
 # We'll run 12 extra tests (see below) if $Q is false.
@@ -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} // 'undef') . "\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;
 
@@ -299,7 +298,7 @@ for my $i (1, 3, 5, 10) {
 # Used to mangle PL_sv_undef
 fresh_perl_like(
     'print sprintf "xxx%n\n"; print undef',
-    qr/Modification of a read-only value attempted at - line 1\./,
+    qr/Modification of a read-only value attempted at\b/,
     { switches => [ '-w' ] },
     q(%n should not be able to modify read-only constants),
 );
@@ -761,44 +760,54 @@ 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' ],
+    [ '0x1.fffffffffffffp-1022', '%a', '0x1.fffffffffffffp-1022' ],
+    [ '0x0.fffffffffffffp-1022', '%a', '0x1.ffffffffffffep-1023' ],
+    [ '0x0.7ffffffffffffp-1022', '%a', '0x1.ffffffffffffcp-1024' ],
+    [ '0x0.3ffffffffffffp-1022', '%a', '0x1.ffffffffffff8p-1025' ],
+    [ '0x0.1ffffffffffffp-1022', '%a', '0x1.ffffffffffffp-1026' ],
+    [ '0x0.0ffffffffffffp-1022', '%a', '0x1.fffffffffffep-1027' ],
+    );
 
-    # 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]);
+       # Note that "0x1p+2" is not considered numeric,
+       # since neither is "0x12", hence the eval.
+        my $s = sprintf($t->[1], eval $t->[0]);
         is($s, $t->[2], "subnormal @$t got $s");
     }
 
@@ -807,42 +816,102 @@ 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, #128909
+SKIP: {
+    skip("non-80-bit-long-double", 17)
+        unless ($Config{uselongdouble} &&
+               ($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
+               ($Config{longdblkind} == 3 ||
+                $Config{longdblkind} == 4));
+
+    {
+        # The last normal for this format.
+       is(sprintf("%a", eval '0x1p-16382'), "0x8p-16385", "[rt.perl.org #128843]");
+
+       # The subnormals cause "exponent underflow" warnings,
+        # but that is not why we are here.
+       local $SIG{__WARN__} = sub {
+           die "$0: $_[0]" unless $_[0] =~ /exponent underflow/;
+       };
+
+       is(sprintf("%a", eval '0x1p-16383'), "0x4p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16384'), "0x2p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16385'), "0x1p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16386'), "0x8p-16386", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16387'), "0x4p-16386", "[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]");
+    is(sprintf("%a", 1.9999999999999999999), "0xf.fffffffffffffffp-3");
+    is(sprintf("%.3a", 1.9999999999999999999), "0x1.000p+1", "[rt.perl.org #128909]");
+    is(sprintf("%.2a", 1.9999999999999999999), "0x1.00p+1");
+    is(sprintf("%.1a", 1.9999999999999999999), "0x1.0p+1");
+    is(sprintf("%.0a", 1.9999999999999999999), "0x1p+1");
+}
+
+# quadmath tests for rt.perl.org #128843
+SKIP: {
+    skip "need quadmath", 7, unless $Config{usequadmath};
+
+    is(sprintf("%a", eval '0x1p-16382'), '0x1p-16382');  # last normal
+
+    local $SIG{__WARN__} = sub {
+        die "$0: $_[0]" unless $_[0] =~ /exponent underflow/;
+    };
+
+    is(sprintf("%a", eval '0x1p-16383'), '0x1p-16383');
+    is(sprintf("%a", eval '0x1p-16384'), '0x1p-16384');
+
+    is(sprintf("%a", eval '0x1p-16491'), '0x1p-16491');
+    is(sprintf("%a", eval '0x1p-16492'), '0x1p-16492');
+    is(sprintf("%a", eval '0x1p-16493'), '0x1p-16493'); # last denormal
+
+    is(sprintf("%a", eval '0x1p-16494'), '0x1p-16494'); # underflow
 }
+
+done_testing();
Unnamed repository; edit this file 'description' to name the repository.