perl #126586 hexfp may lose 1-3 low order bits (most often, 1)

(cherry picked from commit 96524c28e76cdc1099eebc2832aef5b789ebbc11)

2 files changed, 57 insertions, 2 deletions

diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index e83050e348..c9f9e39cbd 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 85);
+plan(tests => 97);
 
 # Test hexfloat literals.
 
@@ -187,9 +187,39 @@ SKIP:
         eval '$a = 0x111.00000000000000p+0';  # 14 zeros.
         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
         is($a, 273);
+
+        undef $a;
+        eval '$a = 0xfffffffffffffp0';  # 52 bits.
+        is(get_warn(), undef);
+        is($a, 4.5035996273705e+15);
+
+        undef $a;
+        eval '$a = 0xfffffffffffff.8p0';  # 53 bits.
+        is(get_warn(), undef);
+        is($a, 4.5035996273705e+15);
+
+        undef $a;
+        eval '$a = 0xfffffffffffff.cp0';  # 54 bits.
+        like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
+        is($a, 4.5035996273705e+15);
+
+        undef $a;
+        eval '$a = 0xf.ffffffffffffp0';  # 52 bits.
+        is(get_warn(), undef);
+        is($a, 16);
+
+        undef $a;
+        eval '$a = 0xf.ffffffffffff8p0';  # 53 bits.
+        is(get_warn(), undef);
+        is($a, 16);
+
+        undef $a;
+        eval '$a = 0xf.ffffffffffffcp0';  # 54 bits.
+        like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
+        is($a, 16);
     } else {
         print "# skipping warning tests\n";
-        skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 14;
+        skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 26;
     }
 }
 
diff --git a/toke.c b/toke.c
index ecd2812f54..dd9d32644d 100644
--- a/toke.c
+++ b/toke.c
@@ -10245,6 +10245,31 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                                 hexfp_nv += b * mult;
                                 mult /= 16.0;
 #endif
+                            } else if (total_bits - shift < NV_MANT_DIG) {
+                                /* A hexdigit straddling the edge of
+                                 * mantissa.  We can try grabbing as
+                                 * many as possible bits. */
+                                int shift2 = 0;
+                                if (b & 1) {
+                                    shift2 = 4;
+                                } else if (b & 2) {
+                                    shift2 = 3;
+                                    total_bits--;
+                                } else if (b & 4) {
+                                    shift2 = 2;
+                                    total_bits -= 2;
+                                } else if (b & 8) {
+                                    shift2 = 1;
+                                    total_bits -= 3;
+                                }
+#ifdef HEXFP_UQUAD
+                                hexfp_uquad <<= shift2;
+                                hexfp_uquad |= b;
+                                hexfp_frac_bits += shift2;
+#else /* HEXFP_NV */
+                                hexfp_nv += b * mult;
+                                mult /= 16.0;
+#endif
                             }
                         }
                     }