[flang] Silence bogus error about insufficiently defined interfaces

[klausler]

The interfaces of separate module procedures are sufficiently well defined in a submodule to be used in a local generic interface; the compiler just needed to work a little harder to find them.

Fixes #116567.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

The interfaces of separate module procedures are sufficiently well defined in a submodule to be used in a local generic interface; the compiler just needed to work a little harder to find them.

Fixes #116567.

---

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

4 Files Affected:

• (modified) flang/include/flang/Evaluate/tools.h (+2)
• (modified) flang/lib/Evaluate/characteristics.cpp (+6-1)
• (modified) flang/lib/Evaluate/tools.cpp (+33)
• (added) flang/test/Semantics/smp-def02.f90 (+42)

diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index a8a6eb922a045d..6261a4eec4a555 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1416,6 +1416,8 @@ common::IgnoreTKRSet GetIgnoreTKR(const Symbol &);
 
 std::optional<int> GetDummyArgumentNumber(const Symbol *);
 
+const Symbol *FindAncestorModuleProcedure(const Symbol *symInSubmodule);
+
 } // namespace Fortran::semantics
 
 #endif // FORTRAN_EVALUATE_TOOLS_H_
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 78cc63d0fde401..324d6b8dde73b8 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -731,11 +731,16 @@ static std::optional<Procedure> CharacterizeProcedure(
               return std::optional<Procedure>{};
             }
           },
-          [&](const semantics::EntityDetails &) {
+          [&](const semantics::EntityDetails &x) {
             CheckForNested(symbol);
             return std::optional<Procedure>{};
           },
           [&](const semantics::SubprogramNameDetails &) {
+            if (const semantics::Symbol *
+                ancestor{FindAncestorModuleProcedure(&symbol)}) {
+              return CharacterizeProcedure(
+                  *ancestor, context, seenProcs, emitError);
+            }
             CheckForNested(symbol);
             return std::optional<Procedure>{};
           },
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 4d98220a7065ca..15e3e9452894de 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1990,4 +1990,37 @@ std::optional<int> GetDummyArgumentNumber(const Symbol *symbol) {
   return std::nullopt;
 }
 
+// Given a symbol that is a SubprogramNameDetails in a submodule, try to
+// find its interface definition in its module or ancestor submodule.
+const Symbol *FindAncestorModuleProcedure(const Symbol *symInSubmodule) {
+  if (symInSubmodule && symInSubmodule->owner().IsSubmodule()) {
+    if (const auto *nameDetails{
+            symInSubmodule->detailsIf<semantics::SubprogramNameDetails>()};
+        nameDetails &&
+        nameDetails->kind() == semantics::SubprogramKind::Module) {
+      const Symbol *next{symInSubmodule->owner().symbol()};
+      while (const Symbol * submodSym{next}) {
+        next = nullptr;
+        if (const auto *modDetails{
+                submodSym->detailsIf<semantics::ModuleDetails>()};
+            modDetails && modDetails->isSubmodule() && modDetails->scope()) {
+          if (const semantics::Scope & parent{modDetails->scope()->parent()};
+              parent.IsSubmodule() || parent.IsModule()) {
+            if (auto iter{parent.find(symInSubmodule->name())};
+                iter != parent.end()) {
+              const Symbol &proc{iter->second->GetUltimate()};
+              if (IsProcedure(proc)) {
+                return &proc;
+              }
+            } else if (parent.IsSubmodule()) {
+              next = parent.symbol();
+            }
+          }
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
 } // namespace Fortran::semantics
diff --git a/flang/test/Semantics/smp-def02.f90 b/flang/test/Semantics/smp-def02.f90
new file mode 100644
index 00000000000000..ef27f14edae0a2
--- /dev/null
+++ b/flang/test/Semantics/smp-def02.f90
@@ -0,0 +1,42 @@
+!RUN: %flang -fsyntax-only %s 2>&1 | FileCheck --allow-empty %s
+!Ensure no bogus error messages about insufficiently defined procedures
+!CHECK-NOT: error
+
+module m
+  interface
+    module subroutine smp1(a1)
+    end
+  end interface
+end
+
+submodule(m) sm1
+  interface
+    module subroutine smp2(a1,a2)
+    end
+  end interface
+end
+
+submodule(m:sm1) sm2
+  interface generic
+    procedure smp1
+    procedure smp2
+    module subroutine smp3(a1,a2,a3)
+    end
+  end interface
+ contains
+  subroutine local1
+    call generic(0.)
+    call generic(0., 1.)
+    call generic(0., 1., 2.)
+  end
+  subroutine local2(a1,a2,a3)
+  end
+  module procedure smp1
+  end
+  module subroutine smp2(a1,a2)
+  end
+  module subroutine smp3(a1,a2,a3)
+  end
+end
+
+

[psteinfeld]

All builds and tests correctly and looks good.