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

2 files changed, 15 insertions, 13 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index ab691c2491..d110c970a7 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -1184,7 +1184,7 @@ sub pad_subs {
 #
 # Normally a bunch of argelem ops will have been generated by the
 # signature parsing, but it's possible that ops have been added manually
-# or altered. In this case we "return ()" and fall back to general
+# or altered. In this case we return "()" and fall back to general
 # deparsing of the individual sigelems as 'my $x = $_[N]' etc.
 #
 # We're only called if the first two ops are nextstate and argcheck.
@@ -1275,13 +1275,14 @@ sub deparse_argops {
 
 # Deparse a sub. Returns everything except the 'sub foo',
 # e.g.  ($$) : method { ...; }
-# or    ($a, $b) : prototype($$) lvalue;
+# or    : prototype($$) lvalue ($a, $b) { ...; };
 
 sub deparse_sub {
     my $self = shift;
     my $cv = shift;
     my @attrs;
-    my $protosig; # prototype or signature (what goes in the (....))
+    my $proto;
+    my $sig;
 
 Carp::confess("NULL in deparse_sub") if !defined($cv) || $cv->isa("B::NULL");
 Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
@@ -1289,12 +1290,12 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
 
     my $has_sig = $self->{hinthash}{feature_signatures};
     if ($cv->FLAGS & SVf_POK) {
-	my $proto = $cv->PV;
+	my $myproto = $cv->PV;
 	if ($has_sig) {
-            push @attrs, "prototype($proto)";
+            push @attrs, "prototype($myproto)";
         }
         else {
-            $protosig = $proto;
+            $proto = $myproto;
         }
     }
     if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) {
@@ -1326,10 +1327,10 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
                      and $$o2)
                 {
                     if ($o2->name eq 'argcheck') {
-                        my ($nexto, $sig) = $self->deparse_argops($firstop, $cv);
+                        my ($nexto, $mysig) = $self->deparse_argops($firstop, $cv);
                         if (defined $nexto) {
                             $firstop = $nexto;
-                            $protosig = $sig;
+                            $sig = $mysig;
                         }
                     }
                 }
@@ -1365,10 +1366,11 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
 	    $body = ';'
 	}
     }
-    $protosig = defined $protosig ? "($protosig) " : "";
+    $proto = defined $proto ? "($proto) " : "";
+    $sig   = defined $sig   ? "($sig) "   : "";
     my $attrs = '';
     $attrs = ': ' . join('', map "$_ ", @attrs) if @attrs;
-    return "$protosig$attrs$body\n";
+    return "$proto$attrs$sig$body\n";
 }
 
 sub deparse_format {
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index cbee5427a8..3219e19b81 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2586,7 +2586,7 @@ $x++;
 no warnings;
 use feature 'signatures';
 my $x;
-sub ($a, $b) : prototype($$) {
+my $f = sub : prototype($$) ($a, $b) {
     $x++;
 }
 ;
@@ -2596,7 +2596,7 @@ $x++;
 no warnings;
 use feature 'signatures';
 my $x;
-sub ($a, $b) : prototype($$) lvalue {
+my $f = sub : prototype($$) lvalue ($a, $b) {
     $x++;
 }
 ;
@@ -2606,7 +2606,7 @@ $x++;
 no warnings;
 use feature 'signatures';
 my $x;
-sub ($a, $b) : lvalue method {
+my $f = sub : lvalue method ($a, $b) {
     $x++;
 }
 ;