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

(cherry picked from commit ee58923a8531731f8acb98ab130abf41f75ebdc7)

2 files changed, 11 insertions, 4 deletions

diff --git a/sv.c b/sv.c
index 69ff4aa06a..2dd0b7a54a 100644
--- a/sv.c
+++ b/sv.c
@@ -12557,12 +12557,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 6acbccf847..bbc53d1d89 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -839,9 +839,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 ||
@@ -854,6 +854,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();