[flang-commits] [flang] [flang] Resolve generics with external procedure actuals by result type (PR #205321)
via flang-commits
flang-commits at lists.llvm.org
Tue Oct 6 03:20:18 PDT 2026
https://github.com/ejose02 updated https://github.com/llvm/llvm-project/pull/205321
>From a07d7fabcf937ba1a090bf536dbfbd00805776d3 Mon Sep 17 00:00:00 2001
From: ejose02 <ejose at amd.com>
Date: Tue, 23 Jun 2026 17:09:56 +0530
Subject: [PATCH] [flang] Resolve generics with external procedure actuals by
result type
Fixes #191404
Root cause:
During generic resolution, CheckCompatibleArgument treated a procedure actual whose function result type was not yet known as compatible with any dummy that has a function result. For an external procedure passed by name (a ProcEntity with an implicit interface), the result type was never established, so every function-result specific matched. This produced a spurious "matched multiple specific procedures" error even when only one specific could possibly apply.
Fix:
When the dummy has a function result type but the actual's is unknown, deduce the actual's result type before comparing:
- resolve the actual to its ultimate symbol and, via FindGlobal, use the characteristics of a global definition when one is visible (and reject the candidate when that global is not a function);
- otherwise apply default implicit typing to the external's name (i-n integer, else real) unless IMPLICIT NONE(TYPE) is in effect.
The deduced type is then checked for type/kind compatibility with the dummy's result. If the type still cannot be determined, the candidate is treated as incompatible (return false) rather than matching unconditionally, which prevents the false ambiguity. Adds regression tests and updates generic11/resolve63 expectations accordingly.
---
flang/lib/Semantics/expression.cpp | 55 ++++++++++++++++++++++++++++++
flang/test/Semantics/generic11.f90 | 1 -
flang/test/Semantics/generic14.f90 | 32 +++++++++++++++++
flang/test/Semantics/generic15.f90 | 34 ++++++++++++++++++
flang/test/Semantics/resolve63.f90 | 1 -
5 files changed, 121 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/generic14.f90
create mode 100644 flang/test/Semantics/generic15.f90
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e3ed0e0be52d4..68acb746b12e9 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2964,6 +2964,61 @@ static bool CheckCompatibleArgument(bool isElemental,
return actualTypeAndShape->type().IsTkCompatibleWith(
dummyTypeAndShape->type());
}
+ if (dummyTypeAndShape && !actualTypeAndShape) {
+ std::optional<DynamicType> actualType;
+ const Symbol *symbol{nullptr};
+ if (const auto *designator{
+ std::get_if<ProcedureDesignator>(&expr->u)}) {
+ symbol = designator->GetSymbol();
+ } else {
+ symbol = GetLastSymbol(*expr);
+ }
+ if (symbol) {
+ const Symbol &ultimate{
+ ResolveAssociations(*symbol).GetUltimate()};
+ const Symbol *def{&ultimate};
+ if (const Symbol *global{semantics::FindGlobal(ultimate)}) {
+ def = &global->GetUltimate();
+ if (!IsFunction(*def)) {
+ return false;
+ }
+ }
+ if (!actualType) {
+ if (std::optional<characteristics::Procedure> proc{
+ characteristics::Procedure::Characterize(
+ *def, foldingContext)}) {
+ if (proc->functionResult) {
+ if (const auto *typeAndShape{
+ proc->functionResult->GetTypeAndShape()}) {
+ actualType = typeAndShape->type();
+ }
+ }
+ }
+ }
+ if (!actualType && IsExternal(ultimate) &&
+ ultimate.has<semantics::ProcEntityDetails>() &&
+ !foldingContext.languageFeatures().IsEnabled(
+ LanguageFeature::ImplicitNoneTypeAlways)) {
+ const std::string &name{ultimate.name().ToString()};
+ if (!name.empty()) {
+ const char ch{name[0]};
+ const auto &defaults{foldingContext.defaults()};
+ if (ch >= 'i' && ch <= 'n') {
+ actualType = DynamicType(TypeCategory::Integer,
+ defaults.GetDefaultKind(TypeCategory::Integer));
+ } else if (ch >= 'a' && ch <= 'z') {
+ actualType = DynamicType(TypeCategory::Real,
+ defaults.GetDefaultKind(TypeCategory::Real));
+ }
+ }
+ }
+ }
+ if (actualType) {
+ return actualType->IsTkCompatibleWith(
+ dummyTypeAndShape->type());
+ }
+ return false;
+ }
}
return true;
},
diff --git a/flang/test/Semantics/generic11.f90 b/flang/test/Semantics/generic11.f90
index 14383ab150fe4..429216b043912 100644
--- a/flang/test/Semantics/generic11.f90
+++ b/flang/test/Semantics/generic11.f90
@@ -20,6 +20,5 @@ subroutine sub2(rfun)
call sub(rfun)
!ERROR: No specific subroutine of generic 'sub' matches the actual arguments
call sub(zfun)
-!ERROR: The actual arguments to the generic procedure 'sub' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
call sub(xfun)
end
diff --git a/flang/test/Semantics/generic14.f90 b/flang/test/Semantics/generic14.f90
new file mode 100644
index 0000000000000..f1472315dca84
--- /dev/null
+++ b/flang/test/Semantics/generic14.f90
@@ -0,0 +1,32 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+! Regression test for #191404)
+
+module m
+ interface gen
+ subroutine with_real(freal)
+ real, external :: freal
+ end subroutine with_real
+ subroutine with_complex(fcom)
+ complex, external :: fcom
+ end subroutine with_complex
+ end interface
+end module
+subroutine with_real(f)
+ real, external :: f
+ print '("ok",F12.7)', f()
+end subroutine
+subroutine with_complex(f)
+ complex, external :: f
+ print '("fail",F12.7)', f()
+end subroutine
+program test
+ use m
+ external fact
+ call gen(fact)
+ print '("ok")'
+end program
+
+function fact()
+ real :: fact
+ fact = 42.0
+end function fact
diff --git a/flang/test/Semantics/generic15.f90 b/flang/test/Semantics/generic15.f90
new file mode 100644
index 0000000000000..f72c850b9df85
--- /dev/null
+++ b/flang/test/Semantics/generic15.f90
@@ -0,0 +1,34 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+! Regression test for #191407
+
+module m
+ interface gen
+ module procedure with_sub, with_fun
+ end interface gen
+contains
+ subroutine with_sub(sub, n)
+ external sub
+ call sub(n)
+ end subroutine with_sub
+ subroutine with_fun(af, n)
+ interface
+ function af(n)
+ real af(n)
+ end function
+ end interface
+ print *,'[',af(n),']'
+ end subroutine
+end module
+
+program test
+ use m
+ external s
+ integer a
+
+ a = 13
+ call gen(s, a)
+end program
+
+subroutine s(n)
+ if (n == 13) print '("ok")'
+end subroutine
diff --git a/flang/test/Semantics/resolve63.f90 b/flang/test/Semantics/resolve63.f90
index 0c3df2e8724a0..9d92d62536a6a 100644
--- a/flang/test/Semantics/resolve63.f90
+++ b/flang/test/Semantics/resolve63.f90
@@ -357,7 +357,6 @@ subroutine s2(af)
end subroutine
subroutine test
external underspecified
- !ERROR: The actual arguments to the generic procedure 'generic' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
call generic(underspecified)
end subroutine
end module
More information about the flang-commits
mailing list