From @tonycoz

0001-perl-131894-limit-the-digits-after-the-decimal-for-b.patch

From c425976fc53a8129872836f887ea5da3f3e71952 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 5 Sep 2017 15:26:41 +1000
Subject: (perl #131894) limit the digits after the "decimal" for bin/oct fp

---
 t/lib/croak/toke | 18 ++++++++++++++++++
 t/op/hexfp.t     | 16 +++++++++++++++-
 toke.c           |  6 ++++--
 3 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index c477be0..3b11ced 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -404,3 +404,21 @@ Number found where operator expected at - line 1, near "--5"
 	(Missing operator before 5?)
 syntax error at - line 1, near "1e"
 Execution of - aborted due to compilation errors.
+########
+# NAME octal fp with non-octal digits after the decimal point
+01.1234567p0;
+07.8p0;
+EXPECT
+Bareword found where operator expected at - line 2, near "8p0"
+	(Missing operator before p0?)
+syntax error at - line 2, near "8p0"
+Execution of - aborted due to compilation errors.
+########
+# NAME binary fp with non-binary digits after the decimal point
+0b1.10p0;
+0b1.2p0;
+EXPECT
+Bareword found where operator expected at - line 2, near "2p0"
+	(Missing operator before p0?)
+syntax error at - line 2, near "2p0"
+Execution of - aborted due to compilation errors.
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index a3529e4..efe908c 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
 
 use Config;
 
-plan(tests => 110);
+plan(tests => 121);
 
 # Test hexfloat literals.
 
@@ -262,6 +262,20 @@ SKIP: {
        "ASAN undefined error parsing the first");
 }
 
+# the implementation also allow for octal and binary fp
+is(01p0, 1);
+is(01.0p0, 1);
+is(01.00p0, 1);
+is(010.1p0, 8.125);
+is(00.400p1, 1);
+is(00p0, 0);
+is(01.1p0, 1.125);
+
+is(0b0p0, 0);
+is(0b1p0, 1);
+is(0b10p0, 2);
+is(0b1.1p0, 1.5);
+
 # 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 84dce75..c98813b 100644
--- a/toke.c
+++ b/toke.c
@@ -10978,9 +10978,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                     NV nv_mult = 1.0;
 #endif
                     bool accumulate = TRUE;
-                    for (h++; (isXDIGIT(*h) || *h == '_'); h++) {
+                    U8 b;
+                    int lim = 1 << shift;
+                    for (h++; ((isXDIGIT(*h) && (b = XDIGIT_VALUE(*h)) < lim) ||
+                               *h == '_'); h++) {
                         if (isXDIGIT(*h)) {
-                            U8 b = XDIGIT_VALUE(*h);
                             significant_bits += shift;
 #ifdef HEXFP_UQUAD
                             if (accumulate) {
-- 
2.1.4

runtime error: shift exponent -2 is negative (toke.c:10966:54) #16114

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions