In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/58be57636a42d6c6fd404c48c4e1cb87870182df?hp=38a3df78b8fbbdf02988dd5fe691c23a8041334f>
- Log -----------------------------------------------------------------
commit 58be57636a42d6c6fd404c48c4e1cb87870182df
Author: Tony Cook <t...@develop-help.com>
Date: Tue Sep 5 15:26:41 2017 +1000
limit digits based on radix for oct/bin fp
All hexadecimal digits were being permitted in octal and binary floating
point literals. (That octal and binary literals are permitted at all
might be an accidental result of permitting hexadecimal?) Restrict which
digits are permitted, in accordance with the radix.
commit 7c6e7cf06853eef1d1b271077c402c5f8655fbe6
Author: Zefram <zef...@fysh.org>
Date: Wed Dec 6 01:40:43 2017 +0000
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].
commit c86de4c07d8483411299c7c5d7d78f4fdaa4b225
Author: Zefram <zef...@fysh.org>
Date: Wed Dec 6 01:10:31 2017 +0000
assert legality of bitshifts in scan_num()
[perl #131894] found some negative-exponent shifting going on here.
Make the illegality more accessible by asserting.
-----------------------------------------------------------------------
Summary of changes:
t/lib/croak/toke | 18 ++++++++++++++++++
t/op/hexfp.t | 26 +++++++++++++++++++++++++-
toke.c | 12 +++++++++---
3 files changed, 52 insertions(+), 4 deletions(-)
diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 082761eec4..1d45a3fdf5 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -462,3 +462,21 @@ tr//\N{}-0/;
EXPECT
Unknown charname '' at - line 1, within string
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 29378f29af..617c0fe44c 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
use Config;
-plan(tests => 109);
+plan(tests => 123);
# Test hexfloat literals.
@@ -255,6 +255,30 @@ 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";
+}
+
+# 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 70e7de01de..60806a749c 100644
--- a/toke.c
+++ b/toke.c
@@ -10997,6 +10997,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
digit:
just_zero = FALSE;
if (!overflowed) {
+ assert(shift >= 0);
x = u << shift; /* make room for the digit */
total_bits += shift;
@@ -11077,19 +11078,22 @@ 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) {
if (significant_bits < NV_MANT_DIG) {
/* We are in the long "run" of xdigits,
* accumulate the full four bits. */
+ assert(shift >= 0);
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
@@ -11098,7 +11102,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
significant_bits - NV_MANT_DIG;
if (tail <= 0)
tail += shift;
+ assert(tail >= 0);
hexfp_uquad <<= tail;
+ assert((shift - tail) >= 0);
hexfp_uquad |= b >> (shift - tail);
hexfp_frac_bits += tail;
--
Perl5 Master Repository
