diff options
author | David Mitchell <davem@iabyn.com> | 2017-11-22 16:03:29 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2017-11-23 08:52:16 +0000 |
commit | 4a4aa6e0f79d1ce5f279a245ef7a700805da3c48 (patch) | |
tree | 9b2b1dc2a9b2c7048e2b814b80bc58e79225351f /lib | |
parent | c4874d8a25094b3c3426b7831ebba86fc934a652 (diff) | |
download | perl-4a4aa6e0f79d1ce5f279a245ef7a700805da3c48.tar.gz |
Deparse: handle state attributes
It already correctly deparses e.g.
my $x :shared = 1;
Now that attributes are legal on state vars, extend deparsing to them too:
state $x :shared = 1;
Also, rename maybe_my_attr() to maybe_var_attr() to reflect its widened
role.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/B/Deparse.pm | 22 | ||||
-rw-r--r-- | lib/B/Deparse.t | 9 |
2 files changed, 24 insertions, 7 deletions
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index b70941cb56..69379ce455 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -3502,8 +3502,8 @@ BEGIN { } -# Look for a my attribute declaration in a list or ex-list. Returns undef -# if not found, 'my($x, @a) :Foo(bar)' etc otherwise. +# Look for a my/state attribute declaration in a list or ex-list. +# Returns undef if not found, 'my($x, @a) :Foo(bar)' etc otherwise. # # There are three basic tree structs that are expected: # @@ -3548,7 +3548,7 @@ BEGIN { # <$> const[PV "foo"] sM ->a # <.> method_named[PV "import"] ->b -sub maybe_my_attr { +sub maybe_var_attr { my ($self, $op, $cx) = @_; my $kid = $op->first->sibling; # skip pushmark @@ -3561,13 +3561,13 @@ sub maybe_my_attr { # @padops and @entersubops. Return if anything else seen. # Also determine what class (if any) all the pad vars belong to my $class; + my $decl; # 'my' or 'state' my (@padops, @entersubops); for ($lop = $kid; !null($lop); $lop = $lop->sibling) { my $lopname = $lop->name; my $loppriv = $lop->private; if ($lopname =~ /^pad[sah]v$/) { return unless $loppriv & OPpLVAL_INTRO; - return if $loppriv & OPpPAD_STATE; my $padname = $self->padname_sv($lop->targ); my $thisclass = ($padname->FLAGS & SVpad_TYPED) @@ -3577,6 +3577,14 @@ sub maybe_my_attr { $class //= $thisclass; return unless $thisclass eq $class; + # all pad vars must be the same sort of declaration + # (all my, all state, etc) + my $this = ($loppriv & OPpPAD_STATE) ? 'state' : 'my'; + if (defined $decl) { + return unless $this eq $decl; + } + $decl = $this; + push @padops, $lop; } elsif ($lopname eq 'entersub') { @@ -3641,7 +3649,7 @@ sub maybe_my_attr { return if $$kid; } - my $res = 'my'; + my $res = $decl; $res .= " $class " if $class ne 'main'; $res .= (@varnames > 1) @@ -3658,7 +3666,7 @@ sub pp_list { { # might be my ($s,@a,%h) :Foo(bar); - my $my_attr = maybe_my_attr($self, $op, $cx); + my $my_attr = maybe_var_attr($self, $op, $cx); return $my_attr if defined $my_attr; } @@ -3962,7 +3970,7 @@ sub pp_null { # might be 'my $s :Foo(bar);' if ($op->targ == OP_LIST) { - my $my_attr = maybe_my_attr($self, $op, $cx); + my $my_attr = maybe_var_attr($self, $op, $cx); return $my_attr if defined $my_attr; } diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 7d5f3ca513..2094a37455 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -2993,3 +2993,12 @@ $x = "\$$a"; # CONTEXT use feature "state"; state @a = (1, 2, 3); state %h = ('a', 1, 'b', 2); +#### +# state var with attribute +# CONTEXT use feature "state"; +state $x :shared; +state $y :shared = 1; +state @a :shared; +state @b :shared = (1, 2); +state %h :shared; +state %i :shared = ('a', 1, 'b', 2); |