perldelta for fc39925ca

[perl5.git] / perly.y

diff --git a/perly.y b/perly.y
index cf11a99..b947a17 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -94,6 +94,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> optlistexpr optexpr indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar formblock
@@ -126,7 +127,7 @@
 %left <i_tkval> MATCHOP
 %right <i_tkval> '!' '~' UMINUS REFGEN
 %right <i_tkval> POWOP
-%nonassoc <i_tkval> PREINC PREDEC POSTINC POSTDEC
+%nonassoc <i_tkval> PREINC PREDEC POSTINC POSTDEC POSTJOIN
 %left <i_tkval> ARROW
 %nonassoc <i_tkval> ')'
 %left <i_tkval> '('
@@ -845,7 +846,7 @@ method      :       METHOD
        ;
 
 /* Some kind of subscripted expression */
-subscripted:    star '{' expr ';' '}'        /* *main::{something} */
+subscripted:    gelem '{' expr ';' '}'        /* *main::{something} */
                         /* In this and all the hash accessors, ';' is
                          * provided by the tokeniser */
                        { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
@@ -1052,6 +1053,18 @@ termunop : '-' term %prec UMINUS                       /* -$x */
                                        op_lvalue(scalar($1), OP_POSTDEC));
                          TOKEN_GETMAD($2,$$,'o');
                        }
+       |       term POSTJOIN    /* implicit join after interpolated ->@ */
+                       { $$ = convert(OP_JOIN, 0,
+                                      op_append_elem(
+                                       OP_LIST,
+                                       newSVREF(scalar(
+                                           newSVOP(OP_CONST,0,
+                                                   newSVpvs("\""))
+                                       )),
+                                       $1
+                                      ));
+                         TOKEN_GETMAD($2,$$,'o');
+                       }
        |       PREINC term                            /* ++$x */
                        { $$ = newUNOP(OP_PREINC, 0,
                                        op_lvalue(scalar($2), OP_PREINC));
@@ -1195,32 +1208,53 @@ term    :       termbinop
                        { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
        |       subscripted
                        { $$ = $1; }
-       |       ary '[' expr ']'                     /* array slice */
+       |       sliceme '[' expr ']'                     /* array slice */
                        { $$ = op_prepend_elem(OP_ASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_ASLICE, 0,
                                        list($3),
                                        ref($1, OP_ASLICE)));
+                         if ($$ && $1)
+                             $$->op_private |=
+                                 $1->op_private & OPpSLICEWARNING;
                          TOKEN_GETMAD($2,$$,'[');
                          TOKEN_GETMAD($4,$$,']');
                        }
-       |       ary '{' expr ';' '}'                 /* @hash{@keys} */
+       |       kvslice '[' expr ']'                 /* array key/value slice */
+                       { $$ = op_prepend_elem(OP_KVASLICE,
+                               newOP(OP_PUSHMARK, 0),
+                                   newLISTOP(OP_KVASLICE, 0,
+                                       list($3),
+                                       ref(oopsAV($1), OP_KVASLICE)));
+                         if ($$ && $1)
+                             $$->op_private |=
+                                 $1->op_private & OPpSLICEWARNING;
+                         TOKEN_GETMAD($2,$$,'[');
+                         TOKEN_GETMAD($4,$$,']');
+                       }
+       |       sliceme '{' expr ';' '}'                 /* @hash{@keys} */
                        { $$ = op_prepend_elem(OP_HSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_HSLICE, 0,
                                        list($3),
                                        ref(oopsHV($1), OP_HSLICE)));
+                         if ($$ && $1)
+                             $$->op_private |=
+                                 $1->op_private & OPpSLICEWARNING;
                            PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
                        }
-       |       hsh '{' expr ';' '}'                 /* %hash{@keys} */
+       |       kvslice '{' expr ';' '}'                 /* %hash{@keys} */
                        { $$ = op_prepend_elem(OP_KVHSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_KVHSLICE, 0,
                                        list($3),
                                        ref($1, OP_KVHSLICE)));
+                         if ($$ && $1)
+                             $$->op_private |=
+                                 $1->op_private & OPpSLICEWARNING;
                            PL_parser->expect = XOPERATOR;
                          TOKEN_GETMAD($2,$$,'{');
                          TOKEN_GETMAD($4,$$,';');
@@ -1253,6 +1287,27 @@ term     :       termbinop
                            op_append_elem(OP_LIST, $3, scalar($2)));
                          TOKEN_GETMAD($1,$$,'o');
                        }
+       |       term ARROW '$' '*'
+                       { $$ = newSVREF($1);
+                         TOKEN_GETMAD($3,$$,'$');
+                       }
+       |       term ARROW '@' '*'
+                       { $$ = newAVREF($1);
+                         TOKEN_GETMAD($3,$$,'@');
+                       }
+       |       term ARROW '%' '*'
+                       { $$ = newHVREF($1);
+                         TOKEN_GETMAD($3,$$,'%');
+                       }
+       |       term ARROW '&' '*'
+                       { $$ = newUNOP(OP_ENTERSUB, 0,
+                                      scalar(newCVREF(IVAL($3),$1)));
+                         TOKEN_GETMAD($3,$$,'&');
+                       }
+       |       term ARROW '*' '*'      %prec '('
+                       { $$ = newGVREF(0,$1);
+                         TOKEN_GETMAD($3,$$,'*');
+                       }
        |       LOOPEX  /* loop exiting command (goto, last, dump, etc) */
                        { $$ = newOP(IVAL($1), OPf_SPECIAL);
                            PL_hints |= HINT_BLOCK_SCOPE;
@@ -1420,12 +1475,14 @@ scalar  :       '$' indirob
 
 ary    :       '@' indirob
                        { $$ = newAVREF($2);
+                         if ($$) $$->op_private |= IVAL($1);
                          TOKEN_GETMAD($1,$$,'@');
                        }
        ;
 
 hsh    :       '%' indirob
                        { $$ = newHVREF($2);
+                         if ($$) $$->op_private |= IVAL($1);
                          TOKEN_GETMAD($1,$$,'%');
                        }
        ;
@@ -1434,6 +1491,10 @@ arylen   :       DOLSHARP indirob
                        { $$ = newAVREF($2);
                          TOKEN_GETMAD($1,$$,'l');
                        }
+       |       term ARROW DOLSHARP '*'
+                       { $$ = newAVREF($1);
+                         TOKEN_GETMAD($3,$$,'l');
+                       }
        ;
 
 star   :       '*' indirob
@@ -1442,6 +1503,27 @@ star     :       '*' indirob
                        }
        ;
 
+sliceme        :       ary
+       |       term ARROW '@'
+                       { $$ = newAVREF($1);
+                         TOKEN_GETMAD($3,$$,'@');
+                       }
+       ;
+
+kvslice        :       hsh
+       |       term ARROW '%'
+                       { $$ = newHVREF($1);
+                         TOKEN_GETMAD($3,$$,'@');
+                       }
+       ;
+
+gelem  :       star
+       |       term ARROW '*'
+                       { $$ = newGVREF(0,$1);
+                         TOKEN_GETMAD($3,$$,'*');
+                       }
+       ;
+
 /* Indirect objects */
 indirob        :       WORD
                        { $$ = scalar($1); }