%token <i_tkval> FUNC0 FUNC1 FUNC UNIOP LSTOP
%token <i_tkval> RELOP EQOP MULOP ADDOP
%token <i_tkval> DOLSHARP DO HASHBRACK NOAMP
-%token <i_tkval> LOCAL MY MYSUB REQUIRE
-%token <i_tkval> COLONATTR
+%token <i_tkval> LOCAL MY REQUIRE
+%token <i_tkval> COLONATTR FORMLBRACK FORMRBRACK
%type <ival> grammar remember mremember
%type <ival> startsub startanonsub startformsub
%type <opval> formname subname proto subbody cont my_scalar formblock
%type <opval> subattrlist myattrlist myattrterm myterm
%type <opval> termbinop termunop anonymous termdo
+%type <opval> formstmtseq formline formarg
%nonassoc <i_tkval> PREC_LOW
%nonassoc LOOPEX
;
/* format body */
-formblock: '=' remember stmtseq '.'
+formblock: '=' remember ';' FORMRBRACK formstmtseq ';' '.'
{ if (PL_parser->copline > (line_t)IVAL($1))
PL_parser->copline = (line_t)IVAL($1);
- $$ = block_end($2, $3);
+ $$ = block_end($2, $5);
TOKEN_GETMAD($1,$$,'{');
- TOKEN_GETMAD($4,$$,'}');
+ TOKEN_GETMAD($7,$$,'}');
}
;
}
;
+/* A sequence of format lines */
+formstmtseq: /* NULL */
+ { $$ = (OP*)NULL; }
+ | formstmtseq formline
+ { $$ = op_append_list(OP_LINESEQ, $1, $2);
+ PL_pad_reset_pending = TRUE;
+ if ($1 && $2)
+ PL_hints |= HINT_BLOCK_SCOPE;
+ }
+ ;
+
/* A statement in the program, including optional labels */
fullstmt: barestmt
{
labfullstmt: LABEL barestmt
{
- $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
- savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+ $$ = newSTATEOP(SVf_UTF8
+ * PVAL($1)[strlen(PVAL($1))+1],
+ PVAL($1), $2);
TOKEN_GETMAD($1,
$2 ? cLISTOPx($$)->op_first : $$, 'L');
}
| LABEL labfullstmt
{
- $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
- savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+ $$ = newSTATEOP(SVf_UTF8
+ * PVAL($1)[strlen(PVAL($1))+1],
+ PVAL($1), $2);
TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
}
;
| FORMAT startformsub formname formblock
{
CV *fmtcv = PL_compcv;
- SvREFCNT_inc_simple_void(PL_compcv);
#ifdef MAD
$$ = newFORM($2, $3, $4);
prepend_madprops($1->tk_mad, $$, 'F');
pad_add_anon(fmtcv, OP_NULL);
}
}
- | SUB startsub subname proto subattrlist subbody
+ | SUB subname startsub
+ {
+ if ($2->op_type == OP_CONST) {
+ const char *const name =
+ SvPV_nolen_const(((SVOP*)$2)->op_sv);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END")
+ || strEQ(name, "INIT") || strEQ(name, "CHECK")
+ || strEQ(name, "UNITCHECK"))
+ CvSPECIAL_on(PL_compcv);
+ }
+ else
+ /* State subs inside anonymous subs need to be
+ clonable themselves. */
+ if (CvANON(CvOUTSIDE(PL_compcv))
+ || CvCLONE(CvOUTSIDE(PL_compcv))
+ || !PadnameIsSTATE(PadlistNAMESARRAY(CvPADLIST(
+ CvOUTSIDE(PL_compcv)
+ ))[$2->op_targ]))
+ CvCLONE_on(PL_compcv);
+ PL_parser->in_my = 0;
+ PL_parser->in_my_stash = NULL;
+ }
+ proto subattrlist subbody
{
SvREFCNT_inc_simple_void(PL_compcv);
#ifdef MAD
{
OP* o = newSVOP(OP_ANONCODE, 0,
- (SV*)newATTRSUB($2, $3, $4, $5, $6));
+ (SV*)(
+#endif
+ $2->op_type == OP_CONST
+ ? newATTRSUB($3, $2, $5, $6, $7)
+ : newMYSUB($3, $2, $5, $6, $7)
+#ifdef MAD
+ ));
$$ = newOP(OP_NULL,0);
op_getmad(o,$$,'&');
- op_getmad($3,$$,'n');
- op_getmad($4,$$,'s');
- op_getmad($5,$$,'a');
+ op_getmad($2,$$,'n');
+ op_getmad($5,$$,'s');
+ op_getmad($6,$$,'a');
token_getmad($1,$$,'d');
- append_madprops($6->op_madprop, $$, 0);
- $6->op_madprop = 0;
+ append_madprops($7->op_madprop, $$, 0);
+ $7->op_madprop = 0;
}
#else
- newATTRSUB($2, $3, $4, $5, $6);
- $$ = (OP*)NULL;
-#endif
- }
- | MYSUB startsub subname proto subattrlist subbody
- {
- /* Unimplemented "my sub foo { }" */
- SvREFCNT_inc_simple_void(PL_compcv);
-#ifdef MAD
- $$ = newMYSUB($2, $3, $4, $5, $6);
- token_getmad($1,$$,'d');
-#else
- newMYSUB($2, $3, $4, $5, $6);
+ ;
$$ = (OP*)NULL;
#endif
+ intro_my();
}
| PACKAGE WORD WORD ';'
{
}
;
+/* Format line */
+formline: THING formarg
+ { OP *list;
+ if ($2) {
+ OP *term = $2;
+ DO_MAD(term = newUNOP(OP_NULL, 0, term));
+ list = op_append_elem(OP_LIST, $1, term);
+ }
+ else {
+#ifdef MAD
+ OP *op = newNULLLIST();
+ list = op_append_elem(OP_LIST, $1, op);
+#else
+ list = $1;
+#endif
+ }
+ if (PL_parser->copline == NOLINE)
+ PL_parser->copline = CopLINE(PL_curcop)-1;
+ else PL_parser->copline--;
+ $$ = newSTATEOP(0, NULL,
+ convert(OP_FORMLINE, 0, list));
+ }
+ ;
+
+formarg : /* NULL */
+ { $$ = NULL; }
+ | FORMLBRACK stmtseq FORMRBRACK
+ { $$ = op_unscope($2); }
+ ;
+
/* An expression which may have a side-effect */
sideff : error
{ $$ = (OP*)NULL; }
;
/* Name of a subroutine - must be a bareword, could be special */
-subname : WORD { const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv);
- if (strEQ(name, "BEGIN") || strEQ(name, "END")
- || strEQ(name, "INIT") || strEQ(name, "CHECK")
- || strEQ(name, "UNITCHECK"))
- CvSPECIAL_on(PL_compcv);
- $$ = $1; }
+subname : WORD
+ | PRIVATEREF
;
/* Subroutine prototype */
op = (UNOP*)op->op_first; /* get to flip */
op = (UNOP*)op->op_first; /* get to range */
token_getmad($2,(OP*)op,'o');
- })
+ });
}
| term ANDAND term /* $x && $y */
{ $$ = newLOGOP(OP_AND, 0, $1, $3);
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
TOKEN_GETMAD($1,$$,'D');
}
- | DO WORD '(' ')' /* do somesub() */
+ | DO subname '(' ')' /* do somesub() */
{ $$ = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
op_prepend_elem(OP_LIST,
TOKEN_GETMAD($3,$$,'(');
TOKEN_GETMAD($4,$$,')');
}
- | DO WORD '(' expr ')' /* do somesub(@args) */
+ | DO subname '(' expr ')' /* do somesub(@args) */
{ $$ = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
op_append_elem(OP_LIST,
newLISTOP(OP_ASLICE, 0,
list($3),
ref($1, OP_ASLICE)));
+ if ($$ && $1)
+ $$->op_private |=
+ $1->op_private & OPpSLICEWARNING;
+ TOKEN_GETMAD($2,$$,'[');
+ TOKEN_GETMAD($4,$$,']');
+ }
+ | hsh '[' 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,$$,']');
}
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} */
+ { $$ = 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,$$,';');
{ $$ = $1; }
| amper /* &foo; */
{ $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
- | amper '(' ')' /* &foo() */
+ | amper '(' ')' /* &foo() or foo() */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1));
TOKEN_GETMAD($2,$$,'(');
TOKEN_GETMAD($3,$$,')');
}
- | amper '(' expr ')' /* &foo(@args) */
+ | amper '(' expr ')' /* &foo(@args) or foo(@args) */
{
$$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, $3, scalar($1)));
}
token_getmad($2,op,'(');
token_getmad($4,op,')');
- })
+ });
}
- | NOAMP WORD optlistexpr /* foo(@args) */
+ | NOAMP subname optlistexpr /* foo @args (no parens) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, $3, scalar($2)));
TOKEN_GETMAD($1,$$,'o');
token_getmad($1,$$,'d');
append_madprops($3->op_madprop, $$, 'a');
$3->op_madprop = 0;
- )
+ );
}
| MY myterm
{ $$ = localize($2,IVAL($1));
ary : '@' indirob
{ $$ = newAVREF($2);
+ if ($$) $$->op_private |= IVAL($1);
TOKEN_GETMAD($1,$$,'@');
}
;
hsh : '%' indirob
{ $$ = newHVREF($2);
+ if ($$) $$->op_private |= IVAL($1);
TOKEN_GETMAD($1,$$,'%');
}
;
https://perl5.git.perl.org / perl5.git / blobdiff