Upgrade to Test::Harness 2.40.

[perl5.git] / perly.y

diff --git a/perly.y b/perly.y
index 48049eb..63210ae 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -96,7 +96,7 @@ static void yydestruct(pTHX_ void *ptr);
 %nonassoc PREC_LOW
 %nonassoc LOOPEX
 
-%left <ival> OROP
+%left <ival> OROP DOROP
 %left ANDOP
 %right NOTOP
 %nonassoc LSTOP LSTOPSUB
@@ -104,7 +104,7 @@ static void yydestruct(pTHX_ void *ptr);
 %right <ival> ASSIGNOP
 %right '?' ':'
 %nonassoc DOTDOT
-%left OROR
+%left OROR DORDOR
 %left ANDAND
 %left <ival> BITOROP
 %left <ival> BITANDOP
@@ -134,7 +134,7 @@ prog        :       progstart
 /* An ordinary block */
 block  :       '{' remember lineseq '}'
                        { if (PL_copline > (line_t)$1)
-                             PL_copline = $1;
+                             PL_copline = (line_t)$1;
                          $$ = block_end($2, $3); }
        ;
 
@@ -154,7 +154,7 @@ progstart:
 
 mblock :       '{' mremember lineseq '}'
                        { if (PL_copline > (line_t)$1)
-                             PL_copline = $1;
+                             PL_copline = (line_t)$1;
                          $$ = block_end($2, $3); }
        ;
 
@@ -206,7 +206,7 @@ sideff      :       error
        |       expr UNTIL iexpr
                        { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
        |       expr FOR expr
-                       { $$ = newFOROP(0, Nullch, $2,
+                       { $$ = newFOROP(0, Nullch, (line_t)$2,
                                        Nullop, $3, $1, Nullop); }
        ;
 
@@ -216,18 +216,18 @@ else      :       /* NULL */
        |       ELSE mblock
                        { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); }
        |       ELSIF '(' mexpr ')' mblock else
-                       { PL_copline = $1;
+                       { PL_copline = (line_t)$1;
                            $$ = newCONDOP(0, $3, scope($5), $6);
                            PL_hints |= HINT_BLOCK_SCOPE; }
        ;
 
 /* Real conditional expressions */
 cond   :       IF '(' remember mexpr ')' mblock else
-                       { PL_copline = $1;
+                       { PL_copline = (line_t)$1;
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7)); }
        |       UNLESS '(' remember miexpr ')' mblock else
-                       { PL_copline = $1;
+                       { PL_copline = (line_t)$1;
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7)); }
        ;
@@ -241,31 +241,31 @@ cont      :       /* NULL */
 
 /* Loops: while, until, for, and a bare block */
 loop   :       label WHILE '(' remember mtexpr ')' mblock cont
-                       { PL_copline = $2;
+                       { PL_copline = (line_t)$2;
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
                                                $2, $5, $7, $8))); }
        |       label UNTIL '(' remember miexpr ')' mblock cont
-                       { PL_copline = $2;
+                       { PL_copline = (line_t)$2;
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
                                                $2, $5, $7, $8))); }
        |       label FOR MY remember my_scalar '(' mexpr ')' mblock cont
                        { $$ = block_end($4,
-                                newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+                                newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); }
        |       label FOR scalar '(' remember mexpr ')' mblock cont
                        { $$ = block_end($5,
-                                newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+                                newFOROP(0, $1, (line_t)$2, mod($3, OP_ENTERLOOP),
                                          $6, $8, $9)); }
        |       label FOR '(' remember mexpr ')' mblock cont
                        { $$ = block_end($4,
-                                newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
+                                newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); }
        |       label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
                        /* basically fake up an initialize-while lineseq */
                        { OP *forop;
-                         PL_copline = $2;
+                         PL_copline = (line_t)$2;
                          forop = newSTATEOP(0, $1,
                                            newWHILEOP(0, 1, (LOOP*)Nullop,
                                                $2, scalar($7),
@@ -404,8 +404,6 @@ subbody     :       block   { $$ = $1; }
 
 package :      PACKAGE WORD ';'
                        { package($2); }
-       |       PACKAGE ';'
-                       { package(Nullop); }
        ;
 
 use    :       USE startsub
@@ -419,6 +417,8 @@ expr        :       expr ANDOP expr
                        { $$ = newLOGOP(OP_AND, 0, $1, $3); }
        |       expr OROP expr
                        { $$ = newLOGOP($2, 0, $1, $3); }
+       |       expr DOROP expr
+                       { $$ = newLOGOP(OP_DOR, 0, $1, $3); }
        |       argexpr %prec PREC_LOW
        ;
 
@@ -477,7 +477,8 @@ method      :       METHOD
 subscripted:    star '{' expr ';' '}'        /* *main::{something} */
                         /* In this and all the hash accessors, ';' is
                          * provided by the tokeniser */
-                       { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
+                       { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
+                           PL_expect = XOPERATOR; }
        |       scalar '[' expr ']'          /* $array[$element] */
                        { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
        |       term ARROW '[' expr ']'      /* somearef->[$element] */
@@ -545,6 +546,8 @@ termbinop   :       term ASSIGNOP term             /* $x = $y */
                        { $$ = newLOGOP(OP_AND, 0, $1, $3); }
        |       term OROR term                         /* $x || $y */
                        { $$ = newLOGOP(OP_OR, 0, $1, $3); }
+       |       term DORDOR term                       /* $x // $y */
+                       { $$ = newLOGOP(OP_DOR, 0, $1, $3); }
        |       term MATCHOP term                      /* $x =~ /$y/ */
                        { $$ = bind_match($2, $1, $3); }
     ;