llvmorg-github-actions[bot] wrote:
<!--LLVM PR SUMMARY COMMENT--> @llvm/pr-subscribers-clang-driver Author: Andre Kuhlenschmidt (akuhlens) <details> <summary>Changes</summary> This is a fix targeted at the specific code berkeleygw. It adds a general extension by which imports of intrinsic functions can shadow imported user functions and adds a single exception for CUBLAS `zgemm` USE-association collision with an equivalent user external interface. When the intrinsic CUBLAS generic and an equivalent external interface are USE-associated under the same name, Flang now selects the CUBLAS generic via a default-on compatibility extension. This preserves the CUBLAS CUDA-specific overloads instead of creating an unusable local association. The repair warns by default under `-Wintrinsic-module-use-association-extension`; `-fno-intrinsic-module-use-association` retains the prior semantic error, and `-Wno-intrinsic-module-use-association-extension` suppresses the warning. --- Full diff: https://github.com/llvm/llvm-project/pull/217455.diff 9 Files Affected: - (modified) clang/include/clang/Options/FlangOptions.td (+3) - (modified) clang/lib/Driver/ToolChains/Flang.cpp (+3-1) - (modified) flang/include/flang/Support/Fortran-features.h (+1-1) - (modified) flang/lib/Frontend/CompilerInvocation.cpp (+10) - (modified) flang/lib/Semantics/resolve-names.cpp (+122) - (modified) flang/lib/Support/Fortran-features.cpp (+1) - (added) flang/test/Driver/intrinsic-module-use-association.f90 (+10) - (added) flang/test/Semantics/CUDA/cuf-use-cublas-zgemm.cuf (+96) - (modified) flang/tools/bbc/bbc.cpp (+8) ``````````diff 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( `````````` </details> https://github.com/llvm/llvm-project/pull/217455 _______________________________________________ cfe-commits mailing list [email protected] https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits
