%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
+%type <opval> formname subname proto optsubbody cont my_scalar formblock
%type <opval> subattrlist myattrlist myattrterm myterm
-%type <opval> termbinop termunop anonymous termdo
+%type <opval> realsubbody subsignature termbinop termunop anonymous termdo
%type <opval> formstmtseq formline formarg
%nonassoc <i_tkval> PREC_LOW
PL_parser->in_my = 0;
PL_parser->in_my_stash = NULL;
}
- proto subattrlist subbody
+ proto subattrlist optsubbody
{
SvREFCNT_inc_simple_void(PL_compcv);
#ifdef MAD
}
;
-/* Subroutine body - either null or a block */
-subbody : block { $$ = $1; }
+/* Optional subroutine signature */
+subsignature: /* NULL */ { $$ = (OP*)NULL; }
+ | '('
+ {
+ if (!FEATURE_SIGNATURES_IS_ENABLED)
+ Perl_croak(aTHX_ "Experimental "
+ "subroutine signatures not enabled");
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__SIGNATURES),
+ "The signatures feature is experimental");
+ $<opval>$ = parse_subsignature();
+ }
+ ')'
+ {
+ $$ = op_append_list(OP_LINESEQ, $<opval>2,
+ newSTATEOP(0, NULL, sawparens(newNULLLIST())));
+ PL_parser->expect = XBLOCK;
+ }
+ ;
+
+/* Subroutine body - block with optional signature */
+realsubbody: remember subsignature '{' stmtseq '}'
+ {
+ if (PL_parser->copline > (line_t)IVAL($3))
+ PL_parser->copline = (line_t)IVAL($3);
+ $$ = block_end($1,
+ op_append_list(OP_LINESEQ, $2, $4));
+ TOKEN_GETMAD($3,$$,'{');
+ TOKEN_GETMAD($5,$$,'}');
+ }
+ ;
+
+/* Optional subroutine body, for named subroutine declaration */
+optsubbody: realsubbody { $$ = $1; }
| ';' { $$ = IF_MAD(
newOP(OP_NULL,0),
(OP*)NULL
TOKEN_GETMAD($2,$$,';');
TOKEN_GETMAD($3,$$,'}');
}
- | ANONSUB startanonsub proto subattrlist block %prec '('
+ | ANONSUB startanonsub proto subattrlist realsubbody %prec '('
{ SvREFCNT_inc_simple_void(PL_compcv);
$$ = newANONATTRSUB($2, $3, $4, $5);
TOKEN_GETMAD($1,$$,'o');
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
TOKEN_GETMAD($1,$$,'D');
}
- | DO subname '(' ')' /* do somesub() */
- { $$ = newUNOP(OP_ENTERSUB,
- OPf_SPECIAL|OPf_STACKED,
- op_prepend_elem(OP_LIST,
- scalar(newCVREF(
- (OPpENTERSUB_AMPER<<8),
- scalar($2)
- )),(OP*)NULL)); dep();
- TOKEN_GETMAD($1,$$,'o');
- TOKEN_GETMAD($3,$$,'(');
- TOKEN_GETMAD($4,$$,')');
- }
- | DO subname '(' expr ')' /* do somesub(@args) */
- { $$ = newUNOP(OP_ENTERSUB,
- OPf_SPECIAL|OPf_STACKED,
- op_append_elem(OP_LIST,
- $4,
- scalar(newCVREF(
- (OPpENTERSUB_AMPER<<8),
- scalar($2)
- )))); dep();
- TOKEN_GETMAD($1,$$,'o');
- TOKEN_GETMAD($3,$$,'(');
- TOKEN_GETMAD($5,$$,')');
- }
- | DO scalar '(' ')' /* do $subref () */
- { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
- op_prepend_elem(OP_LIST,
- scalar(newCVREF(0,scalar($2))), (OP*)NULL)); dep();
- TOKEN_GETMAD($1,$$,'o');
- TOKEN_GETMAD($3,$$,'(');
- TOKEN_GETMAD($4,$$,')');
- }
- | DO scalar '(' expr ')' /* do $subref (@args) */
- { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
- op_prepend_elem(OP_LIST,
- $4,
- scalar(newCVREF(0,scalar($2))))); dep();
- TOKEN_GETMAD($1,$$,'o');
- TOKEN_GETMAD($3,$$,'(');
- TOKEN_GETMAD($5,$$,')');
- }
-
;
term : termbinop