[perl #127183] Non-canonical hexadecimal floats are parsed prematurely

5.22.1 regression from 5.22.0.

Rewriting the hexfp fractional digits parsing to handle the
trickiness of having to ignore both the leading and trailing
zero bits when determining how many bits were actually given.

2 files changed, 54 insertions, 2 deletions

diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index c9f9e39cbd..4b2a96d051 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 97);
+plan(tests => 105);
 
 # Test hexfloat literals.
 
@@ -40,6 +40,11 @@ is(0x0.1p0, 0.0625);
 is(0x0.10p0, 0.0625);
 is(0x0.100p0, 0.0625);
 
+is(0x.1p0, 0.0625);
+is(0x1.1p0, 1.0625);
+is(0x1.11p0, 1.06640625);
+is(0x1.111p0, 1.066650390625);
+
 # Positive exponents.
 is(0x1p2, 4);
 is(0x1p+2, 4);
@@ -107,6 +112,15 @@ is(0xa_b.c_dp+1_2, 703696);
 # different from 3e4 cf 30e3 cf 30000.  The shifting of the hexdigits
 # makes it look stranger, though: 0xap1 == 0x5p2.
 
+# [perl #127183], try some non-canonical forms.
+SKIP: {
+    skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 3)
+        unless ($Config{nv_preserves_uv_bits} == 53);
+    is(0x0.b17217f7d1cf78p0, 0x1.62e42fefa39efp-1);
+    is(0x0.58b90bfbe8e7bcp1, 0x1.62e42fefa39efp-1);
+    is(0x0.2c5c85fdf473dep2, 0x1.62e42fefa39efp-1);
+}
+
 # Needs to use within() instead of is() because of long doubles.
 within(0x1.99999999999ap-4, 0.1, 1e-9);
 within(0x3.333333333333p-5, 0.1, 1e-9);
@@ -133,11 +147,17 @@ sub get_warn() {
     eval '@a = 0x3..5';
     is("@a", "3 4 5");
 
+    undef $a;
     eval '$a = eval "0x.3"';
     is($a, '03');
 
+    undef $a;
     eval '$a = eval "0xc.3"';
     is($a, '123');
+
+    undef $a;
+    eval '$a = eval "0x.p3"';
+    is($a, undef);
 }
 
 # Test warnings.
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 2784bde316..d03deb17b6 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -247,7 +247,7 @@ if ($Config{nvsize} == 8 &&
     print "# no hexfloat tests\n";
 }
 
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 9;
+plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 12;
 
 use strict;
 use Config;
@@ -702,3 +702,35 @@ SKIP: {
     is(sprintf("%+a", -0.0), "-0x0p+0", "negative zero");
     is(sprintf("%.13a", -0.0), "-0x0.0000000000000p+0", "negative zero");
 }
+
+SKIP: {
+    # [perl #127183] Non-canonical hexadecimal floats are parsed prematurely
+
+    skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits}, not 53", 3)
+        unless $Config{nv_preserves_uv_bits} == 53;
+
+    {
+        # The 0x0.b17217f7d1cf78p0 is the original LHS value
+        # from [perl #127183], its bits are 0x162e42fefa39ef << 3,
+        # resulting in a non-canonical form of hexfp, where the most
+        # significant bit is zero, instead of one.
+        is(sprintf("%a", 0x0.b17217f7d1cf78p0 - 0x1.62e42fefa39efp-1),
+           "0x0p+0",
+           "non-canonical form [perl #127183]");
+    }
+
+    {
+        no warnings 'overflow';  # Not the point here.
+
+        # The 0x058b90bfbe8e7bc is 0x162e42fefa39ef << 2,
+        # the 0x02c5c85fdf473de is 0x162e42fefa39ef << 1,
+        # see above.
+        is(sprintf("%a", 0x0.58b90bfbe8e7bcp1 - 0x1.62e42fefa39efp-1),
+           "0x0p+0",
+           "non-canonical form");
+
+        is(sprintf("%a", 0x0.2c5c85fdf473dep2 - 0x1.62e42fefa39efp-1),
+           "0x0p+0",
+           "non-canonical form");
+    }
+}