summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2017-11-22 16:03:29 +0000
committerDavid Mitchell <davem@iabyn.com>2017-11-23 08:52:16 +0000
commit4a4aa6e0f79d1ce5f279a245ef7a700805da3c48 (patch)
tree9b2b1dc2a9b2c7048e2b814b80bc58e79225351f /lib
parentc4874d8a25094b3c3426b7831ebba86fc934a652 (diff)
downloadperl-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.pm22
-rw-r--r--lib/B/Deparse.t9
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);