[flang] Allow for submodule override of module procedure

[klausler]

Summary

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.

flang/include/flang/Semantics/tools.h

if (const auto *expr{Fortran::semantics::GetExpr(semanticsContext, x)}) {
     if constexpr (std::is_same_v<R, std::string>) {
       return Fortran::evaluate::GetScalarConstantValue<DefaultCharConstantType>(
           foldExpr);
     }
   }
   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

 
 void CheckHelper::CheckModuleProcedureDef(const Symbol &symbol) {
   auto procClass{ClassifyProcedure(symbol)};
   if (const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
       subprogram &&
       (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());
       }
     }
   }
 }
 
 void SubprogramMatchHelper::Check(

flang/lib/Semantics/tools.cpp

if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
           return true;
         }
       }
     }
   }
   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

contains
   module subroutine x002
   end subroutine
   module subroutine x003
   end subroutine
 end
 
 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
 
 submodule(m1:sm1) sm4
  contains
   module subroutine x004
   end subroutine
 end
 
 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