diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -88,6 +88,7 @@ bool DoesScopeContain(const Scope *, const Symbol &); bool IsUseAssociated(const Symbol &, const Scope &); bool IsHostAssociated(const Symbol &, const Scope &); +bool IsHostAssociatedIntoSubprogram(const Symbol &, const Scope &); inline bool IsStmtFunction(const Symbol &symbol) { const auto *subprogram{symbol.detailsIf()}; return subprogram && subprogram->stmtFunction(); diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp --- a/flang/lib/Semantics/assignment.cpp +++ b/flang/lib/Semantics/assignment.cpp @@ -103,7 +103,7 @@ const Symbol &x, const Scope &scope) { // See C1594, first paragraph. These conditions enable checks on both // left-hand and right-hand sides in various circumstances. - if (IsHostAssociated(x, scope)) { + if (IsHostAssociatedIntoSubprogram(x, scope)) { return "host-associated"; } else if (IsUseAssociated(x, scope)) { return "USE-associated"; diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -255,6 +255,12 @@ GetProgramUnitOrBlockConstructContaining(scope)); } +bool IsHostAssociatedIntoSubprogram(const Symbol &symbol, const Scope &scope) { + return DoesScopeContain( + &GetProgramUnitOrBlockConstructContaining(FollowHostAssoc(symbol)), + GetProgramUnitContaining(scope)); +} + bool IsInStmtFunction(const Symbol &symbol) { if (const Symbol * function{symbol.owner().symbol()}) { return IsStmtFunction(*function);