This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reduce false positives for @hsh{$s} and @ary[$s] warnings
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 0522852..8cca3f4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4682,6 +4682,20 @@ S_word_takes_any_delimeter(char *p, STRLEN len)
            (p[0] == 'q' && strchr("qwxr", p[1]))));
 }
 
+static void
+S_check_scalar_slice(pTHX_ char *s)
+{
+    s++;
+    while (*s == ' ' || *s == '\t') s++;
+    if (*s == 'q' && s[1] == 'w'
+     && !isWORDCHAR_lazy_if(s+2,UTF))
+       return;
+    while (*s && (isWORDCHAR_lazy_if(s,UTF) || strchr(" \t$#+-'\"", *s)))
+       s += UTF ? UTF8SKIP(s) : 1;
+    if (*s == '}' || *s == ']')
+       pl_yylval.ival = OPpSLICEWARNING;
+}
+
 /*
   yylex
 
@@ -5823,20 +5837,10 @@ Perl_yylex(pTHX)
            /* Warn about % where they meant $. */
            if (*s == '[' || *s == '{') {
                if (ckWARN(WARN_SYNTAX)) {
-                   const char *t = s + 1;
-                   while (*t == ' ') t++;
-                   if (*t == 'q' && t[1] == 'w'
-                    && !isWORDCHAR_lazy_if(t+2,UTF))
-                       goto no_qw_warning;
-                   while (*t && (isWORDCHAR_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
-                       t += UTF ? UTF8SKIP(t) : 1;
-                   if (*t == '}' || *t == ']') {
-                       pl_yylval.ival = OPpSLICEWARNING;
-                   }
+                   S_check_scalar_slice(aTHX_ s);
                }
            }
        }
-      no_qw_warning:
        PL_expect = XOPERATOR;
        force_ident_maybe_lex('%');
        TERM('%');
@@ -6693,6 +6697,7 @@ Perl_yylex(pTHX)
            no_op("Array", s);
        PL_tokenbuf[0] = '@';
        s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
+       pl_yylval.ival = 0;
        if (!PL_tokenbuf[1]) {
            PREREF('@');
        }
@@ -6705,18 +6710,7 @@ Perl_yylex(pTHX)
            /* Warn about @ where they meant $. */
            if (*s == '[' || *s == '{') {
                if (ckWARN(WARN_SYNTAX)) {
-                   const char *t = s + 1;
-                   while (*t && (isWORDCHAR_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
-                       t += UTF ? UTF8SKIP(t) : 1;
-                   if (*t == '}' || *t == ']') {
-                       t++;
-                       PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
-       /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
-                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                        "Scalar value %"UTF8f" better written as $%"UTF8f,
-                         UTF8fARG(UTF, t-PL_bufptr, PL_bufptr),
-                         UTF8fARG(UTF, t-PL_bufptr-1, PL_bufptr+1));
-                   }
+                   S_check_scalar_slice(aTHX_ s);
                }
            }
        }