From d66463eedc5035a4ea4c6085e55405465cca6796 Mon Sep 17 00:00:00 2001
From: Tim Keith <tkeith@nvidia.com>
Date: Mon, 17 Aug 2020 07:00:04 -0700
Subject: [PATCH] [flang] Copy attributes and flags onto host-assoc symbols

As with use-associated symbols, copy the attributes and flags from the
original symbol onto host-associated symbols when they are created.

This was showing up as an error on a deallocate of a host-associated
name. We reported an error because the symbol didn't have the POINTER
or ALLOCATABLE attribute.

Differential Revision: https://reviews.llvm.org/D85763
---
 flang/lib/Semantics/resolve-names.cpp | 23 +++++++++++++----------
 flang/test/Semantics/deallocate06.f90 | 25 +++++++++++++++++++++++++
 flang/test/Semantics/symbol05.f90     |  2 +-
 flang/test/Semantics/symbol09.f90     |  2 +-
 4 files changed, 40 insertions(+), 12 deletions(-)
 create mode 100644 flang/test/Semantics/deallocate06.f90

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5806058..299b180 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -510,6 +510,7 @@ public:
   Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
   Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
   Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
+  Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);
 
   template <typename D>
   common::IfNoLvalue<Symbol &, D> MakeSymbol(
@@ -2008,6 +2009,14 @@ Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
 Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
   return Resolve(name, MakeSymbol(name.source, attrs));
 }
+Symbol &ScopeHandler::MakeHostAssocSymbol(
+    const parser::Name &name, const Symbol &hostSymbol) {
+  Symbol &symbol{MakeSymbol(name, HostAssocDetails{hostSymbol})};
+  name.symbol = &symbol;
+  symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
+  symbol.flags() = hostSymbol.flags();
+  return symbol;
+}
 Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
   CHECK(!FindInScope(currScope(), name));
   return MakeSymbol(currScope(), name, symbol.attrs());
@@ -3304,8 +3313,7 @@ Symbol &DeclarationVisitor::HandleAttributeStmt(
         (currScope().kind() == Scope::Kind::Subprogram ||
             currScope().kind() == Scope::Kind::Block)) {
       if (auto *hostSymbol{FindSymbol(name)}) {
-        name.symbol = nullptr;
-        symbol = &MakeSymbol(name, HostAssocDetails{*hostSymbol});
+        symbol = &MakeHostAssocSymbol(name, *hostSymbol);
       }
     }
   } else if (symbol && symbol->has<UseDetails>()) {
@@ -4580,9 +4588,7 @@ Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
   if (!PassesLocalityChecks(name, prev)) {
     return nullptr;
   }
-  Symbol &symbol{MakeSymbol(name, HostAssocDetails{prev})};
-  name.symbol = &symbol;
-  return &symbol;
+  return &MakeHostAssocSymbol(name, prev);
 }
 
 Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
@@ -4881,9 +4887,7 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
     }
     Symbol &prev{FindOrDeclareEnclosingEntity(name)};
     if (PassesSharedLocalityChecks(name, prev)) {
-      auto &symbol{MakeSymbol(name, HostAssocDetails{prev})};
-      symbol.set(Symbol::Flag::LocalityShared);
-      name.symbol = &symbol; // override resolution to parent
+      MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);
     }
   }
   return false;
@@ -5419,8 +5423,7 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
       return nullptr; // reported an error
     }
     if (IsUplevelReference(*symbol)) {
-      name.symbol = nullptr;
-      MakeSymbol(name, HostAssocDetails{*symbol});
+      MakeHostAssocSymbol(name, *symbol);
     } else if (IsDummy(*symbol) ||
         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
       ConvertToObjectEntity(*symbol);
diff --git a/flang/test/Semantics/deallocate06.f90 b/flang/test/Semantics/deallocate06.f90
new file mode 100644
index 0000000..fc9ff14
--- /dev/null
+++ b/flang/test/Semantics/deallocate06.f90
@@ -0,0 +1,25 @@
+! RUN: %S/test_errors.sh %s %t %f18
+
+! Test deallocate of use- and host-associated variables
+module m1
+  real, pointer :: a(:)
+  real, allocatable :: b(:)
+end
+
+subroutine s1()
+  use m1
+  complex, pointer :: c(:)
+  complex, allocatable :: d(:)
+  complex :: e(10)
+  deallocate(a)
+  deallocate(b)
+contains
+  subroutine s2()
+    deallocate(a)
+    deallocate(b)
+    deallocate(c)
+    deallocate(d)
+    !ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
+    deallocate(e)
+  end subroutine
+end
diff --git a/flang/test/Semantics/symbol05.f90 b/flang/test/Semantics/symbol05.f90
index 03f6fbb..2def77e 100644
--- a/flang/test/Semantics/symbol05.f90
+++ b/flang/test/Semantics/symbol05.f90
@@ -33,7 +33,7 @@ subroutine s2
 contains
  !DEF: /s2/s (Subroutine) Subprogram
  subroutine s
-  !DEF: /s2/s/x HostAssoc INTEGER(4)
+  !DEF: /s2/s/x (Implicit) HostAssoc INTEGER(4)
   x = 1
   !DEF: /s2/s/w (Implicit) ObjectEntity INTEGER(4)
   w = 1
diff --git a/flang/test/Semantics/symbol09.f90 b/flang/test/Semantics/symbol09.f90
index 17ddccc..d3604a1 100644
--- a/flang/test/Semantics/symbol09.f90
+++ b/flang/test/Semantics/symbol09.f90
@@ -106,7 +106,7 @@ subroutine s6
  integer :: a(5) = 1
  !DEF: /s6/Block1/i ObjectEntity INTEGER(4)
  !DEF: /s6/Block1/j (LocalityLocal) HostAssoc INTEGER(8)
- !DEF: /s6/Block1/k (LocalityLocalInit) HostAssoc INTEGER(4)
+ !DEF: /s6/Block1/k (Implicit, LocalityLocalInit) HostAssoc INTEGER(4)
   !DEF: /s6/Block1/a (LocalityShared) HostAssoc INTEGER(4)
  do concurrent(integer::i=1:5)local(j)local_init(k)shared(a)
   !REF: /s6/Block1/a
-- 
2.7.4