[clang] [flang] [Flang] Repair intrinsic CUBLAS USE association (PR #217455)
Andre Kuhlenschmidt via cfe-commits
cfe-commits at lists.llvm.org
Wed Aug 19 16:46:29 PDT 2026
https://github.com/akuhlens updated https://github.com/llvm/llvm-project/pull/217455
>From c0a4a26b0c0d31169c2bd160818557bd7ffa240d Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Wed, 19 Aug 2026 13:18:36 -0700
Subject: [PATCH] Flang: repair intrinsic cublas USE association
---
clang/include/clang/Options/FlangOptions.td | 3 +
clang/lib/Driver/ToolChains/Flang.cpp | 4 +-
.../include/flang/Support/Fortran-features.h | 2 +-
flang/lib/Frontend/CompilerInvocation.cpp | 10 ++
flang/lib/Semantics/resolve-names.cpp | 122 ++++++++++++++++++
flang/lib/Support/Fortran-features.cpp | 1 +
.../intrinsic-module-use-association.f90 | 10 ++
.../Semantics/CUDA/cuf-use-cublas-zgemm.cuf | 96 ++++++++++++++
flang/tools/bbc/bbc.cpp | 8 ++
9 files changed, 254 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Driver/intrinsic-module-use-association.f90
create mode 100644 flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf
diff --git a/clang/include/clang/Options/FlangOptions.td b/clang/include/clang/Options/FlangOptions.td
index cf40d0b909d8f..304391e51f145 100644
--- a/clang/include/clang/Options/FlangOptions.td
+++ b/clang/include/clang/Options/FlangOptions.td
@@ -196,6 +196,9 @@ defm openacc_default_none_scalars_strict : OptOutFC1FFlag<"openacc-default-none-
defm openacc_multiple_names_in_routine : OptOutFC1FFlag<"openacc-multiple-names-in-routine",
"Accept multiple names in OpenACC ROUTINE directive (extension)",
"Do not accept multiple names in OpenACC ROUTINE directive">;
+defm intrinsic_module_use_association : OptOutFC1FFlag<"intrinsic-module-use-association",
+ "Resolve a USE association conflict in favor of an intrinsic module generic (extension)",
+ "Diagnose a USE association conflict with an intrinsic module generic">;
def fno_automatic : Flag<["-"], "fno-automatic">, Group<f_Group>,
HelpText<"Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE">;
diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp
index a48e41159f367..b382f6a355643 100644
--- a/clang/lib/Driver/ToolChains/Flang.cpp
+++ b/clang/lib/Driver/ToolChains/Flang.cpp
@@ -158,7 +158,9 @@ void Flang::addFortranDialectOptions(const ArgList &Args,
options::OPT_fsave_main_program,
options::OPT_fd_lines_as_code,
options::OPT_fd_lines_as_comments,
- options::OPT_fno_save_main_program});
+ options::OPT_fno_save_main_program,
+ options::OPT_fintrinsic_module_use_association,
+ options::OPT_fno_intrinsic_module_use_association});
}
void Flang::addPreprocessingOptions(const ArgList &Args,
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 4ee956a0b4a4f..c4c15c0b42bc8 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -61,7 +61,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
MultipleProgramUnitsOnSameLine, AllocatedForAssociated,
OpenMPThreadprivateEquivalence, RelaxedCLocChecks, CudaPinned,
OpenAccDefaultNoneScalarsStrict, OpenACCMultipleNamesInRoutine,
- EnumerationType, CUDAInit)
+ EnumerationType, CUDAInit, IntrinsicModuleUseAssociation)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index b57bc4583be38..c8a9bdcc65530 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -930,6 +930,16 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
clang::options::OPT_fno_openacc_multiple_names_in_routine,
true));
+ // -f{no-}intrinsic-module-use-association
+ if (const auto *arg = args.getLastArg(
+ clang::options::OPT_fintrinsic_module_use_association,
+ clang::options::OPT_fno_intrinsic_module_use_association)) {
+ opts.features.Enable(
+ Fortran::common::LanguageFeature::IntrinsicModuleUseAssociation,
+ arg->getOption().matches(
+ clang::options::OPT_fintrinsic_module_use_association));
+ }
+
// -f{no-}xor-operator
opts.features.Enable(Fortran::common::LanguageFeature::XOROperator,
args.hasFlag(clang::options::OPT_fxor_operator,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 27c4e96d269aa..4831cceaebbc6 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4230,6 +4230,98 @@ static bool CheckCompatibleDistinctUltimates(SemanticsContext &context,
return true; // don't try to merge generics (or whatever)
}
+static bool AreSameProcedureForUseAssociation(
+ SemanticsContext &context, const Symbol &p1, const Symbol &p2) {
+ const Symbol &ultimate1{p1.GetUltimate()};
+ const Symbol &ultimate2{p2.GetUltimate()};
+ if (&ultimate1 == &ultimate2) {
+ return true;
+ } else if (ultimate1.name() != ultimate2.name()) {
+ return false;
+ } else if (ultimate1.attrs().test(Attr::INTRINSIC) ||
+ ultimate2.attrs().test(Attr::INTRINSIC)) {
+ return ultimate1.attrs().test(Attr::INTRINSIC) &&
+ ultimate2.attrs().test(Attr::INTRINSIC);
+ }
+ if (!IsProcedure(ultimate1) || IsPointer(ultimate1) ||
+ !IsProcedure(ultimate2) || IsPointer(ultimate2) ||
+ ClassifyProcedure(ultimate1) != ClassifyProcedure(ultimate2)) {
+ return false;
+ }
+ auto classification{ClassifyProcedure(ultimate1)};
+ if (classification == ProcedureDefinitionClass::Module) {
+ return AreSameModuleSymbol(ultimate1, ultimate2);
+ }
+ if (classification != ProcedureDefinitionClass::External) {
+ return false;
+ }
+ const auto *subp1{ultimate1.detailsIf<SubprogramDetails>()};
+ const auto *subp2{ultimate2.detailsIf<SubprogramDetails>()};
+ if (!subp1 || !subp1->isInterface() || !subp2 || !subp2->isInterface()) {
+ return false;
+ }
+ auto chars1{evaluate::characteristics::Procedure::Characterize(
+ ultimate1, context.foldingContext())};
+ auto chars2{evaluate::characteristics::Procedure::Characterize(
+ ultimate2, context.foldingContext())};
+ return chars1 && chars2 && *chars1 == *chars2;
+}
+
+static bool HasCUDADummyDataAttribute(const Symbol &procedure) {
+ if (const auto *subp{
+ procedure.GetUltimate().detailsIf<SubprogramDetails>()}) {
+ for (const Symbol *dummy : subp->dummyArgs()) {
+ if (dummy && GetCUDADataAttr(dummy)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+struct IntrinsicModuleUseAssociationRule {
+ const char *moduleName;
+ const char *genericName;
+ bool (*matches)(SemanticsContext &, const GenericDetails &, const Symbol &);
+};
+
+static bool MatchesCublasZgemm(SemanticsContext &context,
+ const GenericDetails &generic, const Symbol &other) {
+ const Symbol *specific{generic.specific()};
+ if (!specific ||
+ !AreSameProcedureForUseAssociation(context, *specific, other)) {
+ return false;
+ }
+ bool containsSpecific{false};
+ bool hasCUDAOverload{false};
+ for (const Symbol &candidate : generic.specificProcs()) {
+ containsSpecific |= &candidate.GetUltimate() == &specific->GetUltimate();
+ hasCUDAOverload |= HasCUDADummyDataAttribute(candidate);
+ }
+ return containsSpecific && hasCUDAOverload;
+}
+
+static const IntrinsicModuleUseAssociationRule *
+FindIntrinsicModuleUseAssociationRule(
+ SemanticsContext &context, const Symbol &generic, const Symbol &other) {
+ static const IntrinsicModuleUseAssociationRule rules[]{
+ {"cublas", "zgemm", MatchesCublasZgemm},
+ };
+ const Scope &owner{generic.GetUltimate().owner()};
+ if (!owner.IsModule() || !owner.parent().IsIntrinsicModules() ||
+ !owner.GetName()) {
+ return nullptr;
+ }
+ for (const auto &rule : rules) {
+ if (owner.GetName().value() == rule.moduleName &&
+ generic.GetUltimate().name() == rule.genericName &&
+ rule.matches(context, generic.get<GenericDetails>(), other)) {
+ return &rule;
+ }
+ }
+ return nullptr;
+}
+
void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
Symbol &originalLocal, const Symbol &useSymbol) {
Symbol *localSymbol{&originalLocal};
@@ -4458,6 +4550,36 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
}
}};
+ auto warnIntrinsicModuleUseAssociation{[&](const Symbol &generic) {
+ const Scope &owner{generic.GetUltimate().owner()};
+ context().Warn(common::LanguageFeature::IntrinsicModuleUseAssociation,
+ location,
+ "USE association selects intrinsic '%s' generic '%s' over an equivalent external interface"_warn_en_US,
+ owner.GetName().value(), generic.GetUltimate().name());
+ }};
+
+ if (context().IsEnabled(
+ common::LanguageFeature::IntrinsicModuleUseAssociation)) {
+ if (localSymbol->has<UseDetails>() && !localGeneric && useGeneric &&
+ localProcedure &&
+ FindIntrinsicModuleUseAssociationRule(
+ context(), useUltimate, *localProcedure)) {
+ warnIntrinsicModuleUseAssociation(useUltimate);
+ EraseSymbol(*localSymbol);
+ Symbol &newSymbol{MakeSymbol(localName,
+ useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
+ UseDetails{localName, useUltimate})};
+ newSymbol.flags() = useSymbol.flags();
+ return;
+ } else if (localSymbol->has<UseDetails>() && localGeneric && !useGeneric &&
+ useProcedure &&
+ FindIntrinsicModuleUseAssociationRule(
+ context(), localUltimate, *useProcedure)) {
+ warnIntrinsicModuleUseAssociation(localUltimate);
+ return;
+ }
+ }
+
// When two non-generic procedures arrived, try to combine them.
const Symbol *combinedProcedure{nullptr};
if (!localProcedure) {
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 0af3ff61d18e1..cc9c17d2477a4 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -223,6 +223,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnUsage_.set(UsageWarning::IgnoredNoReallocateLHS);
warnUsage_.set(UsageWarning::IoImpliedDoIndexConflict);
warnUsage_.set(UsageWarning::BOZLiteralTruncation);
+ warnLanguage_.set(LanguageFeature::IntrinsicModuleUseAssociation);
warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
warnLanguage_.set(LanguageFeature::OpenAccDefaultNoneScalarsStrict);
warnLanguage_.set(LanguageFeature::OpenACCMultipleNamesInRoutine);
diff --git a/flang/test/Driver/intrinsic-module-use-association.f90 b/flang/test/Driver/intrinsic-module-use-association.f90
new file mode 100644
index 0000000000000..b8b3277dfc4cf
--- /dev/null
+++ b/flang/test/Driver/intrinsic-module-use-association.f90
@@ -0,0 +1,10 @@
+! RUN: %flang -fsyntax-only -### -fintrinsic-module-use-association %s 2>&1 | FileCheck %s --check-prefix=DRIVER-ON
+! RUN: %flang -fsyntax-only -### -fno-intrinsic-module-use-association %s 2>&1 | FileCheck %s --check-prefix=DRIVER-OFF
+! RUN: %flang_fc1 -fsyntax-only -fintrinsic-module-use-association %s
+! RUN: %flang_fc1 -fsyntax-only -fno-intrinsic-module-use-association %s
+
+! DRIVER-ON: "-fc1"{{.*}}"-fintrinsic-module-use-association"
+! DRIVER-OFF: "-fc1"{{.*}}"-fno-intrinsic-module-use-association"
+
+program test
+end program
diff --git a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf
new file mode 100644
index 0000000000000..f0692537a78b5
--- /dev/null
+++ b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf
@@ -0,0 +1,96 @@
+! RUN: split-file %s %t
+! RUN: %flang_fc1 -emit-obj -x cuda -module-dir %t %t/cublas.cuf -o %t/cublas.o
+! RUN: %flang_fc1 -emit-obj -module-dir %t %t/blas.f90 -o %t/blas.o
+! RUN: %flang_fc1 -fsyntax-only -x cuda -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --check-prefix=EXTERNAL-FIRST %s
+! RUN: %flang_fc1 -fsyntax-only -x cuda -I %t -fintrinsic-modules-path %t %t/cublas-first.cuf 2>&1 | FileCheck --check-prefix=CUBLAS-FIRST %s
+! RUN: %flang_fc1 -fsyntax-only -x cuda -pedantic -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --check-prefix=PEDANTIC %s
+! RUN: not %flang_fc1 -fsyntax-only -x cuda -fno-intrinsic-module-use-association -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --check-prefix=DISABLED %s
+! RUN: %flang_fc1 -fsyntax-only -x cuda -fno-intrinsic-module-use-association -fintrinsic-module-use-association -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --check-prefix=EXTERNAL-FIRST %s
+! RUN: not %flang_fc1 -fsyntax-only -x cuda -fintrinsic-module-use-association -fno-intrinsic-module-use-association -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --check-prefix=DISABLED %s
+! RUN: %flang_fc1 -fsyntax-only -x cuda -Wno-intrinsic-module-use-association -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --allow-empty --check-prefix=NO-WARNING %s
+! RUN: %flang_fc1 -fsyntax-only -x cuda -pedantic -Wno-intrinsic-module-use-association -I %t -fintrinsic-modules-path %t %t/external-first.cuf 2>&1 | FileCheck --allow-empty --check-prefix=NO-WARNING %s
+
+! An intrinsic CUBLAS generic contains a host interface that is equivalent to
+! the external BLAS interface as well as CUDA-specific procedures. The
+! external interface and the CUBLAS generic are intentionally not merged:
+! USE association selects the latter for the local name.
+
+!--- cublas.cuf
+module cublas
+ implicit none
+ interface
+ subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+ character(1) :: transa, transb
+ integer(4) :: m, n, k, lda, ldb, ldc
+ complex(8) :: alpha, beta
+ complex(8) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *)
+!dir$ ignore_tkr(tr) a, b, c
+ end subroutine
+
+ subroutine zgemmcu_dpm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+ character(1), value :: transa, transb
+ integer(4), value :: m, n, k, lda, ldb, ldc
+ complex(8), device :: alpha, beta
+ complex(8), device :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *)
+!dir$ ignore_tkr(m) alpha, beta
+!dir$ ignore_tkr(tr) a, b, c
+ end subroutine
+
+ subroutine zgemmcu_hpm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+ character(1), value :: transa, transb
+ integer(4), value :: m, n, k, lda, ldb, ldc
+ complex(8) :: alpha, beta
+ complex(8), device :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *)
+!dir$ ignore_tkr(tr) a, b, c
+ end subroutine
+ end interface
+
+ interface zgemm
+ procedure :: zgemm, zgemmcu_dpm, zgemmcu_hpm
+ end interface
+end module
+
+!--- blas.f90
+module blas
+ implicit none
+ interface
+ subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+ character(1) :: transa, transb
+ integer(4) :: m, n, k, lda, ldb, ldc
+ complex(8) :: alpha, beta
+ complex(8) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *)
+ end subroutine
+ end interface
+end module
+
+!--- external-first.cuf
+module external_first
+ use blas, only: zgemm
+ use, intrinsic :: cublas, only: zgemm
+ procedure(zgemm), pointer :: p
+contains
+ subroutine test_cuda_specific()
+ complex(8), device :: a(1, 1), b(1, 1), c(1, 1)
+ call zgemm('N', 'N', 1, 1, 1, (1.D0, 0.D0), a, 1, b, 1, &
+ (0.D0, 0.D0), c, 1)
+ end subroutine
+end module
+
+!--- cublas-first.cuf
+module cublas_first
+ use, intrinsic :: cublas, only: zgemm
+ use blas, only: zgemm
+ procedure(zgemm), pointer :: p
+contains
+ subroutine test_cuda_specific()
+ complex(8), device :: a(1, 1), b(1, 1), c(1, 1)
+ call zgemm('N', 'N', 1, 1, 1, (1.D0, 0.D0), a, 1, b, 1, &
+ (0.D0, 0.D0), c, 1)
+ end subroutine
+end module
+
+! EXTERNAL-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wintrinsic-module-use-association]
+! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wintrinsic-module-use-association]
+! PEDANTIC: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wintrinsic-module-use-association]
+! DISABLED: error: 'zgemm' must be an abstract interface or a procedure with an explicit interface
+! NO-WARNING-NOT: warning:
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
index 4d6b0a22f426e..7860a0fc77cf3 100644
--- a/flang/tools/bbc/bbc.cpp
+++ b/flang/tools/bbc/bbc.cpp
@@ -234,6 +234,10 @@ static llvm::cl::opt<bool> enableCUDAInit("fcuda-init",
llvm::cl::desc("enable CUDA Init"),
llvm::cl::init(false));
+static llvm::cl::opt<bool>
+ warnOnAllExtensions("pedantic", llvm::cl::desc("warn on all extensions"),
+ llvm::cl::init(false));
+
static llvm::cl::opt<bool>
enableDoConcurrentOffload("fdoconcurrent-offload",
llvm::cl::desc("enable do concurrent offload"),
@@ -695,6 +699,10 @@ int main(int argc, char **argv) {
if (enableCUDAInit) {
options.features.Enable(Fortran::common::LanguageFeature::CUDAInit);
}
+ if (warnOnAllExtensions) {
+ options.features.WarnOnAllNonstandard();
+ options.features.WarnOnAllUsage();
+ }
if (enableDoConcurrentOffload) {
options.features.Enable(
More information about the cfe-commits
mailing list