[flang] Copy attributes and flags onto host-assoc symbols

[tskeith]

Summary

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.

[klausler]

What if the attributes of the host symbol change after the association symbol is created? It might be safer to fetch the attributes and flags from the original host symbol when they're needed.

[tskeith]

In D85763#2210944, @klausler wrote:

What if the attributes of the host symbol change after the association symbol is created? It might be safer to fetch the attributes and flags from the original host symbol when they're needed.

I don't think that can happen because we process the host first, though I'm not positive.

Doing it when requested means we need to know which attributes we look for on the local symbol and which on the host symbol (or maybe it works to check both).

[PeteSteinfeld]

Rather than creating a new symbol, you could call GetAssociationRoot in check-deallocate.cpp at line 29:

} else if (!IsAllocatableOrPointer(
               *GetAssociationRoot(*symbol))) { // C932

[tskeith]

In D85763#2211174, @PeteSteinfeld wrote:

Rather than creating a new symbol, you could call GetAssociationRoot in check-deallocate.cpp at line 29:

} else if (!IsAllocatableOrPointer(
               *GetAssociationRoot(*symbol))) { // C932

We're already creating the HostAssocDetails symbols, this change is about getting the right attributes on them. We can follow the associations to test for pointer and allocatable, but some attributes can be on the HostAssocDetails symbol so in those cases we need to check both symbols. This is simpler and similar to how use-association symbols are managed.

flang/lib/Semantics/resolve-names.cpp

public:
   void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
   // Make a new symbol with the name and attrs of an existing one
   Symbol &CopySymbol(const SourceName &, const Symbol &);
 
   // Make symbols in the current or named scope
   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(
       const parser::Name &name, D &&details) {
     return MakeSymbol(name, Attrs{}, std::move(details));
   }
 
   template <typename D>
Symbol &ScopeHandler::MakeSymbol(
   }
 }
 Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
   return MakeSymbol(currScope(), name, 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());
 }
 
 // Look for name only in scope, not in enclosing scopes.
 Symbol *ScopeHandler::FindInScope(
     const Scope &scope, const parser::Name &name) {
Symbol &DeclarationVisitor::HandleAttributeStmt(
   }
   auto *symbol{FindInScope(currScope(), name)};
   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
     // these can be set on a symbol that is host-assoc or use-assoc
     if (!symbol &&
         (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>()) {
     Say(currStmtSource().value(),
         "Cannot change %s attribute on use-associated '%s'"_err_en_US,
         EnumToString(attr), name.source);
     return *symbol;
   }
Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
   return *prev;
 }
 
 Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
   Symbol &prev{FindOrDeclareEnclosingEntity(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,
     const std::optional<parser::IntegerTypeSpec> &type) {
   const DeclTypeSpec *declTypeSpec{nullptr};
   if (auto *prev{FindSymbol(name)}) {
     if (prev->owner() == currScope()) {
       SayAlreadyDeclared(name, *prev);

 
 bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
   for (const auto &name : x.v) {
     if (!FindSymbol(name)) {
       Say(name, "Variable '%s' with SHARED locality implicitly declared"_en_US);
     }
     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;
 }
 
 bool ConstructVisitor::Pre(const parser::AcSpec &x) {
   ProcessTypeSpec(x.type);
   PushScope(Scope::Kind::ImpliedDos, nullptr);

 // If implicit types are allowed, ensure name is in the symbol table.
 // Otherwise, report an error if it hasn't been declared.
 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
   if (Symbol * symbol{FindSymbol(name)}) {
     if (CheckUseError(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);
       ApplyImplicitRules(*symbol);
     }
     return &name;
   }
   if (isImplicitNoneType()) {

flang/test/Semantics/deallocate06.f90

+! 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

flang/test/Semantics/symbol05.f90

block
   !DEF: /s2/x (Implicit) ObjectEntity INTEGER(4)
   x = 1
   !DEF: /s2/y (Implicit) ObjectEntity REAL(4)
   y = 2
  end block
 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
  end subroutine
 end subroutine
 
 !DEF: /s3 (Subroutine) Subprogram
 subroutine s3

flang/test/Semantics/symbol09.f90

 !DEF: /s6 (Subroutine) Subprogram
 subroutine s6
  !DEF: /s6/j ObjectEntity INTEGER(8)
  integer(kind=8) j
  !DEF: /s6/a ObjectEntity INTEGER(4)
  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
   !REF: /s6/Block1/i
   !REF: /s6/Block1/j
   a(i) = j+1
  end do
 end subroutine