(perl #127384)(CVE-2016-1238) port forward changes from maint

[perl5.git] / perly.y

diff --git a/perly.y b/perly.y
index 8050360..6eb4b23 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -31,7 +31,7 @@
 
 /*  Make the parser re-entrant. */
 
-%pure_parser
+%pure-parser
 
 %start grammar
 
@@ -45,9 +45,9 @@
 
 %token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ
 
-%token <ival> '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';' '=' '.'
+%token <ival> '{' '}' '[' ']' '-' '+' '@' '%' '&' '=' '.'
 
-%token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST
+%token <opval> BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST
 %token <opval> FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB
 %token <opval> PLUGEXPR PLUGSTMT
 %token <pval> LABEL
@@ -69,7 +69,7 @@
 %type <opval> stmtseq fullstmt labfullstmt barestmt block mblock else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
 %type <opval> sliceme kvslice gelem
-%type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
+%type <opval> listexpr nexpr texpr iexpr mexpr mnexpr
 %type <opval> optlistexpr optexpr optrepl indirob listop method
 %type <opval> formname subname proto optsubbody cont my_scalar my_var
 %type <opval> refgen_topic formblock
@@ -336,7 +336,7 @@ barestmt:   PLUGSTMT
                          intro_my();
                          parser->parsed_sub = 1;
                        }
-       |       PACKAGE WORD WORD ';'
+       |       PACKAGE BAREWORD BAREWORD ';'
                        {
                          package($3);
                          if ($2)
@@ -345,7 +345,7 @@ barestmt:   PLUGSTMT
                        }
        |       USE startsub
                        { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
-               WORD WORD optlistexpr ';'
+               BAREWORD BAREWORD optlistexpr ';'
                        {
                          SvREFCNT_inc_simple_void(PL_compcv);
                          utilize($1, $2, $4, $5, $6);
@@ -358,21 +358,15 @@ barestmt: PLUGSTMT
                              newCONDOP(0, $4, op_scope($6), $7));
                          parser->copline = (line_t)$1;
                        }
-       |       UNLESS '(' remember miexpr ')' mblock else
+       |       UNLESS '(' remember mexpr ')' mblock else
                        {
                          $$ = block_end($3,
-                             newCONDOP(0, $4, op_scope($6), $7));
+                              newCONDOP(0, $4, $7, op_scope($6)));
                          parser->copline = (line_t)$1;
                        }
        |       GIVEN '(' remember mexpr ')' mblock
                        {
-                         const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-                         $$ = block_end($3,
-                                 newGIVENOP($4, op_scope($6),
-                                   offset == NOT_IN_PAD
-                                   || PAD_COMPNAME_FLAGS_isOUR(offset)
-                                     ? 0
-                                     : offset));
+                         $$ = block_end($3, newGIVENOP($4, op_scope($6), 0));
                          parser->copline = (line_t)$1;
                        }
        |       WHEN '(' remember mexpr ')' mblock
@@ -424,18 +418,18 @@ barestmt: PLUGSTMT
                                      op_lvalue($2, OP_ENTERLOOP), $5, $7, $8));
                          parser->copline = (line_t)$1;
                        }
-       |       FOR REFGEN MY remember my_var
-                       { parser->in_my = 0; $<opval>$ = my($5); }
+       |       FOR my_refgen remember my_var
+                       { parser->in_my = 0; $<opval>$ = my($4); }
                '(' mexpr ')' mblock cont
                        {
                          $$ = block_end(
-                               $4,
+                               $3,
                                newFOROP(0,
                                         op_lvalue(
                                            newUNOP(OP_REFGEN, 0,
-                                                   $<opval>6),
+                                                   $<opval>5),
                                            OP_ENTERLOOP),
-                                        $8, $10, $11)
+                                        $7, $9, $10)
                          );
                          parser->copline = (line_t)$1;
                        }
@@ -459,7 +453,7 @@ barestmt:   PLUGSTMT
                          $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
                                  (OP*)NULL, $1, $2, 0);
                        }
-       |       PACKAGE WORD WORD '{' remember
+       |       PACKAGE BAREWORD BAREWORD '{' remember
                        {
                          package($3);
                          if ($2) {
@@ -587,11 +581,7 @@ mnexpr     :       nexpr
                        { $$ = $1; intro_my(); }
        ;
 
-miexpr :       iexpr
-                       { $$ = $1; intro_my(); }
-       ;
-
-formname:      WORD            { $$ = $1; }
+formname:      BAREWORD        { $$ = $1; }
        |       /* NULL */      { $$ = (OP*)NULL; }
        ;
 
@@ -612,7 +602,7 @@ startformsub:       /* NULL */      /* start a format subroutine scope */
        ;
 
 /* Name of a subroutine - must be a bareword, could be special */
-subname        :       WORD
+subname        :       BAREWORD
        |       PRIVATEREF
        ;
 
@@ -829,7 +819,7 @@ termunop : '-' term %prec UMINUS                       /* -$x */
        |       '!' term                               /* !$x */
                        { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
        |       '~' term                               /* ~$x */
-                       { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2)); }
+                       { $$ = newUNOP($1, 0, scalar($2)); }
        |       term POSTINC                           /* $x++ */
                        { $$ = newUNOP(OP_POSTINC, 0,
                                        op_lvalue(scalar($1), OP_POSTINC)); }
@@ -896,10 +886,12 @@ term      :       termbinop
                        { $$ = newCONDOP(0, $1, $3, $5); }
        |       REFGEN term                          /* \$x, \@y, \%z */
                        { $$ = newUNOP(OP_REFGEN, 0, $2); }
+       |       MY REFGEN term
+                       { $$ = newUNOP(OP_REFGEN, 0, localize($3,1)); }
        |       myattrterm      %prec UNIOP
                        { $$ = $1; }
        |       LOCAL term      %prec UNIOP
-                       { $$ = localize($2,$1); }
+                       { $$ = localize($2,0); }
        |       '(' expr ')'
                        { $$ = sawparens($2); }
        |       QWLIST
@@ -1036,7 +1028,7 @@ term      :       termbinop
                        }
                    '(' listexpr optrepl ')'
                        { $$ = pmruntime($1, $4, $5, 1, $<ival>2); }
-       |       WORD
+       |       BAREWORD
        |       listop
        |       YADAYADA
                        {
@@ -1050,7 +1042,9 @@ term      :       termbinop
 myattrterm:    MY myterm myattrlist
                        { $$ = my_attrs($2,$3); }
        |       MY myterm
-                       { $$ = localize($2,$1); }
+                       { $$ = localize($2,1); }
+       |       MY REFGEN myterm myattrlist
+                       { $$ = newUNOP(OP_REFGEN, 0, my_attrs($3,$4)); }
        ;
 
 /* Things that can be "my"'d */
@@ -1101,6 +1095,10 @@ refgen_topic:    my_var
        |       amper
        ;
 
+my_refgen:     MY REFGEN
+       |       REFGEN MY
+       ;
+
 amper  :       '&' indirob
                        { $$ = newCVREF($1,$2); }
        ;
@@ -1147,7 +1145,7 @@ gelem     :       star
        ;
 
 /* Indirect objects */
-indirob        :       WORD
+indirob        :       BAREWORD
                        { $$ = scalar($1); }
        |       scalar %prec PREC_LOW
                        { $$ = scalar($1); }