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

[via flang-commits]

Author: Peter Klausler
Date: 2024-11-19T16:20:23-08:00
New Revision: a54e8b2cc45f079881ee8013143494e9a1315929

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

LOG: [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 https://github.com/llvm/llvm-project/issues/116567.

Added: 
    flang/test/Semantics/smp-def02.f90

Modified: 
    flang/include/flang/Evaluate/tools.h
    flang/lib/Evaluate/characteristics.cpp
    flang/lib/Evaluate/tools.cpp

Removed: 
    


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