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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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 https://github.com/llvm/llvm-project/issues/116567.

>From fa0700c92f8ff3258ba9f09e2456b619b2b076f3 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 18 Nov 2024 13:35:01 -0800
Subject: [PATCH] [flang] Silence bogus error about insufficiently defined
 interfaces

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 https://github.com/llvm/llvm-project/issues/116567.
---
 flang/include/flang/Evaluate/tools.h   |  2 ++
 flang/lib/Evaluate/characteristics.cpp |  7 ++++-
 flang/lib/Evaluate/tools.cpp           | 33 ++++++++++++++++++++
 flang/test/Semantics/smp-def02.f90     | 42 ++++++++++++++++++++++++++
 4 files changed, 83 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Semantics/smp-def02.f90

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