avoid negative shift in scan_num()

Lengthy binaryish floating point literals used to perform illegal bit
shifts.  Ignore digits that are past the end of the significand at an
earlier stage to avoid this.  Code fix by Tony C.  Fixes [perl #131894].

diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index 29378f2..e541cad 100644 (file)
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 109);
+plan(tests => 112);
 
 # Test hexfloat literals.
 
@@ -255,6 +255,16 @@ SKIP: {
     is(0x1p-16445, 3.6451995318824746e-4951);
 }
 
+# [perl #131894] parsing long binaryish floating point literals used to
+# perform illegal bit shifts
+SKIP: {
+    skip("non-64-bit NVs", 1)
+      unless $Config{nvsize} == 8 && $Config{d_double_style_ieee};
+    is sprintf("%a", eval("0x030000000000000.1p0")), "0x1.8p+53";
+    is sprintf("%a", eval("01400000000000000000.1p0")), "0x1.8p+54";
+    is sprintf("%a", eval("0b110000000000000000000000000000000000000000000000000000000.1p0")), "0x1.8p+56";
+}
+
 # sprintf %a/%A testing is done in sprintf2.t,
 # trickier than necessary because of long doubles,
 # and because looseness of the spec.

diff --git a/toke.c b/toke.c
index 0b3e2aa..3baa520 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11091,7 +11091,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                                     hexfp_uquad <<= shift;
                                     hexfp_uquad |= b;
                                     hexfp_frac_bits += shift;
-                                } else {
+                                } else if (significant_bits - shift < NV_MANT_DIG) {
                                     /* We are at a hexdigit either at,
                                      * or straddling, the edge of mantissa.
                                      * We will try grabbing as many as