[flang] Allow for submodule override of module procedure

When checking that a module procedure definition is unique, allow for
the possibility that a submodule may contain a module procedure
interface that shadows a module procedure of the same name in its
(sub)module parent.   In other words, module procedure definitions
need only be unique in the tree of submodules rooted at the (sub)module
containing the relevant module procedure interface.

Differential Revision: https://reviews.llvm.org/D159033

Author: klausler

flang/include/flang/Semantics/tools.h

@@ -679,5 +679,8 @@ std::optional<R> GetConstExpr(
   return std::nullopt;
 }
 
+// Returns "m" for a module, "m:sm" for a submodule.
+std::string GetModuleOrSubmoduleName(const Symbol &);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Semantics/check-declarations.cpp

@@ -3133,26 +3133,22 @@ void CheckHelper::CheckModuleProcedureDef(const Symbol &symbol) {
       (procClass == ProcedureDefinitionClass::Module &&
           symbol.attrs().test(Attr::MODULE)) &&
       !subprogram->bindName() && !subprogram->isInterface()) {
-    const Symbol *module{nullptr};
-    if (const Scope * moduleScope{FindModuleContaining(symbol.owner())};
-        moduleScope && moduleScope->symbol()) {
-      if (const auto *details{
-              moduleScope->symbol()->detailsIf<ModuleDetails>()}) {
-        if (details->parent()) {
-          moduleScope = details->parent();
-        }
-        module = moduleScope->symbol();
-      }
-    }
-    if (module) {
+    const Symbol &interface {
+      subprogram->moduleInterface() ? *subprogram->moduleInterface() : symbol
+    };
+    if (const Symbol *
+            module{interface.owner().kind() == Scope::Kind::Module
+                    ? interface.owner().symbol()
+                    : nullptr};
+        module && module->has<ModuleDetails>()) {
       std::pair<SourceName, const Symbol *> key{symbol.name(), module};
       auto iter{moduleProcs_.find(key)};
       if (iter == moduleProcs_.end()) {
         moduleProcs_.emplace(std::move(key), symbol);
       } else if (
           auto *msg{messages_.Say(symbol.name(),
-              "Module procedure '%s' in module '%s' has multiple definitions"_err_en_US,
-              symbol.name(), module->name())}) {
+              "Module procedure '%s' in '%s' has multiple definitions"_err_en_US,
+              symbol.name(), GetModuleOrSubmoduleName(*module))}) {
         msg->Attach(iter->second->name(), "Previous definition of '%s'"_en_US,
             symbol.name());
       }

flang/lib/Semantics/tools.cpp

@@ -1646,4 +1646,13 @@ bool CouldBeDataPointerValuedFunction(const Symbol *original) {
   return false;
 }
 
+std::string GetModuleOrSubmoduleName(const Symbol &symbol) {
+  const auto &details{symbol.get<ModuleDetails>()};
+  std::string result{symbol.name().ToString()};
+  if (details.ancestor() && details.ancestor()->symbol()) {
+    result = details.ancestor()->symbol()->name().ToString() + ':' + result;
+  }
+  return result;
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/separate-mp04.f90

@@ -28,17 +28,17 @@ module subroutine x003
 
 submodule(m1) sm2
  contains
-  !ERROR: Module procedure 'x002' in module 'm1' has multiple definitions
+  !ERROR: Module procedure 'x002' in 'm1' has multiple definitions
   module subroutine x002
   end subroutine
 end
 
 submodule(m1:sm2) sm3
  contains
-  !ERROR: Module procedure 'x002' in module 'm1' has multiple definitions
+  !ERROR: Module procedure 'x002' in 'm1' has multiple definitions
   module subroutine x002
   end subroutine
-  !ERROR: Module procedure 'x003' in module 'm1' has multiple definitions
+  !ERROR: Module procedure 'x003' in 'm1' has multiple definitions
   module subroutine x003
   end subroutine
 end
@@ -51,7 +51,7 @@ module subroutine x004
 
 submodule(m1:sm1) sm5
  contains
-  !ERROR: Module procedure 'x004' in module 'm1' has multiple definitions
+  !ERROR: Module procedure 'x004' in 'm1:sm1' has multiple definitions
   module subroutine x004
   end subroutine
 end