[rt.perl.org #128890]: printf %a rounds incorrectly

(cherry picked from commit 75326c485e9d40be5c22d508f581cdea68b244ce)

2 files changed, 67 insertions, 29 deletions

diff --git a/sv.c b/sv.c
index 5c54b27e0b..ccc873c0ad 100644
--- a/sv.c
+++ b/sv.c
@@ -12522,39 +12522,50 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         U8* ve = (subnormal ? vlnz + 1 : vend);
                         SSize_t vn = ve - (subnormal ? vfnz : vhex);
                         if ((SSize_t)(precis + 1) < vn) {
-                            bool round;
-
-                            v = v0 + precis + 1;
-                            /* Round away from zero: if the tail
-                             * beyond the precis xdigits is equal to
-                             * or greater than 0x8000... */
-                            round = *v > 0x8;
-                            if (!round && *v == 0x8) {
-                                for (v++; v < ve; v++) {
-                                    if (*v) {
-                                        round = TRUE;
-                                        break;
-                                    }
+                            bool overflow = FALSE;
+                            if (v0[precis + 1] < 0x8) {
+                                /* Round down, nothing to do. */
+                            } else if (v[precis + 1] > 0x8) {
+                                /* Round up. */
+                                v0[precis + 1]++;
+                                overflow = v0[precis + 1] > 0xF;
+                                v0[precis + 1] &= 0xF;
+                            } else { /* v[precis + 1] == 0x8 */
+                                /* Half-point: round towards the one
+                                 * with the even least-significant digit:
+                                 * 08 -> 0  88 -> 8
+                                 * 18 -> 2  98 -> a
+                                 * 28 -> 2  a8 -> a
+                                 * 38 -> 4  b8 -> c
+                                 * 48 -> 4  c8 -> c
+                                 * 58 -> 6  d8 -> e
+                                 * 68 -> 6  e8 -> e
+                                 * 78 -> 8  f8 -> 10 */
+                                if ((v0[precis] & 0x1)) {
+                                    v0[precis]++;
                                 }
+                                overflow = v0[precis] > 0xF;
+                                v0[precis] &= 0xF;
                             }
-                            if (round) {
-                                for (v = v0 + precis; v >= v0; v--) {
-                                    if (*v < 0xF) {
-                                        (*v)++;
+
+                            if (overflow) {
+                                for (v = v0 + precis - 1; v >= v0; v--) {
+                                    (*v)++;
+                                    overflow = *v > 0xF;
+                                    (*v) &= 0xF;
+                                    if (!overflow) {
                                         break;
                                     }
-                                    *v = 0;
-                                    if (v == v0) {
-                                        /* If the carry goes all the way to
-                                         * the front, we need to output
-                                         * a single '1'. This goes against
-                                         * the "xdigit and then radix"
-                                         * but since this is "cannot happen"
-                                         * category, that is probably good. */
-                                        *p++ = xdig[1];
-                                    }
+                                }
+                                if (v == v0 && overflow) {
+                                    /* If the overflow goes all the
+                                     * way to the front, we need to
+                                     * insert 0x1 in front. */
+                                    Move(v0, v0 + 1, vn, char);
+                                    *v0 = 0x1;
                                 }
                             }
+
                             /* The new effective "last non zero". */
                             vlnz = v0 + precis;
                         }
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index c6fe652187..4c5c2495fc 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -262,7 +262,7 @@ if ($Config{nvsize} == 8 &&
     print "# no hexfloat tests\n";
 }
 
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 41;
+plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 64;
 
 use strict;
 use Config;
@@ -776,7 +776,7 @@ SKIP: {
 	[ '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-321', '%.1a', '0x1.2p-1065' ],
 	[ '3e-322', '%.1a', '0x1.ep-1069' ],
 	[ '3e-323', '%.1a', '0x1.8p-1072' ],
 	[ '3e-324', '%.1a', '0x1.0p-1074' ],
@@ -800,3 +800,30 @@ 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");