Use a more sophisticated heuristics to produce the warning

'Parentheses missing around "%s" list'. This fixes bug #22147.
Also, the warning is now produced for C<local *a,*b;>.

p4raw-id: //depot/perl@19503

diff --git a/op.c b/op.c
index be05875..86cfe23 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1838,14 +1838,23 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
        {
            char *s = PL_bufptr;
+           int sigil = 0;
 
-           while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s)))
+           /* some heuristics to detect a potential error */
+           while (*s && (strchr(", \t\n", *s)
+                       || (strchr("@$%*", *s) && ++sigil) ))
                s++;
-
-           if (*s == ';' || *s == '=')
-               Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
-                           "Parentheses missing around \"%s\" list",
-                           lex ? (PL_in_my == KEY_our ? "our" : "my") : "local");
+           if (sigil) {
+               while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)
+                           || strchr("@$%*, \t\n", *s)))
+                   s++;
+
+               if (*s == ';' || *s == '=')
+                   Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
+                               "Parentheses missing around \"%s\" list",
+                               lex ? (PL_in_my == KEY_our ? "our" : "my")
+                               : "local");
+           }
        }
     }
     if (lex)

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 3e8261b..dff697d 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -581,20 +581,32 @@ Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
 BEGIN not safe after errors--compilation aborted at - line 18.
 ########
 # op.c
-use warnings 'syntax' ;
+use warnings 'parenthesis' ;
 my $a, $b = (1,2);
-no warnings 'syntax' ;
+my @foo,%bar,  $quux; # there's a TAB here
+no warnings 'parenthesis' ;
 my $c, $d = (1,2);
 EXPECT
 Parentheses missing around "my" list at - line 3.
+Parentheses missing around "my" list at - line 4.
 ########
 # op.c
-use warnings 'syntax' ;
+use warnings 'parenthesis' ;
+our $a, $b = (1,2);
+no warnings 'parenthesis' ;
+our $c, $d = (1,2);
+EXPECT
+Parentheses missing around "our" list at - line 3.
+########
+# op.c
+use warnings 'parenthesis' ;
 local $a, $b = (1,2);
-no warnings 'syntax' ;
+local *f, *g;
+no warnings 'parenthesis' ;
 local $c, $d = (1,2);
 EXPECT
 Parentheses missing around "local" list at - line 3.
+Parentheses missing around "local" list at - line 4.
 ########
 # op.c
 use warnings 'bareword' ;