summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--parser.h1
-rw-r--r--t/lib/warnings/toke58
-rw-r--r--toke.c8
3 files changed, 66 insertions, 1 deletions
diff --git a/parser.h b/parser.h
index e7b887ec3b..dc5e89df4d 100644
--- a/parser.h
+++ b/parser.h
@@ -128,6 +128,7 @@ typedef struct yy_parser {
U8 lex_flags;
PERL_BITFIELD16 in_pod:1; /* lexer is within a =pod section */
PERL_BITFIELD16 filtered:1; /* source filters in evalbytes */
+ PERL_BITFIELD16 saw_infix_sigil:1; /* saw & or * or % operator */
} yy_parser;
/* flags for lexer API */
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index df2a0b4e2f..3faa256eff 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -890,6 +890,11 @@ $^W = 0 ;
*foo *foo ;
}
*foo *foo ;
+# These should not warn [perl #117535]:
+foo**foo ;
+no warnings 'deprecated';
+sort $*foo ;
+sort $ *foo ;
EXPECT
Operator or semicolon missing before *foo at - line 3.
Ambiguous use of * resolved as operator * at - line 3.
@@ -899,6 +904,59 @@ Operator or semicolon missing before *foo at - line 10.
Ambiguous use of * resolved as operator * at - line 10.
########
# toke.c
+$^W = 0 ;
+%foo %foo ;
+{
+ no warnings 'ambiguous' ;
+ %foo %foo ;
+ use warnings 'ambiguous' ;
+ %foo %foo ;
+}
+%foo %foo ;
+# This should not produce ambiguity warnings [perl #117535]:
+sort $%foo ;
+sort $ %foo ;
+EXPECT
+Operator or semicolon missing before %foo at - line 3.
+Ambiguous use of % resolved as operator % at - line 3.
+Operator or semicolon missing before %foo at - line 8.
+Ambiguous use of % resolved as operator % at - line 8.
+Operator or semicolon missing before %foo at - line 10.
+Ambiguous use of % resolved as operator % at - line 10.
+Bareword found where operator expected at - line 12, near "$%foo"
+ (Missing operator before foo?)
+Bareword found where operator expected at - line 13, near "$ %foo"
+ (Missing operator before foo?)
+Illegal modulus zero at - line 3.
+########
+# toke.c
+$^W = 0 ;
+&foo &foo ;
+{
+ no warnings 'ambiguous' ;
+ &foo &foo ;
+ use warnings 'ambiguous' ;
+ &foo &foo ;
+}
+&foo &foo ;
+# These should not warn produce ambiguity warnings [perl #76910]:
+foo&&foo ;
+sort $&foo ;
+sort $ &foo ;
+EXPECT
+Operator or semicolon missing before &foo at - line 3.
+Ambiguous use of & resolved as operator & at - line 3.
+Operator or semicolon missing before &foo at - line 8.
+Ambiguous use of & resolved as operator & at - line 8.
+Operator or semicolon missing before &foo at - line 10.
+Ambiguous use of & resolved as operator & at - line 10.
+Bareword found where operator expected at - line 13, near "$&foo"
+ (Missing operator before foo?)
+Bareword found where operator expected at - line 14, near "$ &foo"
+ (Missing operator before foo?)
+Undefined subroutine &main::foo called at - line 3.
+########
+# toke.c
use utf8;
use open qw( :utf8 :std );
$^W = 0 ;
diff --git a/toke.c b/toke.c
index aedccc555d..8f6eb44177 100644
--- a/toke.c
+++ b/toke.c
@@ -4640,6 +4640,7 @@ Perl_yylex(pTHX)
char *d;
STRLEN len;
bool bof = FALSE;
+ const bool saw_infix_sigil = PL_parser->saw_infix_sigil;
U8 formbrack = 0;
U32 fake_eof = 0;
@@ -5042,6 +5043,7 @@ Perl_yylex(pTHX)
s = PL_bufptr;
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
+ PL_parser->saw_infix_sigil = 0;
retry:
#ifdef PERL_MAD
@@ -5697,6 +5699,7 @@ Perl_yylex(pTHX)
s--;
TOKEN(0);
}
+ PL_parser->saw_infix_sigil = 1;
Mop(OP_MULTIPLY);
case '%':
@@ -5705,6 +5708,7 @@ Perl_yylex(pTHX)
PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
TOKEN(0);
++s;
+ PL_parser->saw_infix_sigil = 1;
Mop(OP_MODULO);
}
PL_tokenbuf[0] = '%';
@@ -6198,6 +6202,7 @@ Perl_yylex(pTHX)
s--;
TOKEN(0);
}
+ PL_parser->saw_infix_sigil = 1;
BAop(OP_BIT_AND);
}
@@ -7433,7 +7438,8 @@ Perl_yylex(pTHX)
op_free(rv2cv_op);
safe_bareword:
- if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
+ if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
+ && saw_infix_sigil) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
"Operator or semicolon missing before %c%"SVf,
lastchar, SVfARG(newSVpvn_flags(PL_tokenbuf,