From 4a4aa6e0f79d1ce5f279a245ef7a700805da3c48 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Wed, 22 Nov 2017 16:03:29 +0000
Subject: 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.
---
 lib/B/Deparse.pm | 22 +++++++++++++++-------
 lib/B/Deparse.t  |  9 +++++++++
 2 files changed, 24 insertions(+), 7 deletions(-)

(limited to 'lib')

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);
-- 
cgit v1.2.1