[flang] Silence bogus error about insufficiently defined interfaces (#116694)

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.

Author: klausler

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_

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>{};
           },

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

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
+
+