[rt.perl.org #128909] printf %a mishandles exponent-crossing rounding with long double

diff --git a/sv.c b/sv.c
index ae70d7b..467af34 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12549,12 +12549,14 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                                         break;
                                     }
                                 }
-                                if (v == v0 && overflow) {
+                                if (v == v0 - 1 && overflow) {
                                     /* If the overflow goes all the
                                      * way to the front, we need to
-                                     * insert 0x1 in front. */
+                                     * insert 0x1 in front, and adjust
+                                     * the argument. */
                                     Move(v0, v0 + 1, vn, char);
                                     *v0 = 0x1;
+                                    exponent += 4;
                                 }
                             }
 

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 1dcfa93..7116e4c 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -849,9 +849,9 @@ SKIP: {
 }
 
 # x86 80-bit long-double tests for
-# rt.perl.org #128843, #128888, #128889, #128890, #128893
+# rt.perl.org #128843, #128888, #128889, #128890, #128893, #128909
 SKIP: {
-    skip("non-80-bit-long-double", 7)
+    skip("non-80-bit-long-double", 12)
         unless ($Config{uselongdouble} &&
                ($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
                ($Config{longdblkind} == 3 ||
@@ -864,6 +864,11 @@ SKIP: {
     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");
 }
 
 done_testing();