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
