move sub attributes before the signature

RT #132141

Attributes such as :lvalue have to come *before* the signature to ensure
that they're applied to any code block within the signature; e.g.

    sub f :lvalue ($a = do { $x = "abc"; return substr($x,0,1)}) {
        ....
    }

So this commit moves sub attributes to come before the signature.  This is
how they were originally, but they were swapped with v5.21.7-394-gabcf453.
This commit is essentially a revert of that commit (and its followups
v5.21.7-395-g71917f6, v5.21.7-421-g63ccd0d), plus some extra work for
Deparse, and an extra test.

See:
    RT #123069 for why they were originally swapped
    RT #132141 for why that broke :lvalue
    http://nntp.perl.org/group/perl.perl5.porters/247999
               for a general discussion about RT #132141

1 files changed, 19 insertions, 58 deletions

diff --git a/perly.y b/perly.y
index 45536f2217..30d8360994 100644
--- a/perly.y
+++ b/perly.y
@@ -74,7 +74,7 @@
 %type <opval> formname subname proto optsubbody cont my_scalar my_var
 %type <opval> refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
-%type <opval> termbinop termunop anonymous termdo
+%type <opval> realsubbody termbinop termunop anonymous termdo
 %type <ival>  sigslurpsigil
 %type <opval> sigvarname sigdefault sigscalarelem sigslurpelem
 %type <opval> sigelem siglist siglistornull subsignature 
@@ -306,45 +306,6 @@ barestmt:	PLUGSTMT
 			  intro_my();
 			  parser->parsed_sub = 1;
 			}
-	|	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);
-			  parser->in_my = 0;
-			  parser->in_my_stash = NULL;
-			}
-		remember subsignature subattrlist '{' stmtseq '}'
-			{
-			  OP *body;
-			  if (parser->copline > (line_t)$8)
-			      parser->copline = (line_t)$8;
-			  body = block_end($5,
-				op_append_list(OP_LINESEQ, $6, $9));
-
-			  SvREFCNT_inc_simple_void(PL_compcv);
-			  $2->op_type == OP_CONST
-			      ? newATTRSUB($3, $2, NULL, $7, body)
-			      : newMYSUB($3, $2, NULL, $7, body)
-			  ;
-			  $$ = NULL;
-			  intro_my();
-			  parser->parsed_sub = 1;
-			}
 	|	PACKAGE BAREWORD BAREWORD ';'
 			{
 			  package($3);
@@ -781,7 +742,8 @@ siglistornull:		/* NULL */
 			{ $$ = $1; }
 
 /* Subroutine signature */
-subsignature:	'('
+subsignature:	/* NULL */ { $$ = (OP*)NULL; }
+	|	'('
                         {
                             ENTER;
                             SAVEIV(parser->sig_elems);
@@ -799,9 +761,9 @@ subsignature:	'('
                             UNOP_AUX_item *aux;
                             OP            *check;
 
-                            if (!parser->error_count) {
-                                assert(FEATURE_SIGNATURES_IS_ENABLED);
-                            }
+			    if (!FEATURE_SIGNATURES_IS_ENABLED)
+			        Perl_croak(aTHX_ "Experimental "
+                                    "subroutine signatures not enabled");
 
                             /* We shouldn't get here otherwise */
                             Perl_ck_warner_d(aTHX_
@@ -825,15 +787,25 @@ subsignature:	'('
                                                 newSTATEOP(0, NULL, NULL));
 
                             parser->in_my = 0;
-                            parser->expect = XATTRBLOCK;
+                            parser->expect = XBLOCK;
                             LEAVE;
 			}
 	;
 
 
+/* Subroutine body - block with optional signature */
+realsubbody:	remember subsignature '{' stmtseq '}'
+			{
+			  if (parser->copline > (line_t)$3)
+			      parser->copline = (line_t)$3;
+			  $$ = block_end($1,
+				op_append_list(OP_LINESEQ, $2, $4));
+ 			}
+ 	;
+
 
 /* Optional subroutine body, for named subroutine declaration */
-optsubbody:	block
+optsubbody:	realsubbody { $$ = $1; }
 	|	';'	{ $$ = NULL; }
 	;
 
@@ -1052,20 +1024,9 @@ anonymous:	'[' expr ']'
 			{ $$ = newANONHASH($2); }
 	|	HASHBRACK ';' '}'	%prec '(' /* { } (';' by tokener) */
 			{ $$ = newANONHASH(NULL); }
-	|	ANONSUB startanonsub proto subattrlist block		%prec '('
+	|	ANONSUB startanonsub proto subattrlist realsubbody	%prec '('
 			{ SvREFCNT_inc_simple_void(PL_compcv);
 			  $$ = newANONATTRSUB($2, $3, $4, $5); }
-	|	ANONSUB startanonsub remember subsignature subattrlist '{' stmtseq '}'	%prec '('
-			{
-			  OP *body;
-			  if (parser->copline > (line_t)$6)
-			      parser->copline = (line_t)$6;
-			  body = block_end($3,
-				op_append_list(OP_LINESEQ, $4, $7));
-			  SvREFCNT_inc_simple_void(PL_compcv);
-			  $$ = newANONATTRSUB($2, NULL, $5, body);
-			}
-
     ;
 
 /* Things called with "do" */