In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/2cb35ee012cfe486aa75a422e7bb3cb18ff51336?hp=bb02b572f9a36976b622aca31b9f0f2bb2929e48>
- Log ----------------------------------------------------------------- commit 2cb35ee012cfe486aa75a422e7bb3cb18ff51336 Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Nov 26 13:41:27 2017 -0800 [perl #132485] Warn about "$foo'bar" commit b3f7b7ad843501b532887233663813d51839174d Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Nov 25 10:07:28 2017 -0800 toke.c: Comment typo ----------------------------------------------------------------------- Summary of changes: embed.fnc | 3 ++- embed.h | 2 +- pod/perldiag.pod | 7 +++++++ proto.h | 2 +- t/lib/warnings/toke | 39 +++++++++++++++++++++++++++++++++++++++ toke.c | 38 ++++++++++++++++++++++++++++++++------ 6 files changed, 82 insertions(+), 9 deletions(-) diff --git a/embed.fnc b/embed.fnc index eeaf050766..6f10fa8c78 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2708,7 +2708,8 @@ so |SV* |new_constant |NULLOK const char *s|STRLEN len \ s |int |ao |int toketype s |void|parse_ident|NN char **s|NN char **d \ |NN char * const e|int allow_package \ - |bool is_utf8|bool check_dollar + |bool is_utf8|bool check_dollar \ + |bool tick_warn # if defined(PERL_CR_FILTER) s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen s |void |strip_return |NN SV *sv diff --git a/embed.h b/embed.h index 21c8328e35..06002a1b9a 100644 --- a/embed.h +++ b/embed.h @@ -1830,7 +1830,7 @@ #define lop(a,b,c) S_lop(aTHX_ a,b,c) #define missingterm(a,b) S_missingterm(aTHX_ a,b) #define no_op(a,b) S_no_op(aTHX_ a,b) -#define parse_ident(a,b,c,d,e,f) S_parse_ident(aTHX_ a,b,c,d,e,f) +#define parse_ident(a,b,c,d,e,f,g) S_parse_ident(aTHX_ a,b,c,d,e,f,g) #define pending_ident() S_pending_ident(aTHX) #define scan_const(a) S_scan_const(aTHX_ a) #define scan_formline(a) S_scan_formline(aTHX_ a) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b069fb165c..16b473f82b 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4315,6 +4315,13 @@ C<sysread()>ing a file, or when seeking past the end of a scalar opened for I/O (in anticipation of future reads and to imitate the behavior with real files). +=item Old package separator used in string + +(W syntax) You used the old package separator, "'", in a variable +named inside a double-quoted string; e.g., C<"In $name's house">. This +is equivalent to C<"In $name::s house">. If you meant the former, put +a backslash before the apostrophe (C<"In $name\'s house">). + =item %s() on unopened %s (W unopened) An I/O operation was attempted on a filehandle that was diff --git a/proto.h b/proto.h index 39276fa223..d1fcc6279c 100644 --- a/proto.h +++ b/proto.h @@ -5754,7 +5754,7 @@ STATIC SV* S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRL STATIC void S_no_op(pTHX_ const char *const what, char *s); #define PERL_ARGS_ASSERT_NO_OP \ assert(what) -STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar); +STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar, bool tick_warn); #define PERL_ARGS_ASSERT_PARSE_IDENT \ assert(s); assert(d); assert(e) STATIC int S_pending_ident(pTHX); diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 0179bc49a7..ffa6307c61 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -54,6 +54,11 @@ toke.c AOK printf ("") sort ("") + Old package separator used in string + "$foo'bar" + "@foo'bar" + "$#foo'bar" + Ambiguous use of %c{%s%s} resolved to %c%s%s $a = ${time[2]} $a = ${time{2}} @@ -411,6 +416,40 @@ no warnings 'syntax' ; sort ("") EXPECT +######## +use warnings 'syntax'; +@foo::bar = 1..3; +() = "$foo'bar"; +() = "@foo'bar"; +() = "$#foo'bar"; +no warnings 'syntax' ; +() = "$foo'bar"; +() = "@foo'bar"; +() = "$#foo'bar"; +EXPECT +Old package separator used in string at - line 3. + (Did you mean "$foo\'bar" instead?) +Old package separator used in string at - line 4. + (Did you mean "@foo\'bar" instead?) +Old package separator used in string at - line 5. + (Did you mean "$#foo\'bar" instead?) +######## +use warnings 'syntax'; use utf8; +@fooл::barл = 1..3; +() = "$fooл'barл"; +() = "@fooл'barл"; +() = "$#fooл'barл"; +no warnings 'syntax' ; +() = "$fooл'barл"; +() = "@fooл'barл"; +() = "$#fooл'barл"; +EXPECT +Old package separator used in string at - line 3. + (Did you mean "$fooл\'barл" instead?) +Old package separator used in string at - line 4. + (Did you mean "@fooл\'barл" instead?) +Old package separator used in string at - line 5. + (Did you mean "$#fooл\'barл" instead?) ######## # toke.c use warnings 'ambiguous' ; diff --git a/toke.c b/toke.c index 02a335572c..ececc94314 100644 --- a/toke.c +++ b/toke.c @@ -2008,7 +2008,7 @@ S_force_next(pTHX_ I32 type) * S_postderef * * This subroutine handles postfix deref syntax after the arrow has already - * been emitted. @* $* etc. are emitted as two separate token right here. + * been emitted. @* $* etc. are emitted as two separate tokens right here. * @[ @{ %[ %{ *{ are emitted also as two tokens, but this function emits * only the first, leaving yylex to find the next. */ @@ -5136,7 +5136,7 @@ Perl_yylex(pTHX) /* read var name, including sigil, into PL_tokenbuf */ PL_tokenbuf[0] = sigil; parse_ident(&s, &dest, dest + sizeof(PL_tokenbuf) - 1, - 0, cBOOL(UTF), FALSE); + 0, cBOOL(UTF), FALSE, FALSE); *dest = '\0'; assert(PL_tokenbuf[1]); /* we have a variable name */ } @@ -9274,8 +9274,10 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, PERL_STATIC_INLINE void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, - bool is_utf8, bool check_dollar) + bool is_utf8, bool check_dollar, bool tick_warn) { + int saw_tick = 0; + const char *olds = *s; PERL_ARGS_ASSERT_PARSE_IDENT; while (*s < PL_bufend) { @@ -9309,6 +9311,7 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, *(*d)++ = ':'; *(*d)++ = ':'; (*s)++; + saw_tick++; } else if (allow_package && **s == ':' && (*s)[1] == ':' /* Disallow things like Foo::$bar. For the curious, this is @@ -9322,6 +9325,29 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, else break; } + if (UNLIKELY(tick_warn && saw_tick && PL_lex_state == LEX_INTERPNORMAL + && !PL_lex_brackets && ckWARN(WARN_SYNTAX))) { + char *d; + char *d2; + Newx(d, *s - olds + saw_tick + 2, char); /* +2 for $# */ + d2 = d; + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "Old package separator used in string"); + if (olds[-1] == '#') + *d2++ = olds[-2]; + *d2++ = olds[-1]; + while (olds < *s) { + if (*olds == '\'') { + *d2++ = '\\'; + *d2++ = *olds++; + } + else + *d2++ = *olds++; + } + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "\t(Did you mean \"%" UTF8f "\" instead?)\n", + UTF8fARG(is_utf8, d2-d, d)); + } return; } @@ -9337,7 +9363,7 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN PERL_ARGS_ASSERT_SCAN_WORD; - parse_ident(&s, &d, e, allow_package, is_utf8, TRUE); + parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, FALSE); *d = '\0'; *slp = d - dest; return s; @@ -9385,7 +9411,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) } } else { /* See if it is a "normal" identifier */ - parse_ident(&s, &d, e, 1, is_utf8, FALSE); + parse_ident(&s, &d, e, 1, is_utf8, FALSE, TRUE); } *d = '\0'; d = dest; @@ -9463,7 +9489,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) (the later check for } being at the expected point will trap cases where this doesn't pan out.) */ d += is_utf8 ? UTF8SKIP(d) : 1; - parse_ident(&s, &d, e, 1, is_utf8, TRUE); + parse_ident(&s, &d, e, 1, is_utf8, TRUE, TRUE); *d = '\0'; } else { /* caret word: ${^Foo} ${^CAPTURE[0]} */ -- Perl5 Master Repository