diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -510,6 +510,7 @@ 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 common::IfNoLvalue MakeSymbol( @@ -2008,6 +2009,14 @@ 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 @@ (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()) { @@ -4580,9 +4588,7 @@ 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 @@ } 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 @@ 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 --- /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 --- a/flang/test/Semantics/symbol05.f90 +++ b/flang/test/Semantics/symbol05.f90 @@ -33,7 +33,7 @@ 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 --- a/flang/test/Semantics/symbol09.f90 +++ b/flang/test/Semantics/symbol09.f90 @@ -106,7 +106,7 @@ 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