[flang] Account for shadowed symbols when skimming executable part

flang/lib/Semantics/resolve-names.cpp

@@ -1573,8 +1573,7 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
     llvm_unreachable("This node is handled in ProgramUnit");
   }
 
-  void NoteExecutablePartCall(
-      Symbol::Flag, const parser::Call &, bool hasCUDAChevrons);
+  void NoteExecutablePartCall(Symbol::Flag, SourceName, bool hasCUDAChevrons);
 
   friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
 
@@ -7706,27 +7705,24 @@ bool ResolveNamesVisitor::CheckImplicitNoneExternal(
 // of the subprogram's interface, and to mark as procedures any symbols
 // that might otherwise have been miscategorized as objects.
 void ResolveNamesVisitor::NoteExecutablePartCall(
-    Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
-  auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
-  if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
-    // Subtlety: The symbol pointers in the parse tree are not set, because
-    // they might end up resolving elsewhere (e.g., construct entities in
-    // SELECT TYPE).
-    if (Symbol * symbol{currScope().FindSymbol(name->source)}) {
-      Symbol::Flag other{flag == Symbol::Flag::Subroutine
-              ? Symbol::Flag::Function
-              : Symbol::Flag::Subroutine};
-      if (!symbol->test(other)) {
-        ConvertToProcEntity(*symbol);
-        if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
-          symbol->set(flag);
-          if (IsDummy(*symbol)) {
-            SetImplicitAttr(*symbol, Attr::EXTERNAL);
-          }
-          ApplyImplicitRules(*symbol);
-          if (hasCUDAChevrons) {
-            details->set_isCUDAKernel();
-          }
+    Symbol::Flag flag, SourceName name, bool hasCUDAChevrons) {
+  // Subtlety: The symbol pointers in the parse tree are not set, because
+  // they might end up resolving elsewhere (e.g., construct entities in
+  // SELECT TYPE).
+  if (Symbol * symbol{currScope().FindSymbol(name)}) {
+    Symbol::Flag other{flag == Symbol::Flag::Subroutine
+            ? Symbol::Flag::Function
+            : Symbol::Flag::Subroutine};
+    if (!symbol->test(other)) {
+      ConvertToProcEntity(*symbol);
+      if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
+        symbol->set(flag);
+        if (IsDummy(*symbol)) {
+          SetImplicitAttr(*symbol, Attr::EXTERNAL);
+        }
+        ApplyImplicitRules(*symbol);
+        if (hasCUDAChevrons) {
+          details->set_isCUDAKernel();
         }
       }
     }
@@ -8445,21 +8441,130 @@ class ExecutionPartSkimmer {
   void Walk(const parser::ExecutionPart *exec) {
     if (exec) {
       parser::Walk(*exec, *this);
+      CHECK(nestedScopes_.empty());
     }
   }
 
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
   void Post(const parser::FunctionReference &fr) {
-    resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v, false);
+    NoteCall(Symbol::Flag::Function, fr.v, false);
   }
   void Post(const parser::CallStmt &cs) {
-    resolver_.NoteExecutablePartCall(
-        Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
+    NoteCall(Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
+  }
+  bool Pre(const parser::AssociateConstruct &) {
+    PushScope();
+    return true;
+  }
+  void Post(const parser::AssociateConstruct &) { PopScope(); }
+  bool Pre(const parser::Association &x) {
+    Hide(std::get<parser::Name>(x.t));
+    return true;
+  }
+  bool Pre(const parser::BlockConstruct &) {
+    PushScope();
+    return true;
+  }
+  void Post(const parser::BlockConstruct &) { PopScope(); }
+  bool Pre(const parser::EntityDecl &x) {
+    Hide(std::get<parser::ObjectName>(x.t));
+    return true;
+  }
+  void Post(const parser::ImportStmt &x) {
+    if (x.kind == common::ImportKind::None ||
+        x.kind == common::ImportKind::Only) {
+      if (!nestedScopes_.front().importOnly.has_value()) {
+        nestedScopes_.front().importOnly.emplace();
+      }
+      for (const auto &name : x.names) {
+        nestedScopes_.front().importOnly->emplace(name.source);
+      }
+    } else {
+      // no special handling needed for explicit names or IMPORT, ALL
+    }
+  }
+  void Post(const parser::UseStmt &x) {
+    if (const auto *onlyList{std::get_if<std::list<parser::Only>>(&x.u)}) {
+      for (const auto &only : *onlyList) {
+        if (const auto *name{std::get_if<parser::Name>(&only.u)}) {
+          Hide(*name);
+        } else if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
+          if (const auto *names{
+                  std::get_if<parser::Rename::Names>(&rename->u)}) {
+            Hide(std::get<0>(names->t));
+          }
+        }
+      }
+    } else {
+      // USE may or may not shadow symbols in host scopes
+      nestedScopes_.front().hasUseWithoutOnly = true;
+    }
+  }
+  bool Pre(const parser::DerivedTypeStmt &x) {
+    Hide(std::get<parser::Name>(x.t));
+    PushScope();
+    return true;
+  }
+  void Post(const parser::DerivedTypeDef &) { PopScope(); }
+  bool Pre(const parser::SelectTypeConstruct &) {
+    PushScope();
+    return true;
+  }
+  void Post(const parser::SelectTypeConstruct &) { PopScope(); }
+  bool Pre(const parser::SelectTypeStmt &x) {
+    if (const auto &maybeName{std::get<1>(x.t)}) {
+      Hide(*maybeName);
+    }
+    return true;
+  }
+  bool Pre(const parser::SelectRankConstruct &) {
+    PushScope();
+    return true;
+  }
+  void Post(const parser::SelectRankConstruct &) { PopScope(); }
+  bool Pre(const parser::SelectRankStmt &x) {
+    if (const auto &maybeName{std::get<1>(x.t)}) {
+      Hide(*maybeName);
+    }
+    return true;
   }
 
 private:
+  void NoteCall(
+      Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
+    auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
+    if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
+      for (const auto &scope : nestedScopes_) {
+        if (scope.locals.find(name->source) != scope.locals.end()) {
+          return; // shadowed by nested declaration
+        }
+        if (scope.hasUseWithoutOnly) {
+          break;
+        }
+        if (scope.importOnly &&
+            scope.importOnly->find(name->source) == scope.importOnly->end()) {
+          return; // not imported
+        }
+      }
+      resolver_.NoteExecutablePartCall(flag, name->source, hasCUDAChevrons);
+    }
+  }
+
+  void PushScope() { nestedScopes_.emplace_front(); }
+  void PopScope() { nestedScopes_.pop_front(); }
+  void Hide(const parser::Name &name) {
+    nestedScopes_.front().locals.emplace(name.source);
+  }
+
   ResolveNamesVisitor &resolver_;
+
+  struct NestedScopeInfo {
+    bool hasUseWithoutOnly{false};
+    std::set<SourceName> locals;
+    std::optional<std::set<SourceName>> importOnly;
+  };
+  std::list<NestedScopeInfo> nestedScopes_;
 };
 
 // Build the scope tree and resolve names in the specification parts of this

flang/test/Semantics/symbol32.f90

@@ -0,0 +1,75 @@
+! RUN: %python %S/test_symbols.py %s %flang_fc1
+! Test the executable part skimming for apparent calls, to ensure that
+! symbols in nested scopes (BLOCK, &c.) properly shadow host symbols.
+!DEF: /m Module
+module m
+end module
+!DEF: /subr (Subroutine) Subprogram
+!DEF: /subr/da INTENT(IN) ObjectEntity CLASS(*)
+!DEF: /subr/ar INTENT(IN) ObjectEntity REAL(4)
+subroutine subr (da, ar)
+ !REF: /subr/da
+ class(*), intent(in) :: da(:)
+ !REF: /subr/ar
+ real, intent(in) :: ar(..)
+ !DEF: /subr/s2 ObjectEntity REAL(4)
+ !DEF: /subr/s4 ObjectEntity REAL(4)
+ !DEF: /subr/s6 ObjectEntity REAL(4)
+ !DEF: /subr/s7 (Function) ProcEntity REAL(4)
+ !DEF: /subr/s8 ObjectEntity REAL(4)
+ real s2, s4, s6, s7, s8
+ !DEF: /s1 EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+ print *, s1(1)
+ block
+  !DEF: /subr/BlockConstruct1/s2 ObjectEntity INTEGER(4)
+  !DEF: /subr/BlockConstruct1/s5 (Function) ProcEntity INTEGER(4)
+  integer s2(10), s5
+  !DEF: /subr/BlockConstruct1/s4 DerivedType
+  type :: s4
+   !DEF: /subr/BlockConstruct1/s4/n ObjectEntity INTEGER(4)
+   integer :: n
+  end type
+  !REF: /subr/BlockConstruct1/s2
+  print *, s2(1)
+  !DEF: /s3 EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+  print *, s3(1)
+  !REF: /subr/BlockConstruct1/s4
+  print *, s4(1)
+  !REF: /subr/BlockConstruct1/s5
+  print *, s5(1)
+ end block
+ block
+  import, none
+  !DEF: /s2 EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+  print *, s2(1)
+ end block
+ block
+  !REF: /subr/s6
+  import, only: s6
+  !DEF: /s8 EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+  print *, s8(1)
+ end block
+ block
+  !REF: /m
+  use :: m
+  !REF: /subr/s7
+  print *, s7(1)
+ end block
+ !DEF: /subr/OtherConstruct1/s2 AssocEntity REAL(4)
+ associate (s2 => [1.])
+  !REF: /subr/OtherConstruct1/s2
+  print *, s2(1)
+ end associate
+ !REF: /subr/da
+ select type (s2 => da)
+ type is (real)
+  !DEF: /subr/OtherConstruct2/s2 AssocEntity REAL(4)
+  print *, s2(1)
+ end select
+ !REF: /subr/ar
+ select rank (s2 => ar)
+ rank (1)
+  !DEF: /subr/OtherConstruct3/s2 AssocEntity REAL(4)
+  print *, s2(1)
+ end select
+end subroutine