[flang-commits] [flang] [flang][OpenMP] Lowering support for declare variant. (PR #206988)
Abid Qadeer via flang-commits
flang-commits at lists.llvm.org
Mon Jul 6 03:50:32 PDT 2026
https://github.com/abidh updated https://github.com/llvm/llvm-project/pull/206988
>From 11a8c70a73da2d022abc8b236af23e78363f1b99 Mon Sep 17 00:00:00 2001
From: Abid Qadeer <haqadeer at amd.com>
Date: Tue, 30 Jun 2026 17:36:26 +0100
Subject: [PATCH 1/3] [flang][OpenMP] Lowering support for declare variant.
Add lowering support for OpenMP DECLARE VARIANT. Each directive is recorded on
its base procedure during the structure checks. During call lowering, best
variant is picked based on recorded selecter and context.
Assisted by: Cursor
---
flang/include/flang/Lower/OpenMP.h | 9 +
.../flang/Semantics/omp-declare-variant.h | 32 +++
flang/include/flang/Semantics/symbol.h | 9 +
flang/lib/Lower/CMakeLists.txt | 1 +
flang/lib/Lower/CallInterface.cpp | 33 ++-
flang/lib/Lower/OpenMP/OpenMP.cpp | 4 +-
flang/lib/Lower/OpenMP/Utils.cpp | 58 +++++
flang/lib/Semantics/check-omp-variant.cpp | 35 +--
...lare-variant-structured-trait-property.f90 | 30 +++
.../Todo/declare-variant-target-device.f90 | 14 ++
.../Lower/OpenMP/Todo/declare-variant.f90 | 17 --
.../Lower/OpenMP/declare-variant-call.f90 | 200 ++++++++++++++++++
.../OpenMP/declare-variant-construct.f90 | 162 ++++++++++++++
.../Lower/OpenMP/declare-variant-device.f90 | 53 +++++
.../OpenMP/declare-variant-implementation.f90 | 32 +++
.../Lower/OpenMP/declare-variant-module.f90 | 23 ++
.../OpenMP/declare-variant-target-device.f90 | 28 +++
17 files changed, 707 insertions(+), 33 deletions(-)
create mode 100644 flang/include/flang/Semantics/omp-declare-variant.h
create mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
create mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
delete mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-call.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-construct.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-device.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-implementation.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-module.f90
create mode 100644 flang/test/Lower/OpenMP/declare-variant-target-device.f90
diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h
index 882ebad9071bc..d2a0592761981 100644
--- a/flang/include/flang/Lower/OpenMP.h
+++ b/flang/include/flang/Lower/OpenMP.h
@@ -105,6 +105,15 @@ void materializeOpenMPDeclareMappers(
Fortran::lower::AbstractConverter &, Fortran::semantics::SemanticsContext &,
const Fortran::semantics::Scope *scope = nullptr);
+namespace omp {
+/// If \p base carries OpenMP DECLARE VARIANT entries, return the variant symbol
+/// that best matches the enclosing OpenMP context, or nullptr if none matches.
+/// \p base is expected to have variant entries.
+const Fortran::semantics::Symbol *
+resolveDeclareVariantCallee(const Fortran::semantics::Symbol &base,
+ AbstractConverter &converter);
+} // namespace omp
+
} // namespace lower
} // namespace Fortran
diff --git a/flang/include/flang/Semantics/omp-declare-variant.h b/flang/include/flang/Semantics/omp-declare-variant.h
new file mode 100644
index 0000000000000..2184bd54b79aa
--- /dev/null
+++ b/flang/include/flang/Semantics/omp-declare-variant.h
@@ -0,0 +1,32 @@
+//===-- flang/Semantics/omp-declare-variant.h -------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
+#define FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
+
+#include "flang/Common/reference.h"
+
+namespace Fortran::parser {
+inline namespace traits {
+struct OmpContextSelectorSpecification;
+} // namespace traits
+} // namespace Fortran::parser
+
+namespace Fortran::semantics {
+class Symbol;
+
+// Information about a DECLARE VARIANT directive that will be recorded on its
+// base procedure.
+struct OmpDeclareVariantEntry {
+ common::Reference<const Symbol> variant;
+ const parser::traits::OmpContextSelectorSpecification *matchSelector{nullptr};
+};
+
+} // namespace Fortran::semantics
+
+#endif // FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index e0511b5b4803d..624ea02fa3525 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -14,6 +14,7 @@
#include "flang/Common/reference.h"
#include "flang/Common/visit.h"
#include "flang/Semantics/module-dependences.h"
+#include "flang/Semantics/omp-declare-variant.h"
#include "flang/Support/Fortran.h"
#include "llvm/ADT/DenseMapInfo.h"
#include "llvm/Frontend/OpenMP/OMP.h"
@@ -307,6 +308,13 @@ class SubprogramDetails : public WithBindName, public WithOmpDeclarative {
openACCRoutineInfos_.push_back(info);
}
+ const std::vector<OmpDeclareVariantEntry> &ompDeclareVariants() const {
+ return ompDeclareVariants_;
+ }
+ void addOmpDeclareVariant(OmpDeclareVariantEntry &&entry) {
+ ompDeclareVariants_.push_back(std::move(entry));
+ }
+
private:
bool isInterface_{false}; // true if this represents an interface-body
bool isDummy_{false}; // true when interface of dummy procedure
@@ -325,6 +333,7 @@ class SubprogramDetails : public WithBindName, public WithOmpDeclarative {
std::vector<std::int64_t> cudaLaunchBounds_, cudaClusterDims_;
// OpenACC routine information
std::vector<OpenACCRoutineInfo> openACCRoutineInfos_;
+ std::vector<OmpDeclareVariantEntry> ompDeclareVariants_;
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const SubprogramDetails &);
diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index f5424c78b9a98..2db97f4f7ec45 100644
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -76,6 +76,7 @@ add_flang_library(FortranLower
MIFDialect
LINK_COMPONENTS
+ FrontendOpenMP
Support
MLIR_DEPS
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 3fcf314faefb6..cb3be13e8c9ba 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -11,6 +11,7 @@
#include "flang/Lower/Bridge.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/OpenACC.h"
+#include "flang/Lower/OpenMP.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
@@ -61,13 +62,39 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
return procRef.hasAlternateReturns();
}
+/// If \p proc refers to a base procedure that carries OpenMP DECLARE VARIANT
+/// entries, return the variant selected for the enclosing OpenMP context: a
+/// direct call to the base is then lowered as a call to that variant. Returns
+/// nullptr when \p proc is not such a base call, or when no variant matches the
+/// context, so the base procedure is used as usual.
+static const Fortran::semantics::Symbol *
+getOmpDeclareVariantCallee(const Fortran::evaluate::ProcedureDesignator &proc,
+ Fortran::lower::AbstractConverter &converter) {
+ const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
+ if (!symbol)
+ return nullptr;
+ const Fortran::semantics::Symbol &ultimate{symbol->GetUltimate()};
+ // Only pay the cost of declare-variant resolution when the callee actually
+ // carries variant entries; this avoids overhead on every other call.
+ const auto *details =
+ ultimate.detailsIf<Fortran::semantics::SubprogramDetails>();
+ if (!details || details->ompDeclareVariants().empty())
+ return nullptr;
+ return Fortran::lower::omp::resolveDeclareVariantCallee(ultimate, converter);
+}
+
/// Return the binding label (from BIND(C...)) or the mangled name of the
/// symbol.
static std::string
getProcMangledName(const Fortran::evaluate::ProcedureDesignator &proc,
Fortran::lower::AbstractConverter &converter) {
- if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
+ if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol()) {
+ // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
+ if (const Fortran::semantics::Symbol *variant =
+ getOmpDeclareVariantCallee(proc, converter))
+ return converter.mangleName(*variant);
return converter.mangleName(symbol->GetUltimate());
+ }
assert(proc.GetSpecificIntrinsic() &&
"expected intrinsic procedure in designator");
return proc.GetName();
@@ -79,6 +106,10 @@ std::string Fortran::lower::CallerInterface::getMangledName() const {
const Fortran::semantics::Symbol *
Fortran::lower::CallerInterface::getProcedureSymbol() const {
+ // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
+ if (const Fortran::semantics::Symbol *variant =
+ getOmpDeclareVariantCallee(procRef.proc(), converter))
+ return variant;
return procRef.proc().GetSymbol();
}
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index ea8c279962508..39a185ab1b9f4 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -4477,8 +4477,8 @@ static void
genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
const parser::OmpDeclareVariantDirective &declareVariantDirective) {
- if (!semaCtx.langOptions().OpenMPSimd)
- TODO(converter.getCurrentLocation(), "OmpDeclareVariantDirective");
+ // No lowering for the declarative directive itself; the recorded variants are
+ // resolved at call sites (see resolveDeclareVariantCallee in CallInterface).
}
static ReductionProcessor::GenCombinerCBTy processReductionCombiner(
diff --git a/flang/lib/Lower/OpenMP/Utils.cpp b/flang/lib/Lower/OpenMP/Utils.cpp
index 382292b6c6c13..308a8597dc657 100644
--- a/flang/lib/Lower/OpenMP/Utils.cpp
+++ b/flang/lib/Lower/OpenMP/Utils.cpp
@@ -20,6 +20,7 @@
#include <flang/Lower/AbstractConverter.h>
#include <flang/Lower/ConvertType.h>
#include <flang/Lower/DirectivesCommon.h>
+#include <flang/Lower/OpenMP.h>
#include <flang/Lower/OpenMP/Clauses.h>
#include <flang/Lower/PFTBuilder.h>
#include <flang/Lower/Support/PrivateReductionUtils.h>
@@ -30,7 +31,10 @@
#include <flang/Parser/openmp-utils.h>
#include <flang/Parser/parse-tree.h>
#include <flang/Parser/tools.h>
+#include <flang/Semantics/omp-declare-variant.h>
#include <flang/Semantics/openmp-utils.h>
+#include <flang/Semantics/scope.h>
+#include <flang/Semantics/symbol.h>
#include <flang/Semantics/tools.h>
#include <flang/Semantics/type.h>
#include <flang/Utils/OpenMP.h>
@@ -1350,6 +1354,60 @@ void collectEnclosingConstructTraits(
std::reverse(constructTraits.begin(), constructTraits.end());
}
+const semantics::Symbol *
+resolveDeclareVariantCallee(const semantics::Symbol &base,
+ AbstractConverter &converter) {
+ const semantics::Symbol &ultimate{base.GetUltimate()};
+
+ const auto *details{ultimate.detailsIf<semantics::SubprogramDetails>()};
+ assert(details && !details->ompDeclareVariants().empty() &&
+ "resolveDeclareVariantCallee called on symbol with no variants");
+
+ semantics::SemanticsContext &semaCtx{ultimate.owner().context()};
+ llvm::SmallVector<llvm::omp::VariantMatchInfo, 4> vmis;
+ llvm::SmallVector<const semantics::Symbol *, 4> variants;
+ for (const semantics::OmpDeclareVariantEntry &entry :
+ details->ompDeclareVariants()) {
+ // Variant selection cannot yet honour some selector features that the
+ // parser/semantics otherwise accept; reject them before building the match
+ // info (MakeVariantMatchInfo asserts none are present). This mirrors how
+ // METADIRECTIVE lowering rejects the same features.
+ if (entry.matchSelector) {
+ switch (semantics::omp::FindUnsupportedSelectorFeature(
+ *entry.matchSelector, semaCtx)) {
+ case semantics::omp::UnsupportedSelectorFeature::TargetDevice:
+ TODO(converter.getCurrentLocation(),
+ "target_device selector in DECLARE VARIANT");
+ break;
+ case semantics::omp::UnsupportedSelectorFeature::
+ ClauseOrExtensionProperty:
+ TODO(converter.getCurrentLocation(),
+ "clause or extension trait matching in DECLARE VARIANT");
+ break;
+ case semantics::omp::UnsupportedSelectorFeature::None:
+ break;
+ }
+ }
+ llvm::omp::VariantMatchInfo &vmi{vmis.emplace_back()};
+ if (entry.matchSelector)
+ semantics::omp::MakeVariantMatchInfo(vmi, *entry.matchSelector, semaCtx);
+ variants.push_back(&entry.variant.get());
+ }
+
+ llvm::SmallVector<llvm::omp::TraitProperty, 8> constructTraits;
+ collectEnclosingConstructTraits(
+ converter.getFirOpBuilder().getInsertionBlock()->getParentOp(),
+ constructTraits);
+ FlangOMPContext ompCtx{converter.getModuleOp(), constructTraits};
+
+ const int bestIdx{llvm::omp::getBestVariantMatchForContext(vmis, ompCtx)};
+ // Return nullptr when no variant matches the current context; the caller
+ // will fall back to the base symbol.
+ if (bestIdx < 0)
+ return nullptr;
+ return variants[bestIdx];
+}
+
} // namespace omp
} // namespace lower
} // namespace Fortran
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index a60f46ba760d9..a52b189879147 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -20,6 +20,7 @@
#include "flang/Parser/characters.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/omp-declare-variant.h"
#include "flang/Semantics/openmp-modifiers.h"
#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/symbol.h"
@@ -740,6 +741,14 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
},
arg.u);
+ const parser::traits::OmpContextSelectorSpecification *matchSelector{
+ getMatchClauseContextSelector(spec)};
+ if (!matchSelector) {
+ context_.Say(x.source,
+ "DECLARE_VARIANT directive requires a MATCH clause"_err_en_US);
+ return;
+ }
+
if (base && variant) {
base = &base->GetUltimate();
variant = &variant->GetUltimate();
@@ -750,22 +759,22 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
context_.Say(arg.source,
"Variant '%s' was already specified for '%s' in another DECLARE VARIANT directive"_err_en_US,
variant->name(), base->name());
- } else if (!hasArgModifiers) {
- // adjust_args/append_args perform the "transformation for its OpenMP
- // context", so the variant interface intentionally differs from the
- // base; skip the same-interface check until they are supported.
- CheckDeclareVariantInterface(context_, *base, *variant, arg.source);
+ } else {
+ if (!hasArgModifiers) {
+ // adjust_args/append_args perform the "transformation for its OpenMP
+ // context", so the variant interface intentionally differs from the
+ // base; skip the same-interface check until they are supported.
+ CheckDeclareVariantInterface(context_, *base, *variant, arg.source);
+ }
+ // Record the variant on its base procedure.
+ if (base->has<SubprogramDetails>()) {
+ auto &details{const_cast<Symbol &>(*base).get<SubprogramDetails>()};
+ details.addOmpDeclareVariant(
+ OmpDeclareVariantEntry{*variant, matchSelector});
+ }
}
}
- const parser::traits::OmpContextSelectorSpecification *matchSelector{
- getMatchClauseContextSelector(spec)};
- if (!matchSelector) {
- context_.Say(x.source,
- "DECLARE_VARIANT directive requires a MATCH clause"_err_en_US);
- return;
- }
-
EnterDirectiveNest(ContextSelectorNest);
CheckContextSelectorSpecification(*matchSelector);
CheckDeclareVariantUserConditions(*matchSelector);
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
new file mode 100644
index 0000000000000..738a57f88d7c2
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
@@ -0,0 +1,30 @@
+! RUN: %not_todo_cmd %flang_fc1 -cpp -DCLAUSE_PROPERTY -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+! RUN: %not_todo_cmd %flang_fc1 -cpp -DEXTENSION_PROPERTY -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: clause or extension trait matching in DECLARE VARIANT
+
+#ifdef CLAUSE_PROPERTY
+subroutine test_clause_property
+ call base_clause()
+end subroutine
+
+subroutine base_clause
+ !$omp declare variant (base_clause:vsub) match (construct={simd(simdlen(8))})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine
+#endif
+
+#ifdef EXTENSION_PROPERTY
+subroutine test_extension_property
+ call base_ext()
+end subroutine
+
+subroutine base_ext
+ !$omp declare variant (base_ext:vsub) match (implementation={my_trait(foo(bar))})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine
+#endif
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
new file mode 100644
index 0000000000000..f9997c58a9dfc
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
@@ -0,0 +1,14 @@
+! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: target_device selector in DECLARE VARIANT
+
+subroutine test_target_device
+ call base()
+end subroutine
+
+subroutine base
+ !$omp declare variant (base:vsub) match (target_device={kind(host)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant.f90
deleted file mode 100644
index 5719ef3afdee1..0000000000000
--- a/flang/test/Lower/OpenMP/Todo/declare-variant.f90
+++ /dev/null
@@ -1,17 +0,0 @@
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
-
-! CHECK: not yet implemented: OmpDeclareVariantDirective
-
-subroutine sb1
- integer :: x
- x = 1
- call sub(x)
-contains
- subroutine vsub (v1)
- integer, value :: v1
- end
- subroutine sub (v1)
- !$omp declare variant(vsub), match(construct={dispatch})
- integer, value :: v1
- end
-end subroutine
diff --git a/flang/test/Lower/OpenMP/declare-variant-call.f90 b/flang/test/Lower/OpenMP/declare-variant-call.f90
new file mode 100644
index 0000000000000..1371f5e26355e
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-call.f90
@@ -0,0 +1,200 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! Lowering tests for DECLARE VARIANT callee resolution at call sites.
+! The declarative directive is not lowered; variant selection rewrites
+! procedure calls inside matching OpenMP regions.
+
+subroutine test_sequential_vs_parallel
+ call base()
+ !$omp parallel
+ call base()
+ !$omp end parallel
+end subroutine test_sequential_vs_parallel
+
+subroutine base
+ !$omp declare variant (base:vsub) match (construct={parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base
+
+! CHECK-LABEL: func.func @_QPtest_sequential_vs_parallel
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+
+subroutine test_teams_vs_parallel
+ !$omp parallel
+ call base2()
+ !$omp end parallel
+ !$omp teams
+ call base2()
+ !$omp end teams
+end subroutine test_teams_vs_parallel
+
+subroutine base2
+ !$omp declare variant (base2:vsub_par) match (construct={parallel})
+ !$omp declare variant (base2:vsub_teams) match (construct={teams})
+contains
+ subroutine vsub_par
+ end subroutine
+ subroutine vsub_teams
+ end subroutine
+end subroutine base2
+
+! CHECK-LABEL: func.func @_QPtest_teams_vs_parallel
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase2Pvsub_par(){{.*}}: () -> ()
+! CHECK: omp.teams
+! CHECK: fir.call @_QFbase2Pvsub_teams(){{.*}}: () -> ()
+
+subroutine test_user_condition_false
+ !$omp parallel
+ call base3()
+ !$omp end parallel
+end subroutine test_user_condition_false
+
+subroutine base3
+ !$omp declare variant (base3:vsub) match (user={condition(.false.)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base3
+
+! CHECK-LABEL: func.func @_QPtest_user_condition_false
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase3(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase3Pvsub
+
+subroutine test_user_condition_true
+ !$omp parallel
+ call base4()
+ !$omp end parallel
+end subroutine test_user_condition_true
+
+subroutine base4
+ !$omp declare variant (base4:vsub) match (user={condition(.true.)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base4
+
+! CHECK-LABEL: func.func @_QPtest_user_condition_true
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase4Pvsub(){{.*}}: () -> ()
+
+subroutine test_omitted_base_name
+ !$omp parallel
+ call host()
+ !$omp end parallel
+end subroutine test_omitted_base_name
+
+subroutine host
+ !$omp declare variant (vsub) match (construct={parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine host
+
+! CHECK-LABEL: func.func @_QPtest_omitted_base_name
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFhostPvsub(){{.*}}: () -> ()
+
+subroutine test_call_with_args
+ integer :: x
+ x = 1
+ call base5(x)
+ !$omp parallel
+ call base5(x)
+ !$omp end parallel
+end subroutine test_call_with_args
+
+subroutine base5(n)
+ integer, intent(in) :: n
+ !$omp declare variant (base5:vsub) match (construct={parallel})
+contains
+ subroutine vsub(n)
+ integer, intent(in) :: n
+ end subroutine
+end subroutine base5
+
+! CHECK-LABEL: func.func @_QPtest_call_with_args
+! CHECK: fir.call @_QPbase5(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase5Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+
+subroutine test_no_variant_recorded
+ call plain()
+ !$omp parallel
+ call plain()
+ !$omp end parallel
+end subroutine test_no_variant_recorded
+
+subroutine plain
+end subroutine plain
+
+! CHECK-LABEL: func.func @_QPtest_no_variant_recorded
+! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFplainP
+
+subroutine test_nested_parallel
+ !$omp parallel
+ !$omp parallel
+ call base6()
+ !$omp end parallel
+ !$omp end parallel
+end subroutine test_nested_parallel
+
+subroutine base6
+ !$omp declare variant (base6:vsub) match (construct={parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base6
+
+! CHECK-LABEL: func.func @_QPtest_nested_parallel
+! CHECK: omp.parallel
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase6Pvsub(){{.*}}: () -> ()
+
+subroutine test_parallel_do
+ integer :: i
+ !$omp parallel do
+ do i = 1, 2
+ call base7(i)
+ end do
+end subroutine test_parallel_do
+
+subroutine base7(n)
+ integer, intent(in) :: n
+ !$omp declare variant (base7:vsub) match (construct={parallel})
+contains
+ subroutine vsub(n)
+ integer, intent(in) :: n
+ end subroutine
+end subroutine base7
+
+! CHECK-LABEL: func.func @_QPtest_parallel_do
+! CHECK: fir.call @_QFbase7Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+
+subroutine test_target_construct
+ call base8()
+ !$omp target
+ call base8()
+ !$omp end target
+end subroutine test_target_construct
+
+subroutine base8
+ !$omp declare variant (base8:vsub) match (construct={target})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base8
+
+! CHECK-LABEL: func.func @_QPtest_target_construct
+! CHECK: fir.call @_QPbase8(){{.*}}: () -> ()
+! CHECK: omp.target
+! CHECK: fir.call @_QFbase8Pvsub(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-construct.f90 b/flang/test/Lower/OpenMP/declare-variant-construct.f90
new file mode 100644
index 0000000000000..23de6ade634dd
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-construct.f90
@@ -0,0 +1,162 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! DECLARE VARIANT callee resolution with combined/composite construct
+! selectors.
+
+! The combined directive selector decomposes to {target, teams}; it matches
+! only when both constructs enclose the call.
+
+! CHECK-LABEL: func.func @_QPtest_combined_match
+! CHECK: omp.target
+! CHECK: omp.teams
+! CHECK: fir.call @_QFbase_ttPvsub(){{.*}}: () -> ()
+subroutine test_combined_match
+ !$omp target
+ !$omp teams
+ call base_tt()
+ !$omp end teams
+ !$omp end target
+end subroutine test_combined_match
+
+subroutine base_tt
+ !$omp declare variant (base_tt:vsub) match (construct={target teams})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_tt
+
+! Only `target` encloses the call, so the {target, teams} selector does not
+! match and the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_combined_partial
+! CHECK: omp.target
+! CHECK: fir.call @_QPbase_tt2(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_tt2Pvsub
+subroutine test_combined_partial
+ !$omp target
+ call base_tt2()
+ !$omp end target
+end subroutine test_combined_partial
+
+subroutine base_tt2
+ !$omp declare variant (base_tt2:vsub) match (construct={target teams})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_tt2
+
+! CHECK-LABEL: func.func @_QPtest_set_match
+! CHECK: omp.target
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
+subroutine test_set_match
+ !$omp target
+ !$omp parallel
+ call base_tp()
+ !$omp end parallel
+ !$omp end target
+end subroutine test_set_match
+
+subroutine base_tp
+ !$omp declare variant (base_tp:vsub) match (construct={target, parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_tp
+
+! Inside `parallel` alone the {target, parallel} selector is not satisfied,
+! so the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_set_no_match
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase_tp2(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_tp2Pvsub
+subroutine test_set_no_match
+ !$omp parallel
+ call base_tp2()
+ !$omp end parallel
+end subroutine test_set_no_match
+
+subroutine base_tp2
+ !$omp declare variant (base_tp2:vsub) match (construct={target, parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_tp2
+
+! A `teams` construct between `target` and `parallel` does not prevent the
+! match: {target, parallel} matches as an ordered subsequence of the enclosing
+! target>teams>parallel context.
+
+! CHECK-LABEL: func.func @_QPtest_set_match_nested_teams
+! CHECK: omp.target
+! CHECK: omp.teams
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
+subroutine test_set_match_nested_teams
+ !$omp target
+ !$omp teams
+ !$omp parallel
+ call base_tp()
+ !$omp end parallel
+ !$omp end teams
+ !$omp end target
+end subroutine test_set_match_nested_teams
+
+subroutine base_rank
+ !$omp declare variant (base_rank:vsub_par) match (construct={parallel})
+ !$omp declare variant (base_rank:vsub_tp) match (construct={target, parallel})
+contains
+ subroutine vsub_par
+ end subroutine
+ subroutine vsub_tp
+ end subroutine
+end subroutine base_rank
+
+! Inside target>parallel both variants apply; the more specific
+! {target, parallel} selector outranks {parallel}.
+
+! CHECK-LABEL: func.func @_QPtest_rank_specific
+! CHECK: omp.target
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_rankPvsub_tp(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_rankPvsub_par
+subroutine test_rank_specific
+ !$omp target
+ !$omp parallel
+ call base_rank()
+ !$omp end parallel
+ !$omp end target
+end subroutine test_rank_specific
+
+! Inside parallel alone only {parallel} applies.
+
+! CHECK-LABEL: func.func @_QPtest_rank_parallel_only
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_rankPvsub_par(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_rankPvsub_tp
+subroutine test_rank_parallel_only
+ !$omp parallel
+ call base_rank()
+ !$omp end parallel
+end subroutine test_rank_parallel_only
+
+subroutine base_score
+ !$omp declare variant (base_score:vsub_lo) match (user={condition(score(1): .true.)})
+ !$omp declare variant (base_score:vsub_hi) match (user={condition(score(100): .true.)})
+contains
+ subroutine vsub_lo
+ end subroutine
+ subroutine vsub_hi
+ end subroutine
+end subroutine base_score
+
+! Both conditions are statically true; the higher score wins.
+
+! CHECK-LABEL: func.func @_QPtest_score_ranking
+! CHECK: fir.call @_QFbase_scorePvsub_hi(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_scorePvsub_lo
+subroutine test_score_ranking
+ call base_score()
+end subroutine test_score_ranking
diff --git a/flang/test/Lower/OpenMP/declare-variant-device.f90 b/flang/test/Lower/OpenMP/declare-variant-device.f90
new file mode 100644
index 0000000000000..1191d6312b551
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-device.f90
@@ -0,0 +1,53 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_device_kind_host
+! CHECK: fir.call @_QFbase_hostPvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase_host
+subroutine test_device_kind_host
+ call base_host()
+end subroutine test_device_kind_host
+
+subroutine base_host
+ !$omp declare variant (base_host:vsub) match (device={kind(host)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_host
+
+! kind(nohost) does not match on a host compilation: the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_device_kind_nohost
+! CHECK: fir.call @_QPbase_nohost(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_nohostPvsub
+subroutine test_device_kind_nohost
+ call base_nohost()
+end subroutine test_device_kind_nohost
+
+subroutine base_nohost
+ !$omp declare variant (base_nohost:vsub) match (device={kind(nohost)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_nohost
+
+! A device kind that matches neither host nor nohost also does not select
+! a variant.
+
+! CHECK-LABEL: func.func @_QPtest_device_no_match
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbasePvsub
+subroutine test_device_no_match
+ call base()
+ !$omp parallel
+ call base()
+ !$omp end parallel
+end subroutine test_device_no_match
+
+subroutine base
+ !$omp declare variant (base:vsub) match (device={kind(fpga)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base
diff --git a/flang/test/Lower/OpenMP/declare-variant-implementation.f90 b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
new file mode 100644
index 0000000000000..07f5124bee035
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
@@ -0,0 +1,32 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_vendor_llvm
+! CHECK: fir.call @_QFbase_llvmPvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase_llvm
+subroutine test_vendor_llvm
+ call base_llvm()
+end subroutine test_vendor_llvm
+
+subroutine base_llvm
+ !$omp declare variant (base_llvm:vsub) match (implementation={vendor(llvm)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_llvm
+
+! An unknown vendor does not match: the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_vendor_unknown
+! CHECK: fir.call @_QPbase_unknown(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_unknownPvsub
+subroutine test_vendor_unknown
+ call base_unknown()
+end subroutine test_vendor_unknown
+
+subroutine base_unknown
+ !$omp declare variant (base_unknown:vsub) match (implementation={vendor("unknown")})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base_unknown
diff --git a/flang/test/Lower/OpenMP/declare-variant-module.f90 b/flang/test/Lower/OpenMP/declare-variant-module.f90
new file mode 100644
index 0000000000000..aa75473a9582b
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-module.f90
@@ -0,0 +1,23 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+module m
+contains
+ subroutine base
+ !$omp declare variant (base:vsub) match (construct={parallel})
+ contains
+ subroutine vsub
+ end subroutine
+ end subroutine base
+
+ subroutine caller
+ call base()
+ !$omp parallel
+ call base()
+ !$omp end parallel
+ end subroutine caller
+end module m
+
+! CHECK-LABEL: func.func @_QMmPcaller
+! CHECK: fir.call @_QMmPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QMmFbasePvsub(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
new file mode 100644
index 0000000000000..45549cb7c444d
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
@@ -0,0 +1,28 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 \
+! RUN: -fopenmp-is-target-device %s -o - | FileCheck %s
+
+subroutine base
+ !$omp declare variant (base:vsub) match (device={kind(nohost)})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine base
+
+subroutine device_caller
+ !$omp declare target to(device_caller) device_type(nohost)
+ call base()
+end subroutine device_caller
+
+subroutine target_region_caller
+ !$omp target
+ call base()
+ !$omp end target
+end subroutine target_region_caller
+
+! CHECK-LABEL: func.func @_QPdevice_caller
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase
+
+! CHECK-LABEL: func.func @_QPtarget_region_caller
+! CHECK: omp.target
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
>From cdc7baba96d66d0b7f4d3ba9cc45307bdad02b67 Mon Sep 17 00:00:00 2001
From: Abid Qadeer <haqadeer at amd.com>
Date: Fri, 3 Jul 2026 16:14:29 +0100
Subject: [PATCH 2/3] Handle review comments.
1. Error out if a variant is not accessible at a call site.
2. Only replace direct calls (not indirect calls or a procedure passed as
an argument).
3. Update tests accordingly.
---
flang/lib/Lower/CallInterface.cpp | 15 +-
flang/lib/Semantics/check-omp-variant.cpp | 32 +-
...lare-variant-structured-trait-property.f90 | 14 +-
.../Todo/declare-variant-target-device.f90 | 7 +-
.../Lower/OpenMP/declare-variant-call.f90 | 207 +++++++-----
.../OpenMP/declare-variant-construct.f90 | 306 +++++++++---------
.../Lower/OpenMP/declare-variant-device.f90 | 45 +--
.../OpenMP/declare-variant-implementation.f90 | 25 +-
.../Lower/OpenMP/declare-variant-module.f90 | 12 +-
.../OpenMP/declare-variant-target-device.f90 | 39 +--
.../test/Semantics/OpenMP/declare-variant.f90 | 39 ++-
11 files changed, 433 insertions(+), 308 deletions(-)
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index cb3be13e8c9ba..5317bc766f2ef 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -88,19 +88,22 @@ getOmpDeclareVariantCallee(const Fortran::evaluate::ProcedureDesignator &proc,
static std::string
getProcMangledName(const Fortran::evaluate::ProcedureDesignator &proc,
Fortran::lower::AbstractConverter &converter) {
- if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol()) {
- // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
- if (const Fortran::semantics::Symbol *variant =
- getOmpDeclareVariantCallee(proc, converter))
- return converter.mangleName(*variant);
+ if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
return converter.mangleName(symbol->GetUltimate());
- }
assert(proc.GetSpecificIntrinsic() &&
"expected intrinsic procedure in designator");
return proc.GetName();
}
std::string Fortran::lower::CallerInterface::getMangledName() const {
+ // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
+ // This substitution applies only to an actual call to the base procedure.
+ // Other references to the base (e.g. taking its address to pass it as an
+ // actual argument or to associate it with a procedure pointer) go through
+ // getProcMangledName and are intentionally not redirected to the variant.
+ if (const Fortran::semantics::Symbol *variant =
+ getOmpDeclareVariantCallee(procRef.proc(), converter))
+ return converter.mangleName(*variant);
return getProcMangledName(procRef.proc(), converter);
}
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index a52b189879147..13b42f787ec74 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -672,6 +672,29 @@ static void CheckDeclareVariantInterface(SemanticsContext &context,
}
}
+// A declare-variant call is rewritten to the variant at every reference to the
+// base, so the variant must be accessible at each of those references. The name
+// of an internal procedure is only visible within its host, so it may only be a
+// variant of a procedure that is internal to the same host; otherwise a
+// reference to the base from elsewhere could not name the variant. OpenMP does
+// not clearly specify this; Flang restricts it to avoid resolving a call to an
+// internal procedure that is not accessible there. Returns true if the pairing
+// is allowed.
+static bool CheckVariantAccessibility(SemanticsContext &context,
+ const Symbol &base, const Symbol &variant, parser::CharBlock source) {
+ if (ClassifyProcedure(variant) != ProcedureDefinitionClass::Internal) {
+ return true;
+ }
+ if (ClassifyProcedure(base) == ProcedureDefinitionClass::Internal &&
+ &base.owner() == &variant.owner()) {
+ return true;
+ }
+ context.Say(source,
+ "The variant procedure '%s' is an internal procedure and is not accessible at every reference to the base procedure '%s'"_err_en_US,
+ variant.name(), base.name());
+ return false;
+}
+
void OmpStructureChecker::CheckOmpDeclareVariantDirective(
const parser::OmpDeclareVariantDirective &x) {
const parser::OmpDirectiveSpecification &spec{x.v};
@@ -749,7 +772,11 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
return;
}
- if (base && variant) {
+ auto isProcedure{[](const Symbol *sym) {
+ return sym && (IsProcedure(*sym) || IsFunction(*sym));
+ }};
+
+ if (isProcedure(base) && isProcedure(variant)) {
base = &base->GetUltimate();
variant = &variant->GetUltimate();
if (base == variant) {
@@ -759,7 +786,8 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
context_.Say(arg.source,
"Variant '%s' was already specified for '%s' in another DECLARE VARIANT directive"_err_en_US,
variant->name(), base->name());
- } else {
+ } else if (CheckVariantAccessibility(
+ context_, *base, *variant, arg.source)) {
if (!hasArgModifiers) {
// adjust_args/append_args perform the "transformation for its OpenMP
// context", so the variant interface intentionally differs from the
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
index 738a57f88d7c2..bfbac5e56b700 100644
--- a/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
@@ -9,10 +9,11 @@ subroutine test_clause_property
end subroutine
subroutine base_clause
+ interface
+ subroutine vsub()
+ end subroutine
+ end interface
!$omp declare variant (base_clause:vsub) match (construct={simd(simdlen(8))})
-contains
- subroutine vsub
- end subroutine
end subroutine
#endif
@@ -22,9 +23,10 @@ subroutine test_extension_property
end subroutine
subroutine base_ext
+ interface
+ subroutine vsub()
+ end subroutine
+ end interface
!$omp declare variant (base_ext:vsub) match (implementation={my_trait(foo(bar))})
-contains
- subroutine vsub
- end subroutine
end subroutine
#endif
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
index f9997c58a9dfc..cc74e358e4425 100644
--- a/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
@@ -7,8 +7,9 @@ subroutine test_target_device
end subroutine
subroutine base
+ interface
+ subroutine vsub()
+ end subroutine
+ end interface
!$omp declare variant (base:vsub) match (target_device={kind(host)})
-contains
- subroutine vsub
- end subroutine
end subroutine
diff --git a/flang/test/Lower/OpenMP/declare-variant-call.f90 b/flang/test/Lower/OpenMP/declare-variant-call.f90
index 1371f5e26355e..289f93ceda62f 100644
--- a/flang/test/Lower/OpenMP/declare-variant-call.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-call.f90
@@ -3,26 +3,27 @@
! Lowering tests for DECLARE VARIANT callee resolution at call sites.
! The declarative directive is not lowered; variant selection rewrites
-! procedure calls inside matching OpenMP regions.
+! procedure calls inside matching OpenMP regions. The base and its variant are
+! sibling internal procedures of the calling host, so the variant is accessible
+! at every reference to the base.
subroutine test_sequential_vs_parallel
call base()
!$omp parallel
call base()
!$omp end parallel
-end subroutine test_sequential_vs_parallel
-
-subroutine base
- !$omp declare variant (base:vsub) match (construct={parallel})
contains
+ subroutine base
+ !$omp declare variant (base:vsub) match (construct={parallel})
+ end subroutine base
subroutine vsub
- end subroutine
-end subroutine base
+ end subroutine vsub
+end subroutine test_sequential_vs_parallel
! CHECK-LABEL: func.func @_QPtest_sequential_vs_parallel
-! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_sequential_vs_parallelPbase(){{.*}}: () -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_sequential_vs_parallelPvsub(){{.*}}: () -> ()
subroutine test_teams_vs_parallel
!$omp parallel
@@ -31,75 +32,76 @@ subroutine test_teams_vs_parallel
!$omp teams
call base2()
!$omp end teams
-end subroutine test_teams_vs_parallel
-
-subroutine base2
- !$omp declare variant (base2:vsub_par) match (construct={parallel})
- !$omp declare variant (base2:vsub_teams) match (construct={teams})
contains
+ subroutine base2
+ !$omp declare variant (base2:vsub_par) match (construct={parallel})
+ !$omp declare variant (base2:vsub_teams) match (construct={teams})
+ end subroutine base2
subroutine vsub_par
- end subroutine
+ end subroutine vsub_par
subroutine vsub_teams
- end subroutine
-end subroutine base2
+ end subroutine vsub_teams
+end subroutine test_teams_vs_parallel
! CHECK-LABEL: func.func @_QPtest_teams_vs_parallel
! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase2Pvsub_par(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_teams_vs_parallelPvsub_par(){{.*}}: () -> ()
! CHECK: omp.teams
-! CHECK: fir.call @_QFbase2Pvsub_teams(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_teams_vs_parallelPvsub_teams(){{.*}}: () -> ()
subroutine test_user_condition_false
!$omp parallel
call base3()
!$omp end parallel
-end subroutine test_user_condition_false
-
-subroutine base3
- !$omp declare variant (base3:vsub) match (user={condition(.false.)})
contains
+ subroutine base3
+ !$omp declare variant (base3:vsub) match (user={condition(.false.)})
+ end subroutine base3
subroutine vsub
- end subroutine
-end subroutine base3
+ end subroutine vsub
+end subroutine test_user_condition_false
! CHECK-LABEL: func.func @_QPtest_user_condition_false
! CHECK: omp.parallel
-! CHECK: fir.call @_QPbase3(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase3Pvsub
+! CHECK: fir.call @_QFtest_user_condition_falsePbase3(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFtest_user_condition_falsePvsub
subroutine test_user_condition_true
!$omp parallel
call base4()
!$omp end parallel
-end subroutine test_user_condition_true
-
-subroutine base4
- !$omp declare variant (base4:vsub) match (user={condition(.true.)})
contains
+ subroutine base4
+ !$omp declare variant (base4:vsub) match (user={condition(.true.)})
+ end subroutine base4
subroutine vsub
- end subroutine
-end subroutine base4
+ end subroutine vsub
+end subroutine test_user_condition_true
! CHECK-LABEL: func.func @_QPtest_user_condition_true
! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase4Pvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_user_condition_truePvsub(){{.*}}: () -> ()
+
+! With the base name omitted, the enclosing procedure (the internal subprogram
+! omit_base) is the base; its sibling internal vsub is the variant.
subroutine test_omitted_base_name
+ call omit_base()
!$omp parallel
- call host()
+ call omit_base()
!$omp end parallel
-end subroutine test_omitted_base_name
-
-subroutine host
- !$omp declare variant (vsub) match (construct={parallel})
contains
+ subroutine omit_base
+ !$omp declare variant (vsub) match (construct={parallel})
+ end subroutine omit_base
subroutine vsub
- end subroutine
-end subroutine host
+ end subroutine vsub
+end subroutine test_omitted_base_name
! CHECK-LABEL: func.func @_QPtest_omitted_base_name
+! CHECK: fir.call @_QFtest_omitted_base_namePomit_base(){{.*}}: () -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QFhostPvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_omitted_base_namePvsub(){{.*}}: () -> ()
subroutine test_call_with_args
integer :: x
@@ -108,37 +110,35 @@ subroutine test_call_with_args
!$omp parallel
call base5(x)
!$omp end parallel
-end subroutine test_call_with_args
-
-subroutine base5(n)
- integer, intent(in) :: n
- !$omp declare variant (base5:vsub) match (construct={parallel})
contains
+ subroutine base5(n)
+ integer, intent(in) :: n
+ !$omp declare variant (base5:vsub) match (construct={parallel})
+ end subroutine base5
subroutine vsub(n)
integer, intent(in) :: n
- end subroutine
-end subroutine base5
+ end subroutine vsub
+end subroutine test_call_with_args
! CHECK-LABEL: func.func @_QPtest_call_with_args
-! CHECK: fir.call @_QPbase5(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: fir.call @_QFtest_call_with_argsPbase5(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase5Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: fir.call @_QFtest_call_with_argsPvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
subroutine test_no_variant_recorded
call plain()
!$omp parallel
call plain()
!$omp end parallel
+contains
+ subroutine plain
+ end subroutine plain
end subroutine test_no_variant_recorded
-subroutine plain
-end subroutine plain
-
! CHECK-LABEL: func.func @_QPtest_no_variant_recorded
-! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_no_variant_recordedPplain(){{.*}}: () -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFplainP
+! CHECK: fir.call @_QFtest_no_variant_recordedPplain(){{.*}}: () -> ()
subroutine test_nested_parallel
!$omp parallel
@@ -146,19 +146,18 @@ subroutine test_nested_parallel
call base6()
!$omp end parallel
!$omp end parallel
-end subroutine test_nested_parallel
-
-subroutine base6
- !$omp declare variant (base6:vsub) match (construct={parallel})
contains
+ subroutine base6
+ !$omp declare variant (base6:vsub) match (construct={parallel})
+ end subroutine base6
subroutine vsub
- end subroutine
-end subroutine base6
+ end subroutine vsub
+end subroutine test_nested_parallel
! CHECK-LABEL: func.func @_QPtest_nested_parallel
! CHECK: omp.parallel
! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase6Pvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_nested_parallelPvsub(){{.*}}: () -> ()
subroutine test_parallel_do
integer :: i
@@ -166,35 +165,83 @@ subroutine test_parallel_do
do i = 1, 2
call base7(i)
end do
-end subroutine test_parallel_do
-
-subroutine base7(n)
- integer, intent(in) :: n
- !$omp declare variant (base7:vsub) match (construct={parallel})
contains
+ subroutine base7(n)
+ integer, intent(in) :: n
+ !$omp declare variant (base7:vsub) match (construct={parallel})
+ end subroutine base7
subroutine vsub(n)
integer, intent(in) :: n
- end subroutine
-end subroutine base7
+ end subroutine vsub
+end subroutine test_parallel_do
! CHECK-LABEL: func.func @_QPtest_parallel_do
-! CHECK: fir.call @_QFbase7Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: fir.call @_QFtest_parallel_doPvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
subroutine test_target_construct
call base8()
!$omp target
call base8()
!$omp end target
-end subroutine test_target_construct
-
-subroutine base8
- !$omp declare variant (base8:vsub) match (construct={target})
contains
+ subroutine base8
+ !$omp declare variant (base8:vsub) match (construct={target})
+ end subroutine base8
subroutine vsub
- end subroutine
-end subroutine base8
+ end subroutine vsub
+end subroutine test_target_construct
! CHECK-LABEL: func.func @_QPtest_target_construct
-! CHECK: fir.call @_QPbase8(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_target_constructPbase8(){{.*}}: () -> ()
! CHECK: omp.target
-! CHECK: fir.call @_QFbase8Pvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QFtest_target_constructPvsub(){{.*}}: () -> ()
+
+! DECLARE VARIANT substitutes the variant only at an actual call to the base.
+! Taking the base's address to pass it as an actual argument is not a call, so
+! it must still reference the base, even inside a matching context.
+
+subroutine test_reference_vs_call
+ !$omp parallel
+ call apply(base9)
+ call base9()
+ !$omp end parallel
+contains
+ subroutine base9
+ !$omp declare variant (base9:vsub) match (construct={parallel})
+ end subroutine base9
+ subroutine vsub
+ end subroutine vsub
+ subroutine apply(f)
+ external :: f
+ call f()
+ end subroutine apply
+end subroutine test_reference_vs_call
+
+! CHECK-LABEL: func.func @_QPtest_reference_vs_call
+! CHECK: omp.parallel
+! CHECK: fir.address_of(@_QFtest_reference_vs_callPbase9)
+! CHECK: fir.call @_QFtest_reference_vs_callPapply
+! CHECK: fir.call @_QFtest_reference_vs_callPvsub(){{.*}}: () -> ()
+
+! DECLARE VARIANT applies only to a direct call to the base in our
+! implementation.
+
+subroutine test_dummy_not_replaced
+ call indirect_caller(base10)
+contains
+ subroutine base10
+ !$omp declare variant (base10:vsub) match (construct={parallel})
+ end subroutine base10
+ subroutine vsub
+ end subroutine vsub
+ subroutine indirect_caller(f)
+ procedure() :: f
+ !$omp parallel
+ call f()
+ !$omp end parallel
+ end subroutine indirect_caller
+end subroutine test_dummy_not_replaced
+
+! CHECK-LABEL: func.func {{.*}}@_QFtest_dummy_not_replacedPindirect_caller
+! CHECK: omp.parallel
+! CHECK: fir.call %{{[0-9]+}}(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-construct.f90 b/flang/test/Lower/OpenMP/declare-variant-construct.f90
index 23de6ade634dd..ca72b5c8e47af 100644
--- a/flang/test/Lower/OpenMP/declare-variant-construct.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-construct.f90
@@ -2,161 +2,159 @@
! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
! DECLARE VARIANT callee resolution with combined/composite construct
-! selectors.
-
-! The combined directive selector decomposes to {target, teams}; it matches
-! only when both constructs enclose the call.
-
-! CHECK-LABEL: func.func @_QPtest_combined_match
-! CHECK: omp.target
-! CHECK: omp.teams
-! CHECK: fir.call @_QFbase_ttPvsub(){{.*}}: () -> ()
-subroutine test_combined_match
- !$omp target
- !$omp teams
- call base_tt()
- !$omp end teams
- !$omp end target
-end subroutine test_combined_match
-
-subroutine base_tt
- !$omp declare variant (base_tt:vsub) match (construct={target teams})
-contains
- subroutine vsub
- end subroutine
-end subroutine base_tt
-
-! Only `target` encloses the call, so the {target, teams} selector does not
-! match and the base call is kept.
-
-! CHECK-LABEL: func.func @_QPtest_combined_partial
-! CHECK: omp.target
-! CHECK: fir.call @_QPbase_tt2(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_tt2Pvsub
-subroutine test_combined_partial
- !$omp target
- call base_tt2()
- !$omp end target
-end subroutine test_combined_partial
-
-subroutine base_tt2
- !$omp declare variant (base_tt2:vsub) match (construct={target teams})
-contains
- subroutine vsub
- end subroutine
-end subroutine base_tt2
-
-! CHECK-LABEL: func.func @_QPtest_set_match
-! CHECK: omp.target
-! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
-subroutine test_set_match
- !$omp target
- !$omp parallel
- call base_tp()
- !$omp end parallel
- !$omp end target
-end subroutine test_set_match
-
-subroutine base_tp
- !$omp declare variant (base_tp:vsub) match (construct={target, parallel})
-contains
- subroutine vsub
- end subroutine
-end subroutine base_tp
-
-! Inside `parallel` alone the {target, parallel} selector is not satisfied,
-! so the base call is kept.
-
-! CHECK-LABEL: func.func @_QPtest_set_no_match
-! CHECK: omp.parallel
-! CHECK: fir.call @_QPbase_tp2(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_tp2Pvsub
-subroutine test_set_no_match
- !$omp parallel
- call base_tp2()
- !$omp end parallel
-end subroutine test_set_no_match
-
-subroutine base_tp2
- !$omp declare variant (base_tp2:vsub) match (construct={target, parallel})
-contains
- subroutine vsub
- end subroutine
-end subroutine base_tp2
-
-! A `teams` construct between `target` and `parallel` does not prevent the
-! match: {target, parallel} matches as an ordered subsequence of the enclosing
-! target>teams>parallel context.
-
-! CHECK-LABEL: func.func @_QPtest_set_match_nested_teams
-! CHECK: omp.target
-! CHECK: omp.teams
-! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
-subroutine test_set_match_nested_teams
- !$omp target
- !$omp teams
- !$omp parallel
- call base_tp()
- !$omp end parallel
- !$omp end teams
- !$omp end target
-end subroutine test_set_match_nested_teams
-
-subroutine base_rank
- !$omp declare variant (base_rank:vsub_par) match (construct={parallel})
- !$omp declare variant (base_rank:vsub_tp) match (construct={target, parallel})
+! selectors. The bases and their variants are sibling module procedures, so
+! each variant is accessible at every reference to its base.
+
+module m
contains
- subroutine vsub_par
- end subroutine
+ subroutine base_tt
+ !$omp declare variant (base_tt:vsub_tt) match (construct={target teams})
+ end subroutine base_tt
+ subroutine vsub_tt
+ end subroutine vsub_tt
+
+ subroutine base_tt2
+ !$omp declare variant (base_tt2:vsub_tt2) match (construct={target teams})
+ end subroutine base_tt2
+ subroutine vsub_tt2
+ end subroutine vsub_tt2
+
+ subroutine base_tp
+ !$omp declare variant (base_tp:vsub_tp) match (construct={target, parallel})
+ end subroutine base_tp
subroutine vsub_tp
- end subroutine
-end subroutine base_rank
-
-! Inside target>parallel both variants apply; the more specific
-! {target, parallel} selector outranks {parallel}.
-
-! CHECK-LABEL: func.func @_QPtest_rank_specific
-! CHECK: omp.target
-! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase_rankPvsub_tp(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_rankPvsub_par
-subroutine test_rank_specific
- !$omp target
- !$omp parallel
- call base_rank()
- !$omp end parallel
- !$omp end target
-end subroutine test_rank_specific
-
-! Inside parallel alone only {parallel} applies.
-
-! CHECK-LABEL: func.func @_QPtest_rank_parallel_only
-! CHECK: omp.parallel
-! CHECK: fir.call @_QFbase_rankPvsub_par(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_rankPvsub_tp
-subroutine test_rank_parallel_only
- !$omp parallel
- call base_rank()
- !$omp end parallel
-end subroutine test_rank_parallel_only
-
-subroutine base_score
- !$omp declare variant (base_score:vsub_lo) match (user={condition(score(1): .true.)})
- !$omp declare variant (base_score:vsub_hi) match (user={condition(score(100): .true.)})
-contains
+ end subroutine vsub_tp
+
+ subroutine base_tp2
+ !$omp declare variant (base_tp2:vsub_tp2) match (construct={target, parallel})
+ end subroutine base_tp2
+ subroutine vsub_tp2
+ end subroutine vsub_tp2
+
+ subroutine base_rank
+ !$omp declare variant (base_rank:vsub_par) match (construct={parallel})
+ !$omp declare variant (base_rank:vsub_rank_tp) match (construct={target, parallel})
+ end subroutine base_rank
+ subroutine vsub_par
+ end subroutine vsub_par
+ subroutine vsub_rank_tp
+ end subroutine vsub_rank_tp
+
+ subroutine base_score
+ !$omp declare variant (base_score:vsub_lo) match (user={condition(score(1): .true.)})
+ !$omp declare variant (base_score:vsub_hi) match (user={condition(score(100): .true.)})
+ end subroutine base_score
subroutine vsub_lo
- end subroutine
+ end subroutine vsub_lo
subroutine vsub_hi
- end subroutine
-end subroutine base_score
-
-! Both conditions are statically true; the higher score wins.
-
-! CHECK-LABEL: func.func @_QPtest_score_ranking
-! CHECK: fir.call @_QFbase_scorePvsub_hi(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_scorePvsub_lo
-subroutine test_score_ranking
- call base_score()
-end subroutine test_score_ranking
+ end subroutine vsub_hi
+
+ ! The combined directive selector decomposes to {target, teams}; it matches
+ ! only when both constructs enclose the call.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_combined_match
+ ! CHECK: omp.target
+ ! CHECK: omp.teams
+ ! CHECK: fir.call @_QMmPvsub_tt(){{.*}}: () -> ()
+ subroutine test_combined_match
+ !$omp target
+ !$omp teams
+ call base_tt()
+ !$omp end teams
+ !$omp end target
+ end subroutine test_combined_match
+
+ ! Only `target` encloses the call, so the {target, teams} selector does not
+ ! match and the base call is kept.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_combined_partial
+ ! CHECK: omp.target
+ ! CHECK: fir.call @_QMmPbase_tt2(){{.*}}: () -> ()
+ ! CHECK-NOT: fir.call @_QMmPvsub_tt2
+ subroutine test_combined_partial
+ !$omp target
+ call base_tt2()
+ !$omp end target
+ end subroutine test_combined_partial
+
+ ! CHECK-LABEL: func.func @_QMmPtest_set_match
+ ! CHECK: omp.target
+ ! CHECK: omp.parallel
+ ! CHECK: fir.call @_QMmPvsub_tp(){{.*}}: () -> ()
+ subroutine test_set_match
+ !$omp target
+ !$omp parallel
+ call base_tp()
+ !$omp end parallel
+ !$omp end target
+ end subroutine test_set_match
+
+ ! Inside `parallel` alone the {target, parallel} selector is not satisfied,
+ ! so the base call is kept.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_set_no_match
+ ! CHECK: omp.parallel
+ ! CHECK: fir.call @_QMmPbase_tp2(){{.*}}: () -> ()
+ ! CHECK-NOT: fir.call @_QMmPvsub_tp2
+ subroutine test_set_no_match
+ !$omp parallel
+ call base_tp2()
+ !$omp end parallel
+ end subroutine test_set_no_match
+
+ ! A `teams` construct between `target` and `parallel` does not prevent the
+ ! match: {target, parallel} matches as an ordered subsequence of the enclosing
+ ! target>teams>parallel context.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_set_match_nested_teams
+ ! CHECK: omp.target
+ ! CHECK: omp.teams
+ ! CHECK: omp.parallel
+ ! CHECK: fir.call @_QMmPvsub_tp(){{.*}}: () -> ()
+ subroutine test_set_match_nested_teams
+ !$omp target
+ !$omp teams
+ !$omp parallel
+ call base_tp()
+ !$omp end parallel
+ !$omp end teams
+ !$omp end target
+ end subroutine test_set_match_nested_teams
+
+ ! Inside target>parallel both variants apply; the more specific
+ ! {target, parallel} selector outranks {parallel}.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_rank_specific
+ ! CHECK: omp.target
+ ! CHECK: omp.parallel
+ ! CHECK: fir.call @_QMmPvsub_rank_tp(){{.*}}: () -> ()
+ ! CHECK-NOT: fir.call @_QMmPvsub_par
+ subroutine test_rank_specific
+ !$omp target
+ !$omp parallel
+ call base_rank()
+ !$omp end parallel
+ !$omp end target
+ end subroutine test_rank_specific
+
+ ! Inside parallel alone only {parallel} applies.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_rank_parallel_only
+ ! CHECK: omp.parallel
+ ! CHECK: fir.call @_QMmPvsub_par(){{.*}}: () -> ()
+ ! CHECK-NOT: fir.call @_QMmPvsub_rank_tp
+ subroutine test_rank_parallel_only
+ !$omp parallel
+ call base_rank()
+ !$omp end parallel
+ end subroutine test_rank_parallel_only
+
+ ! Both conditions are statically true; the higher score wins.
+
+ ! CHECK-LABEL: func.func @_QMmPtest_score_ranking
+ ! CHECK: fir.call @_QMmPvsub_hi(){{.*}}: () -> ()
+ ! CHECK-NOT: fir.call @_QMmPvsub_lo
+ subroutine test_score_ranking
+ call base_score()
+ end subroutine test_score_ranking
+end module m
diff --git a/flang/test/Lower/OpenMP/declare-variant-device.f90 b/flang/test/Lower/OpenMP/declare-variant-device.f90
index 1191d6312b551..fa06f0e0c8cb7 100644
--- a/flang/test/Lower/OpenMP/declare-variant-device.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-device.f90
@@ -1,53 +1,56 @@
! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
! CHECK-LABEL: func.func @_QPtest_device_kind_host
-! CHECK: fir.call @_QFbase_hostPvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QPvhost(){{.*}}: () -> ()
! CHECK-NOT: fir.call @_QPbase_host
subroutine test_device_kind_host
call base_host()
end subroutine test_device_kind_host
subroutine base_host
- !$omp declare variant (base_host:vsub) match (device={kind(host)})
-contains
- subroutine vsub
- end subroutine
+ interface
+ subroutine vhost()
+ end subroutine
+ end interface
+ !$omp declare variant (base_host:vhost) match (device={kind(host)})
end subroutine base_host
! kind(nohost) does not match on a host compilation: the base call is kept.
! CHECK-LABEL: func.func @_QPtest_device_kind_nohost
! CHECK: fir.call @_QPbase_nohost(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_nohostPvsub
+! CHECK-NOT: fir.call @_QPvnohost
subroutine test_device_kind_nohost
call base_nohost()
end subroutine test_device_kind_nohost
subroutine base_nohost
- !$omp declare variant (base_nohost:vsub) match (device={kind(nohost)})
-contains
- subroutine vsub
- end subroutine
+ interface
+ subroutine vnohost()
+ end subroutine
+ end interface
+ !$omp declare variant (base_nohost:vnohost) match (device={kind(nohost)})
end subroutine base_nohost
! A device kind that matches neither host nor nohost also does not select
! a variant.
! CHECK-LABEL: func.func @_QPtest_device_no_match
-! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: fir.call @_QPbase_fpga(){{.*}}: () -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbasePvsub
+! CHECK: fir.call @_QPbase_fpga(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPvfpga
subroutine test_device_no_match
- call base()
+ call base_fpga()
!$omp parallel
- call base()
+ call base_fpga()
!$omp end parallel
end subroutine test_device_no_match
-subroutine base
- !$omp declare variant (base:vsub) match (device={kind(fpga)})
-contains
- subroutine vsub
- end subroutine
-end subroutine base
+subroutine base_fpga
+ interface
+ subroutine vfpga()
+ end subroutine
+ end interface
+ !$omp declare variant (base_fpga:vfpga) match (device={kind(fpga)})
+end subroutine base_fpga
diff --git a/flang/test/Lower/OpenMP/declare-variant-implementation.f90 b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
index 07f5124bee035..b0917d0bc9d74 100644
--- a/flang/test/Lower/OpenMP/declare-variant-implementation.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
@@ -1,32 +1,37 @@
! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! The base and its variant are both external procedures (same visibility), so
+! the variant is accessible at every reference to the base.
+
! CHECK-LABEL: func.func @_QPtest_vendor_llvm
-! CHECK: fir.call @_QFbase_llvmPvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QPvllvm(){{.*}}: () -> ()
! CHECK-NOT: fir.call @_QPbase_llvm
subroutine test_vendor_llvm
call base_llvm()
end subroutine test_vendor_llvm
subroutine base_llvm
- !$omp declare variant (base_llvm:vsub) match (implementation={vendor(llvm)})
-contains
- subroutine vsub
- end subroutine
+ interface
+ subroutine vllvm()
+ end subroutine
+ end interface
+ !$omp declare variant (base_llvm:vllvm) match (implementation={vendor(llvm)})
end subroutine base_llvm
! An unknown vendor does not match: the base call is kept.
! CHECK-LABEL: func.func @_QPtest_vendor_unknown
! CHECK: fir.call @_QPbase_unknown(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QFbase_unknownPvsub
+! CHECK-NOT: fir.call @_QPvunknown
subroutine test_vendor_unknown
call base_unknown()
end subroutine test_vendor_unknown
subroutine base_unknown
- !$omp declare variant (base_unknown:vsub) match (implementation={vendor("unknown")})
-contains
- subroutine vsub
- end subroutine
+ interface
+ subroutine vunknown()
+ end subroutine
+ end interface
+ !$omp declare variant (base_unknown:vunknown) match (implementation={vendor("unknown")})
end subroutine base_unknown
diff --git a/flang/test/Lower/OpenMP/declare-variant-module.f90 b/flang/test/Lower/OpenMP/declare-variant-module.f90
index aa75473a9582b..f4f592323ff78 100644
--- a/flang/test/Lower/OpenMP/declare-variant-module.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-module.f90
@@ -1,14 +1,18 @@
! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! The base and its variant are sibling module procedures, so the variant is
+! accessible at every reference to the base (here, in a sibling procedure of the
+! same module).
+
module m
contains
subroutine base
!$omp declare variant (base:vsub) match (construct={parallel})
- contains
- subroutine vsub
- end subroutine
end subroutine base
+ subroutine vsub
+ end subroutine vsub
+
subroutine caller
call base()
!$omp parallel
@@ -20,4 +24,4 @@ end module m
! CHECK-LABEL: func.func @_QMmPcaller
! CHECK: fir.call @_QMmPbase(){{.*}}: () -> ()
! CHECK: omp.parallel
-! CHECK: fir.call @_QMmFbasePvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QMmPvsub(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
index 45549cb7c444d..7cafbf4e3db81 100644
--- a/flang/test/Lower/OpenMP/declare-variant-target-device.f90
+++ b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
@@ -1,28 +1,31 @@
! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 \
! RUN: -fopenmp-is-target-device %s -o - | FileCheck %s
-subroutine base
- !$omp declare variant (base:vsub) match (device={kind(nohost)})
+module m
contains
+ subroutine base
+ !$omp declare variant (base:vsub) match (device={kind(nohost)})
+ end subroutine base
+
subroutine vsub
- end subroutine
-end subroutine base
+ end subroutine vsub
-subroutine device_caller
- !$omp declare target to(device_caller) device_type(nohost)
- call base()
-end subroutine device_caller
+ subroutine device_caller
+ !$omp declare target to(device_caller) device_type(nohost)
+ call base()
+ end subroutine device_caller
-subroutine target_region_caller
- !$omp target
- call base()
- !$omp end target
-end subroutine target_region_caller
+ subroutine target_region_caller
+ !$omp target
+ call base()
+ !$omp end target
+ end subroutine target_region_caller
+end module m
-! CHECK-LABEL: func.func @_QPdevice_caller
-! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
-! CHECK-NOT: fir.call @_QPbase
+! CHECK-LABEL: func.func @_QMmPdevice_caller
+! CHECK: fir.call @_QMmPvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QMmPbase
-! CHECK-LABEL: func.func @_QPtarget_region_caller
+! CHECK-LABEL: func.func @_QMmPtarget_region_caller
! CHECK: omp.target
-! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+! CHECK: fir.call @_QMmPvsub(){{.*}}: () -> ()
diff --git a/flang/test/Semantics/OpenMP/declare-variant.f90 b/flang/test/Semantics/OpenMP/declare-variant.f90
index 52e8d14a4c200..f47ce1219d2a9 100644
--- a/flang/test/Semantics/OpenMP/declare-variant.f90
+++ b/flang/test/Semantics/OpenMP/declare-variant.f90
@@ -96,14 +96,45 @@ real function fvar(x)
! When the base name is omitted, the enclosing procedure is the base
-subroutine incompatible_omitted_base(x)
- integer :: x
-!ERROR: The variant procedure 'vsub' is not compatible with the base procedure 'incompatible_omitted_base': distinct numbers of dummy arguments
- !$omp declare variant (vsub) match (construct={parallel})
+module omitted_base
contains
+ subroutine incompatible_omitted_base(x)
+ integer :: x
+!ERROR: The variant procedure 'vsub' is not compatible with the base procedure 'incompatible_omitted_base': distinct numbers of dummy arguments
+ !$omp declare variant (vsub) match (construct={parallel})
+ end subroutine
subroutine vsub(x, y)
integer :: x, y
end subroutine
+end module
+
+! A variant is substituted at every reference to the base, so it must be
+! accessible there. An internal procedure is only accessible within its host, so
+! it cannot be a variant of a base that is visible more widely. Here the base is
+! an external procedure but the variant is internal to it.
+
+subroutine external_base_internal_variant
+!ERROR: The variant procedure 'vsub' is an internal procedure and is not accessible at every reference to the base procedure 'external_base_internal_variant'
+ !$omp declare variant (vsub) match (construct={parallel})
+contains
+ subroutine vsub
+ end subroutine
+end subroutine
+
+! A module procedure may be the variant of an external base: it is accessible
+! anywhere the module is used.
+
+module module_variant_of_external
+contains
+ subroutine mvar(x)
+ integer :: x
+ end subroutine
+end module
+
+subroutine external_base_module_variant(x)
+ use module_variant_of_external
+ integer :: x
+ !$omp declare variant (external_base_module_variant:mvar) match (construct={parallel})
end subroutine
! Differing dummy argument names are fine; only characteristics matter.
>From 2c67f55a7974ef63ad1e41abcf41b54e0fc3754e Mon Sep 17 00:00:00 2001
From: Abid Qadeer <haqadeer at amd.com>
Date: Mon, 6 Jul 2026 11:50:07 +0100
Subject: [PATCH 3/3] Refactor code to make it cleaner.
---
flang/lib/Semantics/check-omp-variant.cpp | 16 ++++++++++------
1 file changed, 10 insertions(+), 6 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index 13b42f787ec74..22a0db39c2abc 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -646,6 +646,10 @@ void OmpStructureChecker::CheckDeclareVariantUserConditions(
}
}
+static bool IsProcedureOrFunction(const Symbol &symbol) {
+ return IsProcedure(symbol) || IsFunction(symbol);
+}
+
// OpenMP 6.0, 9.6 (declare_variant), Fortran restriction: "The characteristic
// of the function variant must be compatible with the characteristic of the
// base function after the implementation defined transformation for its OpenMP
@@ -726,7 +730,7 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
auto CheckProcedureSymbol{[&](const Symbol *sym, parser::CharBlock source) {
if (sym) {
- if (!IsProcedure(*sym) && !IsFunction(*sym)) {
+ if (!IsProcedureOrFunction(*sym)) {
auto &msg{context_.Say(source,
"The name '%s' should refer to a procedure"_err_en_US,
sym->name())};
@@ -772,11 +776,11 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
return;
}
- auto isProcedure{[](const Symbol *sym) {
- return sym && (IsProcedure(*sym) || IsFunction(*sym));
- }};
-
- if (isProcedure(base) && isProcedure(variant)) {
+ // Only validate and record the pairing when both names resolve to procedures.
+ // Otherwise a diagnostic was already issued (see CheckProcedureSymbol), and
+ // proceeding would emit spurious follow-on errors.
+ if (base && variant && IsProcedureOrFunction(*base) &&
+ IsProcedureOrFunction(*variant)) {
base = &base->GetUltimate();
variant = &variant->GetUltimate();
if (base == variant) {
More information about the flang-commits
mailing list