In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/72c80c749a61d30202cfa902a18be1b6f3ff6905?hp=8ecef80150e3cbd8e53560e7eb9f9a85a8151ecf>
- Log ----------------------------------------------------------------- commit 72c80c749a61d30202cfa902a18be1b6f3ff6905 Author: Zefram <[email protected]> Date: Tue Jan 17 00:04:00 2017 +0000 warn at most once per literal about misplaced _ Fixes [perl #70878]. ----------------------------------------------------------------------- Summary of changes: t/lib/warnings/toke | 28 ++++++++++++++++++++++++++++ toke.c | 49 +++++++++++++++++++++++-------------------------- 2 files changed, 51 insertions(+), 26 deletions(-) diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 95b7bfa84d..fe8adc5178 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -677,6 +677,34 @@ _123 12340000000000 ######## # toke.c +use warnings 'syntax'; +$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"; +EXPECT +Misplaced _ in number at - line 3. +Misplaced _ in number at - line 4. +Misplaced _ in number at - line 5. +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 +######## +# toke.c use warnings 'bareword' ; #line 25 "bar" $a = FRED:: ; diff --git a/toke.c b/toke.c index 923fc885ed..f40936b0e2 100644 --- a/toke.c +++ b/toke.c @@ -10591,6 +10591,15 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) bool floatit; /* boolean: int or float? */ const char *lastub = NULL; /* position of last underbar */ static const char* const number_too_long = "Number too long"; + bool warned_about_underscore = 0; +#define WARN_ABOUT_UNDERSCORE() \ + do { \ + if (!warned_about_underscore) { \ + warned_about_underscore = 1; \ + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), \ + "Misplaced _ in number"); \ + } \ + } while(0) /* Hexadecimal floating point. * * In many places (where we have quads and NV is IEEE 754 double) @@ -10675,8 +10684,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -10699,8 +10707,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* _ are ignored -- but warned about if consecutive */ case '_': if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; break; @@ -10785,9 +10792,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) out: /* final misplaced underbar check */ - if (s[-1] == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); - } + if (s[-1] == '_') + WARN_ABOUT_UNDERSCORE(); if (UNLIKELY(HEXFP_PEEK(s))) { /* Do sloppy (on the underbars) but quick detection @@ -10996,8 +11002,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) */ if (*s == '_') { if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } else { @@ -11010,9 +11015,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } /* final misplaced underbar check */ - if (lastub && s == lastub + 1) { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); - } + if (lastub && s == lastub + 1) + WARN_ABOUT_UNDERSCORE(); /* read a decimal portion if there is one. avoid 3..5 being interpreted as the number 3. followed @@ -11023,8 +11027,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) *d++ = *s++; if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s; } @@ -11040,18 +11043,15 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) Perl_croak(aTHX_ "%s", number_too_long); if (*s == '_') { if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s; } else *d++ = *s; } /* fractional part ending in underbar? */ - if (s[-1] == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); - } + if (s[-1] == '_') + WARN_ABOUT_UNDERSCORE(); if (*s == '.' && isDIGIT(s[1])) { /* oops, it's really a v-string, but without the "v" */ s = start; @@ -11081,8 +11081,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray preinitial _ */ if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -11092,8 +11091,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray initial _ */ if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -11107,8 +11105,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) else { if (((lastub && s == lastub + 1) || (!isDIGIT(s[1]) && s[1] != '_'))) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } } -- Perl5 Master Repository
