This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse: emit pragmas *before* each sub
authorDavid Mitchell <davem@iabyn.com>
Thu, 21 Jul 2016 14:11:50 +0000 (15:11 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Aug 2016 19:54:40 +0000 (20:54 +0100)
Before deparsing a sub, emit any pragma changes associated with the
first nextstate in the sub *before* emitting the sub itself.

So this:

    use strict;
    sub f { ...}

doesn't get deparsed as

    sub f { use strict; ...}

There was already a partial fix for this in pp_nextstate. Making
next_todo() always emit pragmas catches more cases and makes pp_nextstate
simpler.

This is in preparation for deparsing 'use feature "signatures"'.

lib/B/Deparse.pm
lib/B/Deparse.t

index d921da7..d314c74 100644 (file)
@@ -495,6 +495,13 @@ sub next_todo {
     my $ent = shift @{$self->{'subs_todo'}};
     my ($seq, $cv, $is_form, $name) = @$ent;
 
+    # any 'use strict; package foo' that should come before the sub
+    # declaration to sync with the first COP of the sub
+    my $pragmata = '';
+    if ($cv and !null($cv->START) and is_state($cv->START))  {
+        $pragmata = $self->pragmata($cv->START);
+    }
+
     if (ref $name) { # lexical sub
        # emit the sub.
        my @text;
@@ -520,20 +527,20 @@ sub next_todo {
            # my sub foo;
            push @text, ";\n";
        }
-       return join "", @text;
+       return $pragmata . join "", @text;
     }
 
     my $gv = $cv->GV;
     $name //= $self->gv_name($gv);
     if ($is_form) {
-       return $self->keyword("format") . " $name =\n"
+       return $pragmata . $self->keyword("format") . " $name =\n"
            . $self->deparse_format($cv). "\n";
     } else {
        my $use_dec;
        if ($name eq "BEGIN") {
            $use_dec = $self->begin_is_use($cv);
            if (defined ($use_dec) and $self->{'expand'} < 5) {
-               return () if 0 == length($use_dec);
+               return $pragmata if 0 == length($use_dec);
                $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e;
            }
        }
@@ -554,7 +561,7 @@ sub next_todo {
            }
        }
        if ($use_dec) {
-           return "$p$l$use_dec";
+           return "$pragmata$p$l$use_dec";
        }
         if ( $name !~ /::/ and $self->lex_in_scope("&$name")
                             || $self->lex_in_scope("&$name", 1) )
@@ -563,7 +570,7 @@ sub next_todo {
         } elsif (defined $stash) {
             $name =~ s/^\Q$stash\E::(?!\z|.*::)//;
         }
-       my $ret = "${p}${l}" . $self->keyword("sub") . " $name "
+       my $ret = "$pragmata${p}${l}" . $self->keyword("sub") . " $name "
              . $self->deparse_sub($cv);
        $self->{'subs_declared'}{$name} = 1;
        return $ret;
@@ -2001,7 +2008,7 @@ sub pp_nextstate {
     my($op, $cx) = @_;
     $self->{'curcop'} = $op;
 
-    my @text = $self->pragmata($op);
+    my @text;
 
     my @subs = $self->cop_subs($op);
     if (@subs) {
@@ -2010,13 +2017,8 @@ sub pp_nextstate {
     }
     push @text, @subs;
 
+    push @text, $self->pragmata($op);
 
-    # cop_subs above may have changed the package; restore it
-    my $stash = $op->stashpv;
-    if ($stash ne $self->{'curstash'}) {
-       push @text, $self->keyword("package") . " $stash;\n";
-       $self->{'curstash'} = $stash;
-    }
 
     # This should go after of any branches that add statements, to
     # increase the chances that it refers to the same line it did in
index 7dd056d..24db3de 100644 (file)
@@ -368,20 +368,20 @@ EOCODP
 # CORE::no
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub no; CORE::no less" 2>&1`;
-like($a, qr/my sub no;\nCORE::no less;/,
+like($a, qr/my sub no;\n.*CORE::no less;/s,
     'CORE::no after my sub no');
 
 # CORE::use
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub use; CORE::use less" 2>&1`;
-like($a, qr/my sub use;\nCORE::use less;/,
+like($a, qr/my sub use;\n.*CORE::use less;/s,
     'CORE::use after my sub use');
 
 # CORE::__DATA__
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub __DATA__; `
              .qq`CORE::__DATA__" 2>&1`;
-like($a, qr/my sub __DATA__;\nCORE::__DATA__/s,
+like($a, qr/my sub __DATA__;\n.*CORE::__DATA__/s,
     'CORE::__DATA__ after my sub __DATA__');
 
 # sub declarations