From e4916dd1b37bf1a38d4b4711efc268f2ddfca52f Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 22 Aug 2014 05:40:18 -0700 Subject: [PATCH] [perl #80368] Fix implicit assignop in qq"a\U=" The bug report explains it all: > $ perl -e 'print "a\U="' > Can't modify constant item in concatenation (.) or string at -e line 1, near "print "a\U="" > Execution of -e aborted due to compilation errors. > > The "a\U=" string constant ought to generate ops corresponding roughly to > "a".uc("=") (which would then be constant-folded). However, the "=" is > being interpreted by the tokeniser as part of the concatenation operator, > producing ops corresponding to "a".=uc("") (which generates the error). > > This happens because the implicit concatenation operator is generated > in toke.c via the Aop() macro, which allows an addition-type operator > to be mutated into an assignment operator if it is immediately followed > by an "=". It should instead be generated via one of the other macros, > or possibly a new macro, that doesn't allow for mutation to an assignment > operator. This commit does the latter. > There are multiple sites in toke.c making the same mistake. The other two instances are harmless, but the next commit will change them for a different reason (avoiding unnecessary PL_expect assign- ments with a view to eventually removing PL_lex_expect). --- t/base/lex.t | 6 +++++- toke.c | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/t/base/lex.t b/t/base/lex.t index 01ab208..d75fa57 100644 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -1,6 +1,6 @@ #!./perl -print "1..91\n"; +print "1..92\n"; $x = 'x'; @@ -434,3 +434,7 @@ print "ok $test - y ...\n"; $test++; print "not " unless (time =>) eq time=>; print "ok $test - => quotes keywords across lines\n"; $test++; + +# [perl #80368] +print "not " unless eval '"a\U="' eq "a="; +print "ok $test - [perl #80368] qq \n"; $test++; diff --git a/toke.c b/toke.c index 68cf152..a7ba403 100644 --- a/toke.c +++ b/toke.c @@ -196,6 +196,7 @@ static const char* const lex_state_names[] = { * PWop : power operator * PMop : pattern-matching operator * Aop : addition-level operator + * AopNOASSIGN : addition-level operator that is never part of .= * Mop : multiplication-level operator * Eop : equality-testing operator * Rop : relational operator <= != gt @@ -232,6 +233,7 @@ static const char* const lex_state_names[] = { #define PWop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP))) #define PMop(f) return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP)) #define Aop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP))) +#define AopNOASSIGN(f) return (pl_yylval.ival=f, PL_bufptr=s, REPORT((int)ADDOP)) #define Mop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP))) #define Eop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP)) #define Rop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP)) @@ -4390,7 +4392,7 @@ Perl_yylex(pTHX) if (PL_lex_casemods == 1 && PL_lex_inpat) OPERATOR(','); else - Aop(OP_CONCAT); + AopNOASSIGN(OP_CONCAT); } else return yylex(); -- 1.8.3.1