https://github.com/akuhlens updated https://github.com/llvm/llvm-project/pull/217455
>From 8faabcd0faeeb28a49a4a4691995d4865760f10a Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt <[email protected]> Date: Wed, 19 Aug 2026 13:18:36 -0700 Subject: [PATCH 1/4] Flang: repair intrinsic cublas USE association --- clang/include/clang/Options/FlangOptions.td | 3 + clang/lib/Driver/ToolChains/Flang.cpp | 61 ++++----- .../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 + .../Semantics/CUDA/cuf-use-cublas-zgemm.cuf | 96 ++++++++++++++ flang/tools/bbc/bbc.cpp | 8 ++ 8 files changed, 273 insertions(+), 30 deletions(-) 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..7a3dfd84fd4e7 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 prefer_intrinsic_module_use_association : OptOutFC1FFlag<"prefer-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 5824f59400323..7e7ac97b8b0e5 100644 --- a/clang/lib/Driver/ToolChains/Flang.cpp +++ b/clang/lib/Driver/ToolChains/Flang.cpp @@ -130,35 +130,38 @@ static void renderDependencyGenerationOptions(Compilation &C, void Flang::addFortranDialectOptions(const ArgList &Args, ArgStringList &CmdArgs) const { - Args.addAllArgs(CmdArgs, {options::OPT_ffixed_form, - options::OPT_ffree_form, - options::OPT_ffixed_line_length_EQ, - options::OPT_fopenacc, - options::OPT_finput_charset_EQ, - options::OPT_fimplicit_none, - options::OPT_fimplicit_none_ext, - options::OPT_fno_implicit_none, - options::OPT_fbackslash, - options::OPT_fno_backslash, - options::OPT_flogical_abbreviations, - options::OPT_fno_logical_abbreviations, - options::OPT_fxor_operator, - options::OPT_fno_xor_operator, - options::OPT_falternative_parameter_statement, - options::OPT_fdefault_integer_4, - options::OPT_fdefault_real_4, - options::OPT_fdefault_real_8, - options::OPT_fdefault_integer_8, - options::OPT_fdefault_double_8, - options::OPT_flarge_sizes, - options::OPT_fno_automatic, - options::OPT_fhermetic_module_files, - options::OPT_frealloc_lhs, - options::OPT_fno_realloc_lhs, - options::OPT_fsave_main_program, - options::OPT_fd_lines_as_code, - options::OPT_fd_lines_as_comments, - options::OPT_fno_save_main_program}); + Args.addAllArgs(CmdArgs, + {options::OPT_ffixed_form, + options::OPT_ffree_form, + options::OPT_ffixed_line_length_EQ, + options::OPT_fopenacc, + options::OPT_finput_charset_EQ, + options::OPT_fimplicit_none, + options::OPT_fimplicit_none_ext, + options::OPT_fno_implicit_none, + options::OPT_fbackslash, + options::OPT_fno_backslash, + options::OPT_flogical_abbreviations, + options::OPT_fno_logical_abbreviations, + options::OPT_fxor_operator, + options::OPT_fno_xor_operator, + options::OPT_falternative_parameter_statement, + options::OPT_fdefault_integer_4, + options::OPT_fdefault_real_4, + options::OPT_fdefault_real_8, + options::OPT_fdefault_integer_8, + options::OPT_fdefault_double_8, + options::OPT_flarge_sizes, + options::OPT_fno_automatic, + options::OPT_fhermetic_module_files, + options::OPT_frealloc_lhs, + options::OPT_fno_realloc_lhs, + 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_fprefer_intrinsic_module_use_association, + options::OPT_fno_prefer_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..4921496adee5c 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, PreferIntrinsicModuleUseAssociation) // 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 ae037145ff590..87a25f3101ddd 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -934,6 +934,16 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args, clang::options::OPT_fno_openacc_multiple_names_in_routine, true)); + // -f{no-}prefer-intrinsic-module-use-association + if (const auto *arg = args.getLastArg( + clang::options::OPT_fprefer_intrinsic_module_use_association, + clang::options::OPT_fno_prefer_intrinsic_module_use_association)) { + opts.features.Enable( + Fortran::common::LanguageFeature::PreferIntrinsicModuleUseAssociation, + arg->getOption().matches( + clang::options::OPT_fprefer_intrinsic_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..3eb160c29ca5a 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::PreferIntrinsicModuleUseAssociation, + 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::PreferIntrinsicModuleUseAssociation)) { + 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..533db242ac2d3 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::PreferIntrinsicModuleUseAssociation); warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence); warnLanguage_.set(LanguageFeature::OpenAccDefaultNoneScalarsStrict); warnLanguage_.set(LanguageFeature::OpenACCMultipleNamesInRoutine); 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..66763f692e4a7 --- /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-prefer-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-prefer-intrinsic-module-use-association -fprefer-intrinsic-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 -fprefer-intrinsic-module-use-association -fno-prefer-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-prefer-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-prefer-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 [-Wprefer-intrinsic-module-use-association] +! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] +! PEDANTIC: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-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( >From 5ce0ad5ee1f17ca93e29cde9cafc88b2edfec033 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt <[email protected]> Date: Fri, 21 Aug 2026 11:50:23 -0700 Subject: [PATCH 2/4] Flang: clarify intrinsic USE association extension --- flang/lib/Semantics/resolve-names.cpp | 14 ++++++++++---- flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf | 3 +++ 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 3eb160c29ca5a..474b6644684f3 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4304,6 +4304,8 @@ static bool MatchesCublasZgemm(SemanticsContext &context, static const IntrinsicModuleUseAssociationRule * FindIntrinsicModuleUseAssociationRule( SemanticsContext &context, const Symbol &generic, const Symbol &other) { + // Add entries here for intrinsic module generics that should take precedence + // over an equivalent external interface during USE association. static const IntrinsicModuleUseAssociationRule rules[]{ {"cublas", "zgemm", MatchesCublasZgemm}, }; @@ -4552,10 +4554,14 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, auto warnIntrinsicModuleUseAssociation{[&](const Symbol &generic) { const Scope &owner{generic.GetUltimate().owner()}; - context().Warn(common::LanguageFeature::PreferIntrinsicModuleUseAssociation, - location, - "USE association selects intrinsic '%s' generic '%s' over an equivalent external interface"_warn_en_US, - owner.GetName().value(), generic.GetUltimate().name()); + if (auto *msg{context().Warn( + common::LanguageFeature::PreferIntrinsicModuleUseAssociation, + location, + "USE association selects intrinsic '%s' generic '%s' over an equivalent external interface"_warn_en_US, + owner.GetName().value(), generic.GetUltimate().name())}) { + msg->Attach(location, + "this extension can be disabled (-fno-prefer-intrinsic-module-use-association)"_en_US); + } }}; if (context().IsEnabled( diff --git a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf index 66763f692e4a7..ff81093e94f7c 100644 --- a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf +++ b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf @@ -90,7 +90,10 @@ contains end module ! EXTERNAL-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] +! EXTERNAL-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) ! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] +! CUBLAS-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) ! PEDANTIC: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] +! PEDANTIC: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) ! DISABLED: error: 'zgemm' must be an abstract interface or a procedure with an explicit interface ! NO-WARNING-NOT: warning: >From 9de55e45e8d70730c849eacac4101fd981b7365f Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt <[email protected]> Date: Fri, 21 Aug 2026 16:36:08 -0700 Subject: [PATCH 3/4] Flang: allow dgemm CUBLAS USE association --- flang/lib/Semantics/resolve-names.cpp | 5 +- .../Semantics/CUDA/cuf-use-cublas-zgemm.cuf | 51 +++++++++++++++++-- 2 files changed, 50 insertions(+), 6 deletions(-) diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 474b6644684f3..ba42f2774f993 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4285,7 +4285,7 @@ struct IntrinsicModuleUseAssociationRule { bool (*matches)(SemanticsContext &, const GenericDetails &, const Symbol &); }; -static bool MatchesCublasZgemm(SemanticsContext &context, +static bool MatchesCublasGemm(SemanticsContext &context, const GenericDetails &generic, const Symbol &other) { const Symbol *specific{generic.specific()}; if (!specific || @@ -4307,7 +4307,8 @@ FindIntrinsicModuleUseAssociationRule( // Add entries here for intrinsic module generics that should take precedence // over an equivalent external interface during USE association. static const IntrinsicModuleUseAssociationRule rules[]{ - {"cublas", "zgemm", MatchesCublasZgemm}, + {"cublas", "dgemm", MatchesCublasGemm}, + {"cublas", "zgemm", MatchesCublasGemm}, }; const Scope &owner{generic.GetUltimate().owner()}; if (!owner.IsModule() || !owner.parent().IsIntrinsicModules() || diff --git a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf index ff81093e94f7c..10604469cd446 100644 --- a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf +++ b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf @@ -48,12 +48,49 @@ module cublas interface zgemm procedure :: zgemm, zgemmcu_dpm, zgemmcu_hpm end interface + + interface + subroutine dgemm(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 + real(8) :: alpha, beta + real(8) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) +!dir$ ignore_tkr(tr) a, b, c + end subroutine + + subroutine dgemmcu_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 + real(8), device :: alpha, beta + real(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 dgemmcu_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 + real(8) :: alpha, beta + real(8), device :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) +!dir$ ignore_tkr(tr) a, b, c + end subroutine + end interface + + interface dgemm + procedure :: dgemm, dgemmcu_dpm, dgemmcu_hpm + end interface end module !--- blas.f90 module blas implicit none interface + subroutine dgemm(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 + real(8) :: alpha, beta + real(8) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) + end subroutine 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 @@ -65,12 +102,14 @@ end module !--- external-first.cuf module external_first - use blas, only: zgemm - use, intrinsic :: cublas, only: zgemm + use blas, only: dgemm, zgemm + use, intrinsic :: cublas, only: dgemm, zgemm procedure(zgemm), pointer :: p contains subroutine test_cuda_specific() + real(8), device :: da(1, 1), db(1, 1), dc(1, 1) complex(8), device :: a(1, 1), b(1, 1), c(1, 1) + call dgemm('N', 'N', 1, 1, 1, 1.D0, da, 1, db, 1, 0.D0, dc, 1) call zgemm('N', 'N', 1, 1, 1, (1.D0, 0.D0), a, 1, b, 1, & (0.D0, 0.D0), c, 1) end subroutine @@ -78,19 +117,23 @@ end module !--- cublas-first.cuf module cublas_first - use, intrinsic :: cublas, only: zgemm - use blas, only: zgemm + use, intrinsic :: cublas, only: dgemm, zgemm + use blas, only: dgemm, zgemm procedure(zgemm), pointer :: p contains subroutine test_cuda_specific() + real(8), device :: da(1, 1), db(1, 1), dc(1, 1) complex(8), device :: a(1, 1), b(1, 1), c(1, 1) + call dgemm('N', 'N', 1, 1, 1, 1.D0, da, 1, db, 1, 0.D0, dc, 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 'dgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! EXTERNAL-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! EXTERNAL-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) +! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'dgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! CUBLAS-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) ! PEDANTIC: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] >From 3d852f0f848d72c7fcde4b0ab7494bc26cbb79ff Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt <[email protected]> Date: Fri, 21 Aug 2026 16:56:50 -0700 Subject: [PATCH 4/4] Flang: allow sgemm CUBLAS USE association --- flang/lib/Semantics/resolve-names.cpp | 1 + .../Semantics/CUDA/cuf-use-cublas-zgemm.cuf | 42 +++++++++++++++++-- 2 files changed, 39 insertions(+), 4 deletions(-) diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index ba42f2774f993..6a67f93bbfc70 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4307,6 +4307,7 @@ FindIntrinsicModuleUseAssociationRule( // Add entries here for intrinsic module generics that should take precedence // over an equivalent external interface during USE association. static const IntrinsicModuleUseAssociationRule rules[]{ + {"cublas", "sgemm", MatchesCublasGemm}, {"cublas", "dgemm", MatchesCublasGemm}, {"cublas", "zgemm", MatchesCublasGemm}, }; diff --git a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf index 10604469cd446..59795c1f647ab 100644 --- a/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf +++ b/flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf @@ -79,12 +79,40 @@ module cublas interface dgemm procedure :: dgemm, dgemmcu_dpm, dgemmcu_hpm end interface + + interface + subroutine sgemm(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 + real(4) :: alpha, beta + real(4) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) +!dir$ ignore_tkr(tr) a, b, c + end subroutine + + subroutine sgemmcu_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 + real(4) :: alpha, beta + real(4), device :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) +!dir$ ignore_tkr(tr) a, b, c + end subroutine + end interface + + interface sgemm + procedure :: sgemm, sgemmcu_hpm + end interface end module !--- blas.f90 module blas implicit none interface + subroutine sgemm(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 + real(4) :: alpha, beta + real(4) :: a(1:lda, *), b(1:ldb, *), c(1:ldc, *) + end subroutine subroutine dgemm(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 @@ -102,13 +130,15 @@ end module !--- external-first.cuf module external_first - use blas, only: dgemm, zgemm - use, intrinsic :: cublas, only: dgemm, zgemm + use blas, only: sgemm, dgemm, zgemm + use, intrinsic :: cublas, only: sgemm, dgemm, zgemm procedure(zgemm), pointer :: p contains subroutine test_cuda_specific() + real(4), device :: sa(1, 1), sb(1, 1), sc(1, 1) real(8), device :: da(1, 1), db(1, 1), dc(1, 1) complex(8), device :: a(1, 1), b(1, 1), c(1, 1) + call sgemm('N', 'N', 1, 1, 1, 1.E0, sa, 1, sb, 1, 0.E0, sc, 1) call dgemm('N', 'N', 1, 1, 1, 1.D0, da, 1, db, 1, 0.D0, dc, 1) call zgemm('N', 'N', 1, 1, 1, (1.D0, 0.D0), a, 1, b, 1, & (0.D0, 0.D0), c, 1) @@ -117,22 +147,26 @@ end module !--- cublas-first.cuf module cublas_first - use, intrinsic :: cublas, only: dgemm, zgemm - use blas, only: dgemm, zgemm + use, intrinsic :: cublas, only: sgemm, dgemm, zgemm + use blas, only: sgemm, dgemm, zgemm procedure(zgemm), pointer :: p contains subroutine test_cuda_specific() + real(4), device :: sa(1, 1), sb(1, 1), sc(1, 1) real(8), device :: da(1, 1), db(1, 1), dc(1, 1) complex(8), device :: a(1, 1), b(1, 1), c(1, 1) + call sgemm('N', 'N', 1, 1, 1, 1.E0, sa, 1, sb, 1, 0.E0, sc, 1) call dgemm('N', 'N', 1, 1, 1, 1.D0, da, 1, db, 1, 0.D0, dc, 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 'sgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! EXTERNAL-FIRST: warning: USE association selects intrinsic 'cublas' generic 'dgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! EXTERNAL-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! EXTERNAL-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) +! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'sgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'dgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! CUBLAS-FIRST: warning: USE association selects intrinsic 'cublas' generic 'zgemm' over an equivalent external interface [-Wprefer-intrinsic-module-use-association] ! CUBLAS-FIRST: this extension can be disabled (-fno-prefer-intrinsic-module-use-association) _______________________________________________ cfe-commits mailing list [email protected] https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits
