Re: open/or inconsistency

Message-Id: <20040117195729.623A.BQW10602@nifty.com>
(plus a test.)
Don't produce the warning for constructs like
    open my $fh, $file or die;

p4raw-id: //depot/perl@22170

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

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index e06d251..486a00a 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -584,6 +584,7 @@ BEGIN not safe after errors--compilation aborted at - line 18.
 use warnings 'parenthesis' ;
 my $a, $b = (1,2);
 my @foo,%bar,  $quux; # there's a TAB here
+my $x, $y or print;
 no warnings 'parenthesis' ;
 my $c, $d = (1,2);
 EXPECT