[flang] Fix crash in semantics on error case

[klausler]

An erroneous statement function declaration exposed an unhandled situation in a utility routine in semantics. Patch that hole and add a test.

Fixes #91429.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

An erroneous statement function declaration exposed an unhandled situation in a utility routine in semantics. Patch that hole and add a test.

Fixes #91429.

---

Full diff: https://github.com/llvm/llvm-project/pull/91482.diff

2 Files Affected:

• (modified) flang/lib/Semantics/tools.cpp (+8-6)
• (modified) flang/test/Semantics/stmt-func01.f90 (+8)

diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 2d0caff82eb2b..99381918fc638 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -256,15 +256,17 @@ static const Symbol &FollowHostAssoc(const Symbol &symbol) {
 }
 
 bool IsHostAssociated(const Symbol &symbol, const Scope &scope) {
-  return DoesScopeContain(
-      &GetProgramUnitOrBlockConstructContaining(FollowHostAssoc(symbol)),
-      GetProgramUnitOrBlockConstructContaining(scope));
+  const Symbol &base{FollowHostAssoc(symbol)};
+  return base.owner().IsTopLevel() ||
+      DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
+          GetProgramUnitOrBlockConstructContaining(scope));
 }
 
 bool IsHostAssociatedIntoSubprogram(const Symbol &symbol, const Scope &scope) {
-  return DoesScopeContain(
-      &GetProgramUnitOrBlockConstructContaining(FollowHostAssoc(symbol)),
-      GetProgramUnitContaining(scope));
+  const Symbol &base{FollowHostAssoc(symbol)};
+  return base.owner().IsTopLevel() ||
+      DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
+          GetProgramUnitContaining(scope));
 }
 
 bool IsInStmtFunction(const Symbol &symbol) {
diff --git a/flang/test/Semantics/stmt-func01.f90 b/flang/test/Semantics/stmt-func01.f90
index 733a7a56dfdb2..3c9ffa565900a 100644
--- a/flang/test/Semantics/stmt-func01.f90
+++ b/flang/test/Semantics/stmt-func01.f90
@@ -83,3 +83,11 @@ subroutine s4
   !ERROR: VOLATILE attribute may apply only to a variable
   sf(x) = 1.
 end
+
+subroutine s5
+  !ERROR: Invalid specification expression: reference to impure function 'k'
+  real x(k())
+  !WARNING: Name 'k' from host scope should have a type declaration before its local statement function definition
+  !ERROR: 'k' is already declared in this scoping unit
+  k() = 0.0
+end

[psteinfeld]

All builds and tests correctly and looks good.