In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/7259f4194f3131957240f6b3dba47b74f53ac660?hp=4ec3954cc121fc761a8ba7ee850de9ebb13bf4b9>
- Log ----------------------------------------------------------------- commit 7259f4194f3131957240f6b3dba47b74f53ac660 Author: Tony Cook <[email protected]> Date: Tue Jun 4 16:35:35 2019 +1000 (perl #134125) accept only complete hex and binary literals ----------------------------------------------------------------------- Summary of changes: t/lib/croak/toke | 16 ++++++++++++++++ t/lib/warnings/toke | 3 --- t/op/hexfp.t | 4 ++-- toke.c | 9 +++++++++ 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/t/lib/croak/toke b/t/lib/croak/toke index 21851229fe..70d307b0c4 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -502,3 +502,19 @@ format= EXPECT syntax error at - line 4, next token ??? Execution of - aborted due to compilation errors. +######## +# NAME [perl #134045] incomplete hex number +0x x 2; +0xx 2; +0x_; +EXPECT +Number found where operator expected at - line 1, near "x 2" + (Do you need to predeclare x?) +Bareword found where operator expected at - line 2, near "0xx" + (Missing operator before xx?) +Number found where operator expected at - line 2, near "xx 2" + (Do you need to predeclare xx?) +Bareword found where operator expected at - line 3, near "0x_" + (Missing operator before x_?) +syntax error at - line 1, near "x 2" +Execution of - aborted due to compilation errors. diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 5dbef1ab62..e6591faac7 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -756,7 +756,6 @@ $a = 1_; print "$a\n"; $a = 01_; print "$a\n"; $a = 0_; print "$a\n"; $a = 0x1_; print "$a\n"; -$a = 0x_; print "$a\n"; $a = 1.2_; print "$a\n"; $a = 1._2; print "$a\n"; $a = 1._; print "$a\n"; @@ -768,12 +767,10 @@ Misplaced _ in number at - line 6. Misplaced _ in number at - line 7. Misplaced _ in number at - line 8. Misplaced _ in number at - line 9. -Misplaced _ in number at - line 10. 1 1 0 1 -0 1.2 1.2 1 diff --git a/t/op/hexfp.t b/t/op/hexfp.t index 64f81364b7..8904c48d29 100644 --- a/t/op/hexfp.t +++ b/t/op/hexfp.t @@ -138,7 +138,7 @@ sub get_warn() { { # Test certain things that are not hexfloats and should stay that way. eval '0xp3'; - like(get_warn(), qr/Missing operator before p3/); + like(get_warn(), qr/Missing operator before xp3/); eval '5p3'; like(get_warn(), qr/Missing operator before p3/); @@ -149,7 +149,7 @@ sub get_warn() { undef $a; eval '$a = eval "0x.3"'; - is($a, '03'); + is($a, ''); # 0 x .3 undef $a; eval '$a = eval "0xc.3"'; diff --git a/toke.c b/toke.c index dba907d857..26d383f006 100644 --- a/toke.c +++ b/toke.c @@ -11025,6 +11025,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) I32 shift; bool overflowed = FALSE; bool just_zero = TRUE; /* just plain 0 or binary number? */ + bool has_digs = FALSE; static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 }; static const char* const bases[5] = { "", "binary", "", "octal", "hexadecimal" }; @@ -11116,6 +11117,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) digit: just_zero = FALSE; + has_digs = TRUE; if (!overflowed) { assert(shift >= 0); x = u << shift; /* make room for the digit */ @@ -11331,6 +11333,13 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } } + if (shift != 3 && !has_digs) { + /* 0x or 0b with no digits, treat it as if the x or b is part of the + next token + */ + s = start + 1; + } + if (overflowed) { if (n > 4294967295.0) Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), -- Perl5 Master Repository
