[flang-commits] [flang] 77e965e - [flang] Allow for submodule override of module procedure

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-08-29T09:00:26-07:00
New Revision: 77e965ef454ab1fcb2564e3ade17880a71542f58

URL: https://github.com/llvm/llvm-project/commit/77e965ef454ab1fcb2564e3ade17880a71542f58
DIFF: https://github.com/llvm/llvm-project/commit/77e965ef454ab1fcb2564e3ade17880a71542f58.diff

LOG: [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

Added: 
    

Modified: 
    flang/include/flang/Semantics/tools.h
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/tools.cpp
    flang/test/Semantics/separate-mp04.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 0eed9937e7d78e..27303b8fb38381 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/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_

diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 9c215ed8738223..6ff9b2250f9225 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/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());
       }

diff  --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index e569e7e418b42d..075b7f94c4cfa8 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/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

diff  --git a/flang/test/Semantics/separate-mp04.f90 b/flang/test/Semantics/separate-mp04.f90
index 32005edd91a314..6aec5c9070b777 100644
--- a/flang/test/Semantics/separate-mp04.f90
+++ b/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