[flang-commits] [flang] [flang][OpenMP] Support for nocontext and novariants clauses for dispatch construct (PR #227954)
via flang-commits
flang-commits at lists.llvm.org
Wed Oct 7 09:48:25 PDT 2026
https://github.com/SunilKuravinakop updated https://github.com/llvm/llvm-project/pull/227954
>From cd6fcccfb8425766b679266a0263b5972b6c5040 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Tue, 22 Sep 2026 05:07:53 -0500
Subject: [PATCH 01/12] Support for omp dispatch and omp dispatch nowait in
flang.
---
flang/lib/Lower/OpenMP/OpenMP.cpp | 49 ++++++++++++++++++++--
flang/lib/Semantics/rewrite-parse-tree.cpp | 5 +++
flang/test/Lower/OpenMP/Todo/dispatch.f90 | 40 ++++++++++++++----
flang/test/Lower/OpenMP/dispatch.f90 | 39 +++++++++++++++++
flang/test/Semantics/OpenMP/simd-only.f90 | 12 ++++++
5 files changed, 135 insertions(+), 10 deletions(-)
create mode 100644 flang/test/Lower/OpenMP/dispatch.f90
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index df14d13b76a4b..a815cb2298719 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -2408,6 +2408,18 @@ static void genDistributeClauses(lower::AbstractConverter &converter,
cp.processOrder(clauseOps);
}
+static void genDispatchClauses(lower::AbstractConverter &converter,
+ semantics::SemanticsContext &semaCtx,
+ lower::StatementContext &stmtCtx,
+ const List<Clause> &clauses, mlir::Location loc,
+ mlir::omp::DispatchOperands &clauseOps) {
+ ClauseProcessor cp(converter, semaCtx, clauses);
+ cp.processNowait(clauseOps);
+ cp.processTODO<clause::Depend, clause::Device, clause::IsDevicePtr,
+ clause::Novariants, clause::Nocontext>(
+ loc, llvm::omp::Directive::OMPD_dispatch);
+}
+
static void genFlushClauses(lower::AbstractConverter &converter,
semantics::SemanticsContext &semaCtx,
const ObjectList &objects,
@@ -2981,6 +2993,21 @@ genCriticalOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
queue, item, nameAttr);
}
+static mlir::omp::DispatchOp genDispatchOp(
+ lower::AbstractConverter &converter, lower::SymMap &symTable,
+ lower::StatementContext &stmtCtx, semantics::SemanticsContext &semaCtx,
+ lower::pft::Evaluation &eval, mlir::Location loc,
+ const ConstructQueue &queue, ConstructQueue::const_iterator item) {
+ mlir::omp::DispatchOperands clauseOps;
+ genDispatchClauses(converter, semaCtx, stmtCtx, item->clauses, loc,
+ clauseOps);
+
+ return genOpWithBody<mlir::omp::DispatchOp>(
+ OpWithBodyGenInfo(converter, symTable, semaCtx, loc, eval,
+ llvm::omp::Directive::OMPD_dispatch),
+ queue, item, clauseOps);
+}
+
static mlir::omp::FlushOp
genFlushOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
@@ -5731,6 +5758,10 @@ genOMPDispatch(lower::AbstractConverter &converter, lower::SymMap &symTable,
case llvm::omp::Directive::OMPD_barrier:
newOp = genBarrierOp(converter, symTable, semaCtx, eval, loc, queue, item);
break;
+ case llvm::omp::Directive::OMPD_dispatch:
+ newOp = genDispatchOp(converter, symTable, stmtCtx, semaCtx, eval, loc,
+ queue, item);
+ break;
case llvm::omp::Directive::OMPD_distribute:
newOp = genStandaloneDistribute(converter, symTable, stmtCtx, semaCtx, eval,
loc, queue, item);
@@ -8385,9 +8416,21 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx,
lower::pft::Evaluation &eval,
- const parser::OpenMPDispatchConstruct &) {
- if (!semaCtx.langOptions().OpenMPSimd)
- TODO(converter.getCurrentLocation(), "OpenMPDispatchConstruct");
+ const parser::OpenMPDispatchConstruct &dispatchConstruct) {
+ const parser::OmpDirectiveSpecification &beginSpec =
+ dispatchConstruct.BeginDir();
+ List<Clause> clauses = makeClauses(beginSpec.Clauses(), semaCtx);
+ if (auto &endSpec = dispatchConstruct.EndDir())
+ clauses.append(makeClauses(endSpec->Clauses(), semaCtx));
+
+ llvm::omp::Directive directive = beginSpec.DirId();
+ mlir::Location currentLocation = converter.genLocation(beginSpec.source);
+
+ ConstructQueue queue{
+ buildConstructQueue(converter.getFirOpBuilder().getModule(), semaCtx,
+ eval, beginSpec.source, directive, clauses)};
+ genOMPDispatch(converter, symTable, semaCtx, eval, currentLocation, queue,
+ queue.begin());
}
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp
index a554bb61a68fb..9eb2e8fd8ec8f 100644
--- a/flang/lib/Semantics/rewrite-parse-tree.cpp
+++ b/flang/lib/Semantics/rewrite-parse-tree.cpp
@@ -193,6 +193,11 @@ void RewriteMutator::OpenMPSimdOnly(
&omp->value().u)}) {
it = replaceInlineBlock(std::get<parser::Block>(ompBlock->t), it);
continue;
+ } else if (auto *ompDispatch{
+ std::get_if<parser::OpenMPDispatchConstruct>(
+ &omp->value().u)}) {
+ it = replaceInlineBlock(std::get<parser::Block>(ompDispatch->t), it);
+ continue;
} else if (auto *ompLoop{std::get_if<parser::OpenMPLoopConstruct>(
&omp->value().u)}) {
if (LoopConstructIsSIMD(ompLoop)) {
diff --git a/flang/test/Lower/OpenMP/Todo/dispatch.f90 b/flang/test/Lower/OpenMP/Todo/dispatch.f90
index 380dfa14eaae1..160ab22c20b9b 100644
--- a/flang/test/Lower/OpenMP/Todo/dispatch.f90
+++ b/flang/test/Lower/OpenMP/Todo/dispatch.f90
@@ -1,12 +1,38 @@
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DDEPEND -o - %s 2>&1 | FileCheck %s --check-prefix=DEPEND
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DDEVICE -o - %s 2>&1 | FileCheck %s --check-prefix=DEVICE
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DIS_DEVICE_PTR -o - %s 2>&1 | FileCheck %s --check-prefix=IS_DEVICE_PTR
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DNOVARIANTS -o - %s 2>&1 | FileCheck %s --check-prefix=NOVARIANTS
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DNOCONTEXT -o - %s 2>&1 | FileCheck %s --check-prefix=NOCONTEXT
-! CHECK: not yet implemented: OpenMPDispatchConstruct
-program p
- integer r
- r = 1
-!$omp dispatch nowait
+! DEPEND: not yet implemented: Unhandled clause DEPEND in DISPATCH construct
+! DEVICE: not yet implemented: Unhandled clause DEVICE in DISPATCH construct
+! IS_DEVICE_PTR: not yet implemented: Unhandled clause IS_DEVICE_PTR in DISPATCH construct
+! NOVARIANTS: not yet implemented: Unhandled clause NOVARIANTS in DISPATCH construct
+! NOCONTEXT: not yet implemented: Unhandled clause NOCONTEXT in DISPATCH construct
+
+subroutine sub()
+#ifdef IS_DEVICE_PTR
+ use iso_c_binding
+ type(c_ptr) :: x
+#endif
+ integer :: r
+#ifdef DEPEND
+!$omp dispatch depend(inout: r)
+#endif
+#ifdef DEVICE
+!$omp dispatch device(0)
+#endif
+#ifdef IS_DEVICE_PTR
+!$omp dispatch is_device_ptr(x)
+#endif
+#ifdef NOVARIANTS
+!$omp dispatch novariants(.true.)
+#endif
+#ifdef NOCONTEXT
+!$omp dispatch nocontext(.true.)
+#endif
call foo()
contains
subroutine foo
end subroutine
-end program p
+end subroutine sub
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
new file mode 100644
index 0000000000000..d1a437be5664b
--- /dev/null
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -0,0 +1,39 @@
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s --check-prefix=HLFIR
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=52 %s -o - | FileCheck %s --check-prefix=HLFIR
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=60 %s -o - | FileCheck %s --check-prefix=HLFIR
+
+! Dispatch lowers to a no-op omp.dispatch region wrapping the associated call.
+! Variant selection and the nocontext/novariants clauses are added separately;
+! here the call inside the region targets the base procedure unchanged.
+
+module funcs
+ implicit none
+
+contains
+
+ !HLFIR-LABEL: func @_QMfuncsPfoo_dispatch
+ subroutine foo_dispatch()
+ print *, "in foo_dispatch"
+ end subroutine
+
+end module funcs
+
+!HLFIR-LABEL: func @_QQmain
+program dispatch_test
+ use funcs
+ implicit none
+
+ !HLFIR: omp.dispatch {
+ !$omp dispatch
+ !HLFIR: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ call foo_dispatch()
+ !HLFIR: omp.terminator
+ !HLFIR: }
+
+ !HLFIR: omp.dispatch nowait {
+ !$omp dispatch nowait
+ !HLFIR: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ call foo_dispatch()
+ !HLFIR: omp.terminator
+ !HLFIR: }
+end program
diff --git a/flang/test/Semantics/OpenMP/simd-only.f90 b/flang/test/Semantics/OpenMP/simd-only.f90
index 01370af0a00a7..860befaf43247 100644
--- a/flang/test/Semantics/OpenMP/simd-only.f90
+++ b/flang/test/Semantics/OpenMP/simd-only.f90
@@ -414,3 +414,15 @@ module test_declare_mapper
! CHECK-NOT: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpDeclareMapperDirective
!$omp declare mapper(myvec_t :: v) map(v, v%data(1:v%len))
end module
+
+! CHECK-LABEL: Name = 'test_dispatch'
+subroutine test_dispatch()
+ ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDispatchConstruct
+ ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = dispatch
+ ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> CallStmt
+ !$omp dispatch
+ call foo()
+contains
+ subroutine foo()
+ end subroutine
+end subroutine
>From 8a8f8d94d9e8c62878e557b67194b6dd270ab6e0 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Sat, 26 Sep 2026 02:13:00 -0500
Subject: [PATCH 02/12] Initial Support for novariants and nocontext clauses in
dispatch construct (OpenMP) in flang.
---
flang/include/flang/Lower/OpenMP.h | 17 +-
flang/lib/Lower/ConvertCall.cpp | 62 +++++++
flang/lib/Lower/OpenMP/ClauseProcessor.cpp | 34 ++++
flang/lib/Lower/OpenMP/ClauseProcessor.h | 4 +
flang/lib/Lower/OpenMP/OpenMP.cpp | 5 +-
flang/lib/Lower/OpenMP/Utils.cpp | 39 ++++-
flang/lib/Lower/OpenMP/Utils.h | 7 +-
flang/test/Fir/OpenMP/dispatch.fir | 145 ++++++++++++++++
flang/test/Integration/OpenMP/dispatch.f90 | 192 +++++++++++++++++++++
flang/test/Lower/OpenMP/Todo/dispatch.f90 | 10 --
flang/test/Lower/OpenMP/dispatch.f90 | 186 +++++++++++++++++++-
flang/test/Semantics/OpenMP/dispatch.f90 | 50 ++++++
12 files changed, 724 insertions(+), 27 deletions(-)
create mode 100644 flang/test/Fir/OpenMP/dispatch.fir
create mode 100644 flang/test/Integration/OpenMP/dispatch.f90
diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h
index 863a4ebc897d4..a21cc4be0f6d3 100644
--- a/flang/include/flang/Lower/OpenMP.h
+++ b/flang/include/flang/Lower/OpenMP.h
@@ -22,6 +22,8 @@ namespace mlir {
class Operation;
class Location;
class Type;
+class Value;
+class OpBuilder;
namespace omp {
enum class DeclareTargetDeviceType : uint32_t;
enum class DeclareTargetCaptureClause : uint32_t;
@@ -115,10 +117,21 @@ void markOpenMPImportedDeclareTargets(
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.
+/// \p base is expected to have variant entries. When \p excludeDispatchContext
+/// is set, the innermost enclosing `dispatch` construct is removed from the
+/// context before matching, implementing the `nocontext` clause.
const Fortran::semantics::Symbol *
resolveDeclareVariantCallee(const Fortran::semantics::Symbol &base,
- AbstractConverter &converter);
+ AbstractConverter &converter,
+ bool excludeDispatchContext = false);
+
+/// Return the i1 `novariants` value of an enclosing `omp.dispatch`, or a null
+/// Value if there is none.
+mlir::Value getEnclosingDispatchNovariants(mlir::OpBuilder &builder);
+
+/// Return the i1 `nocontext` value of an enclosing `omp.dispatch`, or a null
+/// Value if there is none.
+mlir::Value getEnclosingDispatchNocontext(mlir::OpBuilder &builder);
} // namespace omp
// Materialize (idempotently) the omp.declare_reduction op for one already-
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 8c70c8145b820..eef88028df91c 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -18,6 +18,7 @@
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/CustomIntrinsicCall.h"
#include "flang/Lower/HlfirIntrinsics.h"
+#include "flang/Lower/OpenMP.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
@@ -35,6 +36,7 @@
#include "flang/Optimizer/Dialect/CUF/CUFOps.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "mlir/Dialect/Arith/IR/Arith.h"
#include "mlir/IR/IRMapping.h"
#include "llvm/ADT/TypeSwitch.h"
#include "llvm/Support/CommandLine.h"
@@ -578,6 +580,66 @@ Fortran::lower::genCallOpAndResult(
funcType = *modifiedFuncType;
}
+ // OpenMP dispatch `novariants`/`nocontext`: at runtime pick the right target
+ // via an indirect call, evaluating arguments once. All candidate procedures
+ // share one signature; revisit if declare-variant `adjust_args`/`append_args`
+ // land.
+ if (funcSymbolAttr) {
+ mlir::Value novariantsCond =
+ Fortran::lower::omp::getEnclosingDispatchNovariants(builder);
+ mlir::Value nocontextCond =
+ Fortran::lower::omp::getEnclosingDispatchNocontext(builder);
+ const Fortran::semantics::Symbol *baseSym =
+ caller.getCallDescription().proc().GetSymbol();
+ const Fortran::semantics::Symbol *selectedSym = caller.getProcedureSymbol();
+ // A runtime choice is only needed when a variant was actually selected for
+ // the enclosing dispatch context (otherwise the base is already the call
+ // target and dropping the dispatch construct cannot introduce a variant).
+ if ((novariantsCond || nocontextCond) && baseSym && selectedSym &&
+ &baseSym->GetUltimate() != &selectedSym->GetUltimate()) {
+ const Fortran::semantics::Symbol &baseUlt = baseSym->GetUltimate();
+ const Fortran::semantics::Symbol &selectedUlt =
+ selectedSym->GetUltimate();
+
+ auto addrOfSym =
+ [&](const Fortran::semantics::Symbol &sym) -> mlir::Value {
+ mlir::func::FuncOp func = Fortran::lower::getOrDeclareFunction(
+ Fortran::evaluate::ProcedureDesignator{sym}, converter);
+ mlir::Value address =
+ fir::AddrOfOp::create(builder, loc, func.getFunctionType(),
+ builder.getSymbolRefAttr(func.getSymName()));
+ return builder.createConvert(loc, funcType, address);
+ };
+
+ // Start from the variant selected with the dispatch construct in context.
+ mlir::Value target =
+ fir::AddrOfOp::create(builder, loc, funcType, funcSymbolAttr);
+
+ // `nocontext(true)`: re-select the variant with the dispatch construct
+ // removed from the OpenMP context. That may resolve to a different
+ // variant (e.g. one matching `device={kind(host)}`) or to the base
+ // procedure.
+ if (nocontextCond) {
+ const Fortran::semantics::Symbol *nocontextSym =
+ Fortran::lower::omp::resolveDeclareVariantCallee(
+ baseUlt, converter, /*excludeDispatchContext=*/true);
+ const Fortran::semantics::Symbol &nocontextUlt =
+ nocontextSym ? nocontextSym->GetUltimate() : baseUlt;
+ if (&nocontextUlt != &selectedUlt)
+ target = mlir::arith::SelectOp::create(
+ builder, loc, nocontextCond, addrOfSym(nocontextUlt), target);
+ }
+
+ // `novariants(true)` takes final precedence: always call the base.
+ if (novariantsCond)
+ target = mlir::arith::SelectOp::create(builder, loc, novariantsCond,
+ addrOfSym(baseUlt), target);
+
+ funcPointer = target;
+ funcSymbolAttr = {}; // Mark as an indirect call.
+ }
+ }
+
llvm::SmallVector<mlir::Value> operands;
// First operand of indirect call is the function pointer. Cast it to
// required function type for the call to handle procedures that have a
diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
index b871f630d3dae..e5a5a479cf6c9 100644
--- a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
+++ b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
@@ -717,6 +717,40 @@ bool ClauseProcessor::processNogroup(
return markClauseOccurrence<omp::clause::Nogroup>(result.nogroup);
}
+bool ClauseProcessor::processNocontext(
+ lower::StatementContext &stmtCtx,
+ mlir::omp::NocontextClauseOps &result) const {
+ const parser::CharBlock *source = nullptr;
+ if (auto *clause = findUniqueClause<omp::clause::Nocontext>(&source)) {
+ fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+ mlir::Location clauseLocation = converter.genLocation(*source);
+
+ mlir::Value nocontextVal =
+ fir::getBase(converter.genExprValue(clause->v, stmtCtx));
+ result.nocontext = firOpBuilder.createConvert(
+ clauseLocation, firOpBuilder.getI1Type(), nocontextVal);
+ return true;
+ }
+ return false;
+}
+
+bool ClauseProcessor::processNovariants(
+ lower::StatementContext &stmtCtx,
+ mlir::omp::NovariantsClauseOps &result) const {
+ const parser::CharBlock *source = nullptr;
+ if (auto *clause = findUniqueClause<omp::clause::Novariants>(&source)) {
+ fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
+ mlir::Location clauseLocation = converter.genLocation(*source);
+
+ mlir::Value novariantsVal =
+ fir::getBase(converter.genExprValue(clause->v, stmtCtx));
+ result.novariants = firOpBuilder.createConvert(
+ clauseLocation, firOpBuilder.getI1Type(), novariantsVal);
+ return true;
+ }
+ return false;
+}
+
bool ClauseProcessor::processNowait(mlir::omp::NowaitClauseOps &result) const {
return markClauseOccurrence<omp::clause::Nowait>(result.nowait);
}
diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.h b/flang/lib/Lower/OpenMP/ClauseProcessor.h
index 6b0e0cf606f48..02149a48b0638 100644
--- a/flang/lib/Lower/OpenMP/ClauseProcessor.h
+++ b/flang/lib/Lower/OpenMP/ClauseProcessor.h
@@ -102,6 +102,10 @@ class ClauseProcessor {
bool processMergeable(mlir::omp::MergeableClauseOps &result) const;
bool processNogroup(mlir::omp::NogroupClauseOps &result) const;
bool processNotinbranch(mlir::omp::NotinbranchClauseOps &result) const;
+ bool processNocontext(lower::StatementContext &stmtCtx,
+ mlir::omp::NocontextClauseOps &result) const;
+ bool processNovariants(lower::StatementContext &stmtCtx,
+ mlir::omp::NovariantsClauseOps &result) const;
bool processNowait(mlir::omp::NowaitClauseOps &result) const;
bool processNumTasks(lower::StatementContext &stmtCtx,
mlir::omp::NumTasksClauseOps &result) const;
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index a815cb2298719..dc88184c7663e 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -2414,9 +2414,10 @@ static void genDispatchClauses(lower::AbstractConverter &converter,
const List<Clause> &clauses, mlir::Location loc,
mlir::omp::DispatchOperands &clauseOps) {
ClauseProcessor cp(converter, semaCtx, clauses);
+ cp.processNocontext(stmtCtx, clauseOps);
+ cp.processNovariants(stmtCtx, clauseOps);
cp.processNowait(clauseOps);
- cp.processTODO<clause::Depend, clause::Device, clause::IsDevicePtr,
- clause::Novariants, clause::Nocontext>(
+ cp.processTODO<clause::Depend, clause::Device, clause::IsDevicePtr>(
loc, llvm::omp::Directive::OMPD_dispatch);
}
diff --git a/flang/lib/Lower/OpenMP/Utils.cpp b/flang/lib/Lower/OpenMP/Utils.cpp
index b52c03ff63fed..7b1bf0b67a8c6 100644
--- a/flang/lib/Lower/OpenMP/Utils.cpp
+++ b/flang/lib/Lower/OpenMP/Utils.cpp
@@ -1474,15 +1474,29 @@ semantics::omp::OmpVariantMatchContext makeVariantMatchContext(
void collectEnclosingConstructTraits(
mlir::Operation *op,
- llvm::SmallVectorImpl<llvm::omp::TraitProperty> &constructTraits) {
+ llvm::SmallVectorImpl<llvm::omp::TraitProperty> &constructTraits,
+ bool excludeNearestDispatch) {
// Collect enclosing OpenMP operations so variants chosen by an outer
// metadirective are part of this metadirective's context. For example, an
// inner metadirective inside `target` and an outer-selected `parallel` must
// be able to match construct={target, parallel}. The final reverse yields
// outermost-to-innermost order as required by OMPContext.
+ //
+ // When \p excludeNearestDispatch is set, the innermost enclosing `dispatch`
+ // construct is left out of the trait set. This implements the `nocontext`
+ // clause, which removes its own dispatch construct from the OpenMP context
+ // used for variant selection.
+ bool skippedDispatch = false;
for (; op; op = op->getParentOp()) {
if (mlir::isa<mlir::omp::WsloopOp>(op))
constructTraits.push_back(llvm::omp::TraitProperty::construct_for_for);
+ if (mlir::isa<mlir::omp::DispatchOp>(op)) {
+ if (excludeNearestDispatch && !skippedDispatch)
+ skippedDispatch = true;
+ else
+ constructTraits.push_back(
+ llvm::omp::TraitProperty::construct_dispatch_dispatch);
+ }
if (mlir::isa<mlir::omp::ParallelOp>(op))
constructTraits.push_back(
llvm::omp::TraitProperty::construct_parallel_parallel);
@@ -1498,7 +1512,8 @@ void collectEnclosingConstructTraits(
const semantics::Symbol *
resolveDeclareVariantCallee(const semantics::Symbol &base,
- AbstractConverter &converter) {
+ AbstractConverter &converter,
+ bool excludeDispatchContext) {
const semantics::Symbol &ultimate{base.GetUltimate()};
const auto *details{ultimate.detailsIf<semantics::SubprogramDetails>()};
@@ -1539,7 +1554,7 @@ resolveDeclareVariantCallee(const semantics::Symbol &base,
llvm::SmallVector<llvm::omp::TraitProperty, 8> constructTraits;
collectEnclosingConstructTraits(
converter.getFirOpBuilder().getInsertionBlock()->getParentOp(),
- constructTraits);
+ constructTraits, excludeDispatchContext);
semantics::omp::OmpVariantMatchContext ompCtx =
makeVariantMatchContext(converter.getModuleOp(), constructTraits);
@@ -1551,6 +1566,24 @@ resolveDeclareVariantCallee(const semantics::Symbol &base,
return variants[bestIdx];
}
+mlir::Value getEnclosingDispatchNovariants(mlir::OpBuilder &builder) {
+ mlir::Block *block = builder.getInsertionBlock();
+ for (mlir::Operation *op = block ? block->getParentOp() : nullptr; op;
+ op = op->getParentOp())
+ if (auto dispatch = mlir::dyn_cast<mlir::omp::DispatchOp>(op))
+ return dispatch.getNovariants();
+ return {};
+}
+
+mlir::Value getEnclosingDispatchNocontext(mlir::OpBuilder &builder) {
+ mlir::Block *block = builder.getInsertionBlock();
+ for (mlir::Operation *op = block ? block->getParentOp() : nullptr; op;
+ op = op->getParentOp())
+ if (auto dispatch = mlir::dyn_cast<mlir::omp::DispatchOp>(op))
+ return dispatch.getNocontext();
+ return {};
+}
+
} // namespace omp
} // namespace lower
} // namespace Fortran
diff --git a/flang/lib/Lower/OpenMP/Utils.h b/flang/lib/Lower/OpenMP/Utils.h
index 7fde1825b006a..f1f9643e54cbe 100644
--- a/flang/lib/Lower/OpenMP/Utils.h
+++ b/flang/lib/Lower/OpenMP/Utils.h
@@ -265,10 +265,13 @@ std::optional<llvm::SmallVector<mlir::Value>> getIteratorElementIndices(
/// Walk the already-emitted MLIR parent operations starting from \p op and
/// collect the implied OpenMP construct traits in outermost-to-innermost
/// order. Used by metadirective lowering and declare-variant call resolution
-/// to build the `ConstructTraits` of an `OMPContext`.
+/// to build the `ConstructTraits` of an `OMPContext`. When
+/// \p excludeNearestDispatch is set, the innermost enclosing `dispatch`
+/// construct is omitted (used to implement the `nocontext` clause).
void collectEnclosingConstructTraits(
mlir::Operation *op,
- llvm::SmallVectorImpl<llvm::omp::TraitProperty> &constructTraits);
+ llvm::SmallVectorImpl<llvm::omp::TraitProperty> &constructTraits,
+ bool excludeNearestDispatch = false);
/// Return true when \p module is being compiled for an AMDGPU device or all of
/// its offload targets are AMDGPU devices.
diff --git a/flang/test/Fir/OpenMP/dispatch.fir b/flang/test/Fir/OpenMP/dispatch.fir
new file mode 100644
index 0000000000000..6e5670dd461f3
--- /dev/null
+++ b/flang/test/Fir/OpenMP/dispatch.fir
@@ -0,0 +1,145 @@
+// RUN: fir-opt %s | FileCheck %s
+
+module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array<i32: 8, 16, 32, 64>, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", fir.relocation_model = 1 : i32, llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 24.0.0 (https://github.com/SunilKuravinakop/llvm-project.git 665c356fed252c9f65f99e7609997822e0e0a908)", llvm.target_triple = "x86_64-unknown-linux-gnu", omp.flags = #omp.flags<openmp_device_version = 31>, omp.is_gpu = false, omp.is_target_device = false, omp.target_triples = [], omp.version = #omp.version<version = 31>} {
+ // CHECK-LABEL: func.func @_QMfuncsPfoo_variant
+ func.func @_QMfuncsPfoo_variant() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c6_i32 = arith.constant 6 : i32
+ %1 = fir.address_of(@_QQclXa0e1d7990b4b8f5533e92e3c2cc80a5d) : !fir.ref<!fir.char<1,89>>
+ %2 = fir.convert %1 : (!fir.ref<!fir.char<1,89>>) -> !fir.ref<i8>
+ %c35_i32 = arith.constant 35 : i32
+ %3 = fir.call @_FortranAioBeginExternalListOutput(%c6_i32, %2, %c35_i32) fastmath<contract> : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ %4 = fir.address_of(@_QQclX696E20666F6F5F76617269616E74) : !fir.ref<!fir.char<1,14>>
+ %c14 = arith.constant 14 : index
+ %5:2 = hlfir.declare %4 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX696E20666F6F5F76617269616E74"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
+ %6 = fir.convert %5#0 : (!fir.ref<!fir.char<1,14>>) -> !fir.ref<i8>
+ %7 = fir.convert %c14 : (index) -> i64
+ %8 = fir.call @_FortranAioOutputAscii(%3, %6, %7) fastmath<contract> : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+ %9 = fir.call @_FortranAioEndIoStatement(%3) fastmath<contract> : (!fir.ref<i8>) -> i32
+ return
+ }
+ // CHECK-LABEL: func.func @_QMfuncsPfoo_dispatch
+ func.func @_QMfuncsPfoo_dispatch() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %c6_i32 = arith.constant 6 : i32
+ %1 = fir.address_of(@_QQclXa0e1d7990b4b8f5533e92e3c2cc80a5d) : !fir.ref<!fir.char<1,89>>
+ %2 = fir.convert %1 : (!fir.ref<!fir.char<1,89>>) -> !fir.ref<i8>
+ %c40_i32 = arith.constant 40 : i32
+ %3 = fir.call @_FortranAioBeginExternalListOutput(%c6_i32, %2, %c40_i32) fastmath<contract> : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ %4 = fir.address_of(@_QQclX696E20666F6F5F6469737061746368) : !fir.ref<!fir.char<1,15>>
+ %c15 = arith.constant 15 : index
+ %5:2 = hlfir.declare %4 typeparams %c15 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX696E20666F6F5F6469737061746368"} : (!fir.ref<!fir.char<1,15>>, index) -> (!fir.ref<!fir.char<1,15>>, !fir.ref<!fir.char<1,15>>)
+ %6 = fir.convert %5#0 : (!fir.ref<!fir.char<1,15>>) -> !fir.ref<i8>
+ %7 = fir.convert %c15 : (index) -> i64
+ %8 = fir.call @_FortranAioOutputAscii(%3, %6, %7) fastmath<contract> : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+ %9 = fir.call @_FortranAioEndIoStatement(%3) fastmath<contract> : (!fir.ref<i8>) -> i32
+ return
+ }
+ // CHECK-LABEL: func.func @_QQmain
+ func.func @_QQmain() attributes {fir.bindc_name = "DISPATCH_TEST"} {
+ %0 = fir.dummy_scope : !fir.dscope
+ // CHECK: fir.call @_QMfuncsPfoo_dispatch()
+ fir.call @_QMfuncsPfoo_dispatch() fastmath<contract> : () -> ()
+ // CHECK: omp.dispatch {
+ omp.dispatch {
+ // CHECK: fir.call @_QMfuncsPfoo_variant()
+ fir.call @_QMfuncsPfoo_variant() fastmath<contract> : () -> ()
+ // CHECK: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ // CHECK-LABEL: func.func @omp_dispatch_nowait
+ func.func @omp_dispatch_nowait() {
+ // CHECK: omp.dispatch nowait {
+ omp.dispatch nowait {
+ // CHECK: fir.call @_QMfuncsPfoo_variant()
+ fir.call @_QMfuncsPfoo_variant() fastmath<contract> : () -> ()
+ // CHECK: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ // novariants: runtime select of base/variant address, then indirect call.
+ // CHECK-LABEL: func.func @omp_dispatch_novariants
+ func.func @omp_dispatch_novariants(%cond : i1) {
+ // CHECK: omp.dispatch novariants(%[[COND:.*]]) {
+ omp.dispatch novariants(%cond) {
+ // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ %variant = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ // CHECK: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ %base = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[BASE]], %[[VARIANT]] : () -> ()
+ %target = arith.select %cond, %base, %variant : () -> ()
+ // CHECK: fir.call %[[TARGET]]()
+ fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ // nocontext: runtime select of base/variant address, then indirect call.
+ // CHECK-LABEL: func.func @omp_dispatch_nocontext
+ func.func @omp_dispatch_nocontext(%cond : i1) {
+ // CHECK: omp.dispatch nocontext(%[[COND:.*]]) {
+ omp.dispatch nocontext(%cond) {
+ // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ %variant = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ // CHECK: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ %base = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[BASE]], %[[VARIANT]] : () -> ()
+ %target = arith.select %cond, %base, %variant : () -> ()
+ // CHECK: fir.call %[[TARGET]]()
+ fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ // nocontext with multiple matching variants: the frontend re-resolves variant
+ // selection with the dispatch construct removed, so the runtime select picks
+ // between the two variants (device={kind(host)} vs construct={dispatch}),
+ // not the base procedure.
+ // CHECK-LABEL: func.func @omp_dispatch_nocontext_variant
+ func.func @omp_dispatch_nocontext_variant(%cond : i1) {
+ // CHECK: omp.dispatch nocontext(%[[COND:.*]]) {
+ omp.dispatch nocontext(%cond) {
+ // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ %variant = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ // CHECK: %[[HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ %host = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[HOST]], %[[VARIANT]] : () -> ()
+ %target = arith.select %cond, %host, %variant : () -> ()
+ // CHECK: fir.call %[[TARGET]]()
+ fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ // CHECK-LABEL: func.func @omp_dispatch_novariants_nocontext(
+ // CHECK-SAME: %[[C1:[^:]+]]: i1, %[[C2:[^:]+]]: i1)
+ func.func @omp_dispatch_novariants_nocontext(%c1 : i1, %c2 : i1) {
+ // CHECK: omp.dispatch nocontext(%[[C2]]) novariants(%[[C1]]) {
+ omp.dispatch nocontext(%c2) novariants(%c1) {
+ // CHECK: %[[BOTH_VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ %variant = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ // CHECK: %[[BOTH_HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ %host = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ // CHECK: %[[CONTEXT_TARGET:.*]] = arith.select %[[C2]], %[[BOTH_HOST]], %[[BOTH_VARIANT]] : () -> ()
+ %context_target = arith.select %c2, %host, %variant : () -> ()
+ // CHECK: %[[BOTH_BASE:.*]] = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
+ %base = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
+ // CHECK: %[[BOTH_TARGET:.*]] = arith.select %[[C1]], %[[BOTH_BASE]], %[[CONTEXT_TARGET]] : () -> ()
+ %target = arith.select %c1, %base, %context_target : () -> ()
+ // CHECK-NEXT: fir.call %[[BOTH_TARGET]]()
+ fir.call %target() fastmath<contract> : () -> ()
+ // CHECK-NEXT: omp.terminator
+ omp.terminator
+ }
+ return
+ }
+ func.func private @_QMfuncsPdispatch_variant()
+ func.func private @_QMfuncsPhost_variant()
+ func.func private @_QMfuncsPbase_routine()
+}
diff --git a/flang/test/Integration/OpenMP/dispatch.f90 b/flang/test/Integration/OpenMP/dispatch.f90
new file mode 100644
index 0000000000000..202ceeaec850a
--- /dev/null
+++ b/flang/test/Integration/OpenMP/dispatch.f90
@@ -0,0 +1,192 @@
+!===----------------------------------------------------------------------===!
+! This directory can be used to add Integration tests involving multiple
+! stages of the compiler (for eg. from Fortran to LLVM IR). It should not
+! contain executable tests. We should only add tests here sparingly and only
+! if there is no other way to test. Repeat this message in each test that is
+! added to this directory and sub-directories.
+!===----------------------------------------------------------------------===!
+
+!RUN: %flang_fc1 -emit-llvm -fopenmp -fopenmp-version=52 %s -o - | FileCheck %s
+
+!CHECK-LABEL: define void @_QMfuncsPfoo_variant()
+!CHECK: call ptr @_FortranAioBeginExternalListOutput
+
+!CHECK-LABEL: define void @_QMfuncsPfoo_dispatch()
+!CHECK: call ptr @_FortranAioBeginExternalListOutput
+
+!CHECK-LABEL: define void @_QQmain()
+!CHECK: call void @_QMfuncsPfoo_dispatch()
+!CHECK: br label %omp.dispatch.region
+!CHECK: omp.dispatch.region:
+!CHECK: call void @_QMfuncsPfoo_variant()
+!CHECK: br label %omp.region.cont
+!CHECK: omp.region.cont:
+
+! novariants: runtime select of base/variant address, then indirect call.
+!CHECK-LABEL: define void @test_novariants_(
+!CHECK-SAME: ptr noalias %[[ARG:[0-9]+]])
+!CHECK: %[[LOAD:.*]] = load i32, ptr %[[ARG]], align 4
+!CHECK: %[[COND:.*]] = icmp ne i32 %[[LOAD]], 0
+!CHECK: br label %omp.dispatch.region
+!CHECK: omp.dispatch.region:
+!CHECK: %[[TARGET:.*]] = select i1 %[[COND]], ptr @_QMfuncsPfoo_dispatch, ptr @_QMfuncsPfoo_variant
+!CHECK: call void %[[TARGET]]()
+!CHECK: br label %omp.region.cont
+!CHECK: omp.region.cont:
+
+! nocontext: runtime select of base/variant address, then indirect call.
+!CHECK-LABEL: define void @test_nocontext_(
+!CHECK-SAME: ptr noalias %[[NARG:[0-9]+]])
+!CHECK: %[[NLOAD:.*]] = load i32, ptr %[[NARG]], align 4
+!CHECK: %[[NCOND:.*]] = icmp ne i32 %[[NLOAD]], 0
+!CHECK: br label %omp.dispatch.region
+!CHECK: omp.dispatch.region:
+!CHECK: %[[NTARGET:.*]] = select i1 %[[NCOND]], ptr @_QMfuncsPfoo_dispatch, ptr @_QMfuncsPfoo_variant
+!CHECK: call void %[[NTARGET]]()
+!CHECK: br label %omp.region.cont
+!CHECK: omp.region.cont:
+
+!CHECK-LABEL: define void @test_novariants_nocontext_(
+!CHECK-SAME: ptr noalias %[[C1_ARG:[0-9]+]], ptr noalias %[[C2_ARG:[0-9]+]])
+!CHECK: %[[C2_LOAD:.*]] = load i32, ptr %[[C2_ARG]], align 4
+!CHECK: %[[C2_COND:.*]] = icmp ne i32 %[[C2_LOAD]], 0
+!CHECK: %[[C1_LOAD:.*]] = load i32, ptr %[[C1_ARG]], align 4
+!CHECK: %[[C1_COND:.*]] = icmp ne i32 %[[C1_LOAD]], 0
+!CHECK: br label %omp.dispatch.region
+!CHECK: omp.dispatch.region:
+!CHECK: %[[CONTEXT_TARGET:.*]] = select i1 %[[C2_COND]], ptr @_QMfuncsPhost_variant, ptr @_QMfuncsPdispatch_variant
+!CHECK: %[[BOTH_TARGET:.*]] = select i1 %[[C1_COND]], ptr @_QMfuncsPbase_routine, ptr %[[CONTEXT_TARGET]]
+!CHECK-NEXT: call void %[[BOTH_TARGET]]()
+!CHECK-NEXT: br label %omp.region.cont
+!CHECK: omp.region.cont:
+
+module funcs
+ implicit none
+
+contains
+
+ subroutine foo_variant()
+ print *, "in foo_variant"
+ end subroutine
+
+ subroutine foo_dispatch()
+ !$omp declare variant(foo_dispatch:foo_variant) match(construct={dispatch})
+ print *, "in foo_dispatch"
+ end subroutine
+
+ subroutine dispatch_variant()
+ print *, "in dispatch_variant"
+ end subroutine
+
+ subroutine host_variant()
+ print *, "in host_variant"
+ end subroutine
+
+ subroutine base_routine()
+ !$omp declare variant(base_routine:dispatch_variant) match(construct={dispatch})
+ !$omp declare variant(base_routine:host_variant) match(device={kind(host)})
+ print *, "in base_routine"
+ end subroutine
+
+end module funcs
+
+program dispatch_test
+ use funcs
+ implicit none
+
+ call foo_dispatch()
+
+ !$omp dispatch
+ call foo_dispatch()
+
+end program
+
+subroutine test_novariants(cond)
+ use funcs
+ implicit none
+ logical :: cond
+
+ !$omp dispatch novariants(cond)
+ call foo_dispatch()
+
+end subroutine
+
+subroutine test_nocontext(cond)
+ use funcs
+ implicit none
+ logical :: cond
+
+ !$omp dispatch nocontext(cond)
+ call foo_dispatch()
+
+end subroutine
+
+subroutine test_novariants_nocontext(c1, c2)
+ use funcs
+ implicit none
+ logical :: c1, c2
+
+ !$omp dispatch novariants(c1) nocontext(c2)
+ call base_routine()
+
+end subroutine
+
+!CHECK-LABEL: define void @test_external_novariants_(
+!CHECK-SAME: ptr noalias %[[EXT_COND_ARG:[0-9]+]])
+!CHECK: %[[EXT_LOAD:.*]] = load i32, ptr %[[EXT_COND_ARG]], align 4
+!CHECK: %[[EXT_COND:.*]] = icmp ne i32 %[[EXT_LOAD]], 0
+!CHECK: %[[EXT_TARGET:.*]] = select i1 %[[EXT_COND]], ptr @external_base_, ptr @external_variant_
+!CHECK-NEXT: call void %[[EXT_TARGET]]()
+subroutine test_external_novariants(cond)
+ implicit none
+ logical :: cond
+ interface
+ subroutine external_variant()
+ end subroutine
+ subroutine external_base()
+ import :: external_variant
+ !$omp declare variant(external_base:external_variant) match(construct={dispatch})
+ end subroutine
+ end interface
+
+ !$omp dispatch novariants(cond)
+ call external_base()
+end subroutine
+
+!CHECK-LABEL: define i32 @test_external_nocontext_(
+!CHECK-SAME: ptr noalias %[[EXT_NCOND_ARG:[0-9]+]], ptr noalias %[[EXT_VALUE_ARG:[0-9]+]])
+!CHECK: %[[EXT_NLOAD:.*]] = load i32, ptr %[[EXT_NCOND_ARG]], align 4
+!CHECK: %[[EXT_NCOND:.*]] = icmp ne i32 %[[EXT_NLOAD]], 0
+!CHECK: %[[EXT_VALUE:.*]] = load i32, ptr %[[EXT_VALUE_ARG]], align 4
+!CHECK: %[[EXT_NTARGET:.*]] = select i1 %[[EXT_NCOND]], ptr @external_host_func_, ptr @external_dispatch_func_
+!CHECK-NEXT: %[[EXT_RESULT:.*]] = call i32 %[[EXT_NTARGET]](i32 %[[EXT_VALUE]])
+!CHECK: store i32 %[[EXT_RESULT]], ptr %[[EXT_RESULT_ADDR:.*]], align 4
+!CHECK: %[[EXT_RETURN:.*]] = load i32, ptr %[[EXT_RESULT_ADDR]], align 4
+!CHECK: ret i32 %[[EXT_RETURN]]
+integer function test_external_nocontext(cond, value) result(res)
+ implicit none
+ logical :: cond
+ integer :: value
+ interface
+ integer function external_dispatch_func(value)
+ integer, value :: value
+ end function
+ integer function external_host_func(value)
+ integer, value :: value
+ end function
+ integer function external_base_func(value) result(output)
+ import :: external_dispatch_func, external_host_func
+ integer, value :: value
+ !$omp declare variant(external_base_func:external_dispatch_func) match(construct={dispatch})
+ !$omp declare variant(external_base_func:external_host_func) match(device={kind(host)})
+ end function
+ end interface
+
+ !$omp dispatch nocontext(cond)
+ res = external_base_func(value)
+end function
+
+!CHECK-DAG: declare void @external_variant_()
+!CHECK-DAG: declare void @external_base_()
+!CHECK-DAG: declare i32 @external_dispatch_func_(i32)
+!CHECK-DAG: declare i32 @external_host_func_(i32)
diff --git a/flang/test/Lower/OpenMP/Todo/dispatch.f90 b/flang/test/Lower/OpenMP/Todo/dispatch.f90
index 160ab22c20b9b..ccf32f2dad193 100644
--- a/flang/test/Lower/OpenMP/Todo/dispatch.f90
+++ b/flang/test/Lower/OpenMP/Todo/dispatch.f90
@@ -1,14 +1,10 @@
! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DDEPEND -o - %s 2>&1 | FileCheck %s --check-prefix=DEPEND
! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DDEVICE -o - %s 2>&1 | FileCheck %s --check-prefix=DEVICE
! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DIS_DEVICE_PTR -o - %s 2>&1 | FileCheck %s --check-prefix=IS_DEVICE_PTR
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DNOVARIANTS -o - %s 2>&1 | FileCheck %s --check-prefix=NOVARIANTS
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=52 -cpp -DNOCONTEXT -o - %s 2>&1 | FileCheck %s --check-prefix=NOCONTEXT
! DEPEND: not yet implemented: Unhandled clause DEPEND in DISPATCH construct
! DEVICE: not yet implemented: Unhandled clause DEVICE in DISPATCH construct
! IS_DEVICE_PTR: not yet implemented: Unhandled clause IS_DEVICE_PTR in DISPATCH construct
-! NOVARIANTS: not yet implemented: Unhandled clause NOVARIANTS in DISPATCH construct
-! NOCONTEXT: not yet implemented: Unhandled clause NOCONTEXT in DISPATCH construct
subroutine sub()
#ifdef IS_DEVICE_PTR
@@ -24,12 +20,6 @@ subroutine sub()
#endif
#ifdef IS_DEVICE_PTR
!$omp dispatch is_device_ptr(x)
-#endif
-#ifdef NOVARIANTS
-!$omp dispatch novariants(.true.)
-#endif
-#ifdef NOCONTEXT
-!$omp dispatch nocontext(.true.)
#endif
call foo()
contains
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index d1a437be5664b..1dc562906738f 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -1,39 +1,209 @@
-!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s --check-prefix=HLFIR
-!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=52 %s -o - | FileCheck %s --check-prefix=HLFIR
-!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=60 %s -o - | FileCheck %s --check-prefix=HLFIR
+!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s --check-prefix=HLFIR
-! Dispatch lowers to a no-op omp.dispatch region wrapping the associated call.
-! Variant selection and the nocontext/novariants clauses are added separately;
-! here the call inside the region targets the base procedure unchanged.
+! Variant selection is provided by DECLARE VARIANT with a `construct={dispatch}`
+! match: inside a dispatch region the call to the base procedure `foo_dispatch`
+! is replaced by a call to its variant `foo_variant`. `base_routine` additionally
+! carries a `device={kind(host)}` variant to exercise re-resolution under
+! `nocontext` when more than one variant matches.
module funcs
implicit none
contains
+ !novariants clause : base & variant subroutines
+ !HLFIR-LABEL: func @_QMfuncsPfoo_variant
+ subroutine foo_variant()
+ print *, "in foo_variant"
+ end subroutine
+
!HLFIR-LABEL: func @_QMfuncsPfoo_dispatch
subroutine foo_dispatch()
+ !$omp declare variant(foo_dispatch:foo_variant) match(construct={dispatch})
print *, "in foo_dispatch"
end subroutine
+ !nocontext clause : base & variant subroutines
+ !HLFIR-LABEL: func @_QMfuncsPdispatch_variant
+ subroutine dispatch_variant()
+ print *, "in dispatch_variant"
+ end subroutine
+
+ !HLFIR-LABEL: func @_QMfuncsPhost_variant
+ subroutine host_variant()
+ print *, "in host_variant"
+ end subroutine
+
+ ! `base_routine` has two variants: `dispatch_variant` matches
+ ! `construct={dispatch}` and `host_variant` matches `device={kind(host)}`.
+ !HLFIR-LABEL: func @_QMfuncsPbase_routine
+ subroutine base_routine()
+ !$omp declare variant(base_routine:dispatch_variant) match(construct={dispatch})
+ !$omp declare variant(base_routine:host_variant) match(device={kind(host)})
+ print *, "in base_routine"
+ end subroutine
+
end module funcs
!HLFIR-LABEL: func @_QQmain
program dispatch_test
use funcs
implicit none
+ logical :: cond
+
+ ! A call outside any dispatch region targets the base procedure.
+ !HLFIR: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ call foo_dispatch()
!HLFIR: omp.dispatch {
!$omp dispatch
- !HLFIR: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ !HLFIR: fir.call @_QMfuncsPfoo_variant() {{.*}}: () -> ()
call foo_dispatch()
!HLFIR: omp.terminator
!HLFIR: }
!HLFIR: omp.dispatch nowait {
!$omp dispatch nowait
- !HLFIR: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ !HLFIR: fir.call @_QMfuncsPfoo_variant() {{.*}}: () -> ()
+ call foo_dispatch()
+ !HLFIR: omp.terminator
+ !HLFIR: }
+
+ ! novariants: runtime select of base/variant address, then indirect call, so
+ ! the arguments are evaluated once.
+ !HLFIR: %[[COND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[COND_I1:.*]] = fir.convert %[[COND]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch novariants(%[[COND_I1]]) {
+ !$omp dispatch novariants(cond)
+ !HLFIR: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ !HLFIR: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ !HLFIR: %[[TARGET:.*]] = arith.select %[[COND_I1]], %[[BASE]], %[[VARIANT]] : () -> ()
+ !HLFIR: fir.call %[[TARGET]]() {{.*}}: () -> ()
+ call foo_dispatch()
+ !HLFIR: omp.terminator
+ !HLFIR: }
+
+ ! nocontext: the dispatch construct is dropped from the OpenMP context when
+ ! the condition is true, so the same base/variant runtime select is emitted.
+ !HLFIR: %[[NCOND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[NCOND_I1:.*]] = fir.convert %[[NCOND]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch nocontext(%[[NCOND_I1]]) {
+ !$omp dispatch nocontext(cond)
+ !HLFIR: %[[NVARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
+ !HLFIR: %[[NBASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
+ !HLFIR: %[[NTARGET:.*]] = arith.select %[[NCOND_I1]], %[[NBASE]], %[[NVARIANT]] : () -> ()
+ !HLFIR: fir.call %[[NTARGET]]() {{.*}}: () -> ()
call foo_dispatch()
!HLFIR: omp.terminator
!HLFIR: }
+
+ ! nocontext with two matching variants: with the dispatch construct removed
+ ! from the context, `construct={dispatch}` no longer matches and selection
+ ! re-resolves to the `device={kind(host)}` variant, so the runtime select is
+ ! between the two variants (not the base procedure).
+ !HLFIR: %[[MCOND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[MCOND_I1:.*]] = fir.convert %[[MCOND]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch nocontext(%[[MCOND_I1]]) {
+ !$omp dispatch nocontext(cond)
+ !HLFIR: %[[MVARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ !HLFIR: %[[MHOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ !HLFIR: %[[MTARGET:.*]] = arith.select %[[MCOND_I1]], %[[MHOST]], %[[MVARIANT]] : () -> ()
+ !HLFIR: fir.call %[[MTARGET]]() {{.*}}: () -> ()
+ call base_routine()
+ !HLFIR: omp.terminator
+ !HLFIR: }
end program
+
+!HLFIR-LABEL: func @_QPtest_novariants_nocontext(
+!HLFIR-SAME: %[[C1_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[C2_ARG:[^:]+]]: !fir.ref<!fir.logical<4>>
+subroutine test_novariants_nocontext(c1, c2)
+ use funcs
+ implicit none
+ logical :: c1, c2
+
+ !HLFIR: %[[C1:.*]]:2 = hlfir.declare %[[C1_ARG]]
+ !HLFIR: %[[C2:.*]]:2 = hlfir.declare %[[C2_ARG]]
+ !HLFIR: %[[C2_LOAD:.*]] = fir.load %[[C2]]#0 : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[C2_I1:.*]] = fir.convert %[[C2_LOAD]] : (!fir.logical<4>) -> i1
+ !HLFIR: %[[C1_LOAD:.*]] = fir.load %[[C1]]#0 : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[C1_I1:.*]] = fir.convert %[[C1_LOAD]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch nocontext(%[[C2_I1]]) novariants(%[[C1_I1]]) {
+ !$omp dispatch novariants(c1) nocontext(c2)
+ !HLFIR: %[[BOTH_VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
+ !HLFIR: %[[BOTH_HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
+ !HLFIR: %[[CONTEXT_TARGET:.*]] = arith.select %[[C2_I1]], %[[BOTH_HOST]], %[[BOTH_VARIANT]] : () -> ()
+ !HLFIR: %[[BOTH_BASE:.*]] = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
+ !HLFIR: %[[BOTH_TARGET:.*]] = arith.select %[[C1_I1]], %[[BOTH_BASE]], %[[CONTEXT_TARGET]] : () -> ()
+ !HLFIR: fir.call %[[BOTH_TARGET]]() {{.*}}: () -> ()
+ call base_routine()
+ !HLFIR: omp.terminator
+ !HLFIR: }
+end subroutine
+
+!HLFIR-LABEL: func @_QPtest_external_novariants(
+subroutine test_external_novariants(cond)
+ implicit none
+ logical :: cond
+ interface
+ subroutine external_variant()
+ end subroutine
+ subroutine external_base()
+ import :: external_variant
+ !$omp declare variant(external_base:external_variant) match(construct={dispatch})
+ end subroutine
+ end interface
+
+ !HLFIR: omp.dispatch novariants(%[[EXT_COND:.*]]) {
+ !$omp dispatch novariants(cond)
+ !HLFIR: %[[EXT_VARIANT:.*]] = fir.address_of(@_QPexternal_variant) : () -> ()
+ !HLFIR: %[[EXT_BASE:.*]] = fir.address_of(@_QPexternal_base) : () -> ()
+ !HLFIR: %[[EXT_TARGET:.*]] = arith.select %[[EXT_COND]], %[[EXT_BASE]], %[[EXT_VARIANT]] : () -> ()
+ !HLFIR-NEXT: fir.call %[[EXT_TARGET]]() {{.*}}: () -> ()
+ call external_base()
+ !HLFIR-NEXT: omp.terminator
+end subroutine
+
+!HLFIR-LABEL: func @_QPtest_external_nocontext(
+!HLFIR-SAME: %[[EXT_COND_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[EXT_VALUE_ARG:[^:]+]]: !fir.ref<i32>
+integer function test_external_nocontext(cond, value) result(res)
+ implicit none
+ logical :: cond
+ integer :: value
+ interface
+ integer function external_dispatch_func(value)
+ integer, value :: value
+ end function
+ integer function external_host_func(value)
+ integer, value :: value
+ end function
+ integer function external_base_func(value) result(output)
+ import :: external_dispatch_func, external_host_func
+ integer, value :: value
+ !$omp declare variant(external_base_func:external_dispatch_func) match(construct={dispatch})
+ !$omp declare variant(external_base_func:external_host_func) match(device={kind(host)})
+ end function
+ end interface
+
+ !HLFIR: %[[EXT_COND_ADDR:.*]]:2 = hlfir.declare %[[EXT_COND_ARG]]
+ !HLFIR: %[[EXT_RESULT_ADDR:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFtest_external_nocontextEres"}
+ !HLFIR: %[[EXT_VALUE_ADDR:.*]]:2 = hlfir.declare %[[EXT_VALUE_ARG]]
+ !HLFIR: %[[EXT_COND_LOAD:.*]] = fir.load %[[EXT_COND_ADDR]]#0 : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[EXT_NCOND:.*]] = fir.convert %[[EXT_COND_LOAD]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch nocontext(%[[EXT_NCOND]]) {
+ !$omp dispatch nocontext(cond)
+ !HLFIR: %[[EXT_VALUE:.*]] = fir.load %[[EXT_VALUE_ADDR]]#0 : !fir.ref<i32>
+ !HLFIR: %[[EXT_DISPATCH:.*]] = fir.address_of(@_QPexternal_dispatch_func) : (i32) -> i32
+ !HLFIR: %[[EXT_HOST:.*]] = fir.address_of(@_QPexternal_host_func) : (i32) -> i32
+ !HLFIR: %[[EXT_NTARGET:.*]] = arith.select %[[EXT_NCOND]], %[[EXT_HOST]], %[[EXT_DISPATCH]] : (i32) -> i32
+ !HLFIR-NEXT: %[[EXT_RESULT:.*]] = fir.call %[[EXT_NTARGET]](%[[EXT_VALUE]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: hlfir.assign %[[EXT_RESULT]] to %[[EXT_RESULT_ADDR]]#0 : i32, !fir.ref<i32>
+ res = external_base_func(value)
+ !HLFIR-NEXT: omp.terminator
+ !HLFIR: %[[EXT_RETURN:.*]] = fir.load %[[EXT_RESULT_ADDR]]#0 : !fir.ref<i32>
+ !HLFIR: return %[[EXT_RETURN]] : i32
+end function
+
+!HLFIR-DAG: func.func private @_QPexternal_variant()
+!HLFIR-DAG: func.func private @_QPexternal_base()
+!HLFIR-DAG: func.func private @_QPexternal_dispatch_func(i32) -> i32
+!HLFIR-DAG: func.func private @_QPexternal_host_func(i32) -> i32
diff --git a/flang/test/Semantics/OpenMP/dispatch.f90 b/flang/test/Semantics/OpenMP/dispatch.f90
index af0d6856ab948..ad617a7afe9c4 100644
--- a/flang/test/Semantics/OpenMP/dispatch.f90
+++ b/flang/test/Semantics/OpenMP/dispatch.f90
@@ -18,3 +18,53 @@ subroutine sb3
!ERROR: The DISPATCH construct should contain a single function or subroutine call
!$omp dispatch
end subroutine
+
+subroutine sb4
+ logical :: c
+ integer :: r
+ ! The novariants clause is accepted; the body validation still applies.
+ !$omp dispatch novariants(c)
+!ERROR: The body of the DISPATCH construct should be a function or a subroutine call
+ print *, r
+end subroutine
+
+subroutine sb5
+ logical :: a, b
+ ! novariants has the `unique` property (OpenMP 5.2, 7.6.1).
+!ERROR: At most one NOVARIANTS clause can appear on DISPATCH directive
+ !$omp dispatch novariants(a) novariants(b)
+ call foo()
+end subroutine
+
+subroutine sb6
+ integer :: i
+ ! novariants requires an expression of logical type (OpenMP 5.2, 7.6.1).
+!ERROR: Must have LOGICAL type, but is INTEGER(4)
+ !$omp dispatch novariants(i)
+ call foo()
+end subroutine
+
+subroutine sb7
+ logical :: c
+ integer :: r
+ ! The nocontext clause is accepted; the body validation still applies.
+ !$omp dispatch nocontext(c)
+!ERROR: The body of the DISPATCH construct should be a function or a subroutine call
+ print *, r
+end subroutine
+
+subroutine sb8
+ logical :: a, b
+ ! nocontext has the `unique` property (OpenMP 5.2, 7.6.2).
+!ERROR: At most one NOCONTEXT clause can appear on DISPATCH directive
+ !$omp dispatch nocontext(a) nocontext(b)
+ call foo()
+end subroutine
+
+subroutine sb9
+ integer :: i
+ ! nocontext requires an expression of logical type (OpenMP 5.2, 7.6.2).
+!ERROR: Must have LOGICAL type, but is INTEGER(4)
+ !$omp dispatch nocontext(i)
+ call foo()
+end subroutine
>From 0db5e2885fbc1802a1181fe95ab03adb05a8537c Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Sat, 26 Sep 2026 02:16:57 -0500
Subject: [PATCH 03/12] Applying the dispatch context to function calls within
the arguments e.g. if a variant for "f" is "fv" then "!$omp dispatch call
s(f(3))" will result in s(fv(3)).
---
flang/include/flang/Lower/OpenMP.h | 7 +++
flang/lib/Lower/CallInterface.cpp | 12 +++--
flang/lib/Lower/ConvertCall.cpp | 3 +-
flang/lib/Lower/OpenMP/OpenMP.cpp | 45 +++++++++++++++++
flang/test/Lower/OpenMP/dispatch.f90 | 75 ++++++++++++++++++++++++++++
5 files changed, 136 insertions(+), 6 deletions(-)
diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h
index a21cc4be0f6d3..6dfc96b6ecc28 100644
--- a/flang/include/flang/Lower/OpenMP.h
+++ b/flang/include/flang/Lower/OpenMP.h
@@ -35,6 +35,10 @@ class FirOpBuilder;
} // namespace fir
namespace Fortran {
+namespace evaluate {
+class ProcedureRef;
+} // namespace evaluate
+
namespace parser {
struct OpenMPConstruct;
struct OpenMPDeclarativeConstruct;
@@ -115,6 +119,9 @@ void markOpenMPImportedDeclareTargets(
semantics::SemanticsContext &semaCtx);
namespace omp {
+bool isDispatchTargetCall(const Fortran::evaluate::ProcedureRef &proc,
+ AbstractConverter &converter);
+
/// 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. When \p excludeDispatchContext
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 9885345bed3a5..e2db53f938c77 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -69,9 +69,9 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
/// 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,
+getOmpDeclareVariantCallee(const Fortran::evaluate::ProcedureRef &procRef,
Fortran::lower::AbstractConverter &converter) {
- const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
+ const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
if (!symbol)
return nullptr;
const Fortran::semantics::Symbol &ultimate{symbol->GetUltimate()};
@@ -81,7 +81,9 @@ getOmpDeclareVariantCallee(const Fortran::evaluate::ProcedureDesignator &proc,
ultimate.detailsIf<Fortran::semantics::SubprogramDetails>();
if (!details || details->ompDeclareVariants().empty())
return nullptr;
- return Fortran::lower::omp::resolveDeclareVariantCallee(ultimate, converter);
+ return Fortran::lower::omp::resolveDeclareVariantCallee(
+ ultimate, converter,
+ !Fortran::lower::omp::isDispatchTargetCall(procRef, converter));
}
/// Return the binding label (from BIND(C...)) or the mangled name of the
@@ -103,7 +105,7 @@ std::string Fortran::lower::CallerInterface::getMangledName() const {
// 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))
+ getOmpDeclareVariantCallee(procRef, converter))
return converter.mangleName(*variant);
return getProcMangledName(procRef.proc(), converter);
}
@@ -112,7 +114,7 @@ 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))
+ getOmpDeclareVariantCallee(procRef, converter))
return variant;
return procRef.proc().GetSymbol();
}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index eef88028df91c..cc6542b302b90 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -584,7 +584,8 @@ Fortran::lower::genCallOpAndResult(
// via an indirect call, evaluating arguments once. All candidate procedures
// share one signature; revisit if declare-variant `adjust_args`/`append_args`
// land.
- if (funcSymbolAttr) {
+ if (funcSymbolAttr && Fortran::lower::omp::isDispatchTargetCall(
+ caller.getCallDescription(), converter)) {
mlir::Value novariantsCond =
Fortran::lower::omp::getEnclosingDispatchNovariants(builder);
mlir::Value nocontextCond =
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index dc88184c7663e..c50f64e4af05f 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -22,6 +22,7 @@
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
#include "flang/Evaluate/type.h"
#include "flang/Lower/Bridge.h"
#include "flang/Lower/ConvertCall.h"
@@ -845,6 +846,24 @@ getSectionsConstructStackTop(lower::AbstractConverter &converter) {
return frame ? &frame->sectionsConstruct : nullptr;
}
+class DispatchTargetStackFrame
+ : public mlir::StateStackFrameBase<DispatchTargetStackFrame> {
+public:
+ MLIR_DEFINE_EXPLICIT_INTERNAL_INLINE_TYPE_ID(DispatchTargetStackFrame)
+
+ explicit DispatchTargetStackFrame(const evaluate::ProcedureRef *target)
+ : target{target} {}
+
+ const evaluate::ProcedureRef *target;
+};
+
+bool Fortran::lower::omp::isDispatchTargetCall(
+ const evaluate::ProcedureRef &proc, lower::AbstractConverter &converter) {
+ auto *frame =
+ converter.getStateStack().getStackTop<DispatchTargetStackFrame>();
+ return frame && frame->target == &proc;
+}
+
/// Bind objects to their corresponding entry block arguments.
///
/// The binding will be performed inside of the current block, which does not
@@ -2994,6 +3013,21 @@ genCriticalOp(lower::AbstractConverter &converter, lower::SymMap &symTable,
queue, item, nameAttr);
}
+class DispatchTargetFinder
+ : public evaluate::AnyTraverse<DispatchTargetFinder,
+ const evaluate::ProcedureRef *> {
+public:
+ using Base = evaluate::AnyTraverse<DispatchTargetFinder,
+ const evaluate::ProcedureRef *>;
+ DispatchTargetFinder() : Base{*this} {}
+ using Base::operator();
+
+ const evaluate::ProcedureRef *
+ operator()(const evaluate::ProcedureRef &proc) const {
+ return &proc;
+ }
+};
+
static mlir::omp::DispatchOp genDispatchOp(
lower::AbstractConverter &converter, lower::SymMap &symTable,
lower::StatementContext &stmtCtx, semantics::SemanticsContext &semaCtx,
@@ -3003,6 +3037,17 @@ static mlir::omp::DispatchOp genDispatchOp(
genDispatchClauses(converter, semaCtx, stmtCtx, item->clauses, loc,
clauseOps);
+ const evaluate::ProcedureRef *target = nullptr;
+ for (lower::pft::Evaluation &nested : eval.getNestedEvaluations())
+ nested.visit(common::visitors{
+ [&](const parser::CallStmt &stmt) { target = &*stmt.typedCall; },
+ [&](const parser::AssignmentStmt &stmt) {
+ target = DispatchTargetFinder{}(stmt.typedAssignment->v->rhs);
+ },
+ [](const auto &) {}});
+ mlir::SaveStateStack<DispatchTargetStackFrame> saveStateStack{
+ converter.getStateStack(), target};
+
return genOpWithBody<mlir::omp::DispatchOp>(
OpWithBodyGenInfo(converter, symTable, semaCtx, loc, eval,
llvm::omp::Directive::OMPD_dispatch),
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index 1dc562906738f..976441bbfd5fe 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -203,6 +203,81 @@ integer function external_base_func(value) result(output)
!HLFIR: return %[[EXT_RETURN]] : i32
end function
+!HLFIR-LABEL: func @_QPtest_dispatch_argument(
+subroutine test_dispatch_argument(c1, c2)
+ implicit none
+ logical :: c1, c2
+ integer :: result
+ real :: real_result
+ interface
+ integer function argument_dispatch(value)
+ integer, value :: value
+ end function
+ integer function argument_host(value)
+ integer, value :: value
+ end function
+ integer function argument_base(value) result(output)
+ import :: argument_dispatch, argument_host
+ integer, value :: value
+ !$omp declare variant(argument_base:argument_dispatch) match(construct={dispatch})
+ !$omp declare variant(argument_base:argument_host) match(device={kind(host)})
+ end function
+ subroutine target_dispatch(value)
+ integer, value :: value
+ end subroutine
+ subroutine target_host(value)
+ integer, value :: value
+ end subroutine
+ subroutine target_base(value)
+ import :: target_dispatch, target_host
+ integer, value :: value
+ !$omp declare variant(target_base:target_dispatch) match(construct={dispatch})
+ !$omp declare variant(target_base:target_host) match(device={kind(host)})
+ end subroutine
+ end interface
+
+ !HLFIR: omp.dispatch {
+ !$omp dispatch
+ !HLFIR: %[[ARG_RESULT:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.call @_QPtarget_dispatch(%[[ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: omp.terminator
+ call target_base(argument_base(3))
+
+ !HLFIR: omp.dispatch nocontext(%[[ARG_C2:.*]]) novariants(%[[ARG_C1:.*]]) {
+ !$omp dispatch novariants(c1) nocontext(c2)
+ !HLFIR-NOT: arith.select
+ !HLFIR: %[[BOTH_ARG_RESULT:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: %[[ARG_DISPATCH:.*]] = fir.address_of(@_QPtarget_dispatch) : (i32) -> ()
+ !HLFIR-NEXT: %[[ARG_HOST:.*]] = fir.address_of(@_QPtarget_host) : (i32) -> ()
+ !HLFIR-NEXT: %[[ARG_CONTEXT:.*]] = arith.select %[[ARG_C2]], %[[ARG_HOST]], %[[ARG_DISPATCH]] : (i32) -> ()
+ !HLFIR-NEXT: %[[ARG_BASE:.*]] = fir.address_of(@_QPtarget_base) : (i32) -> ()
+ !HLFIR-NEXT: %[[ARG_TARGET:.*]] = arith.select %[[ARG_C1]], %[[ARG_BASE]], %[[ARG_CONTEXT]] : (i32) -> ()
+ !HLFIR-NEXT: fir.call %[[ARG_TARGET]](%[[BOTH_ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: omp.terminator
+ call target_base(argument_base(3))
+
+ !HLFIR: omp.dispatch nocontext(%[[FUNC_C2:.*]]) novariants(%[[FUNC_C1:.*]]) {
+ !$omp dispatch novariants(c1) nocontext(c2)
+ !HLFIR-NOT: arith.select
+ !HLFIR: %[[INNER_RESULT:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: %[[FUNC_DISPATCH:.*]] = fir.address_of(@_QPargument_dispatch) : (i32) -> i32
+ !HLFIR-NEXT: %[[FUNC_HOST:.*]] = fir.address_of(@_QPargument_host) : (i32) -> i32
+ !HLFIR-NEXT: %[[FUNC_CONTEXT:.*]] = arith.select %[[FUNC_C2]], %[[FUNC_HOST]], %[[FUNC_DISPATCH]] : (i32) -> i32
+ !HLFIR-NEXT: %[[FUNC_BASE:.*]] = fir.address_of(@_QPargument_base) : (i32) -> i32
+ !HLFIR-NEXT: %[[FUNC_TARGET:.*]] = arith.select %[[FUNC_C1]], %[[FUNC_BASE]], %[[FUNC_CONTEXT]] : (i32) -> i32
+ !HLFIR-NEXT: %[[OUTER_RESULT:.*]] = fir.call %[[FUNC_TARGET]](%[[INNER_RESULT]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: hlfir.assign %[[OUTER_RESULT]] to %{{.*}} : i32, !fir.ref<i32>
+ !HLFIR-NEXT: omp.terminator
+ result = argument_base(argument_base(3))
+
+ !HLFIR: omp.dispatch {
+ !$omp dispatch
+ !HLFIR: %[[CONVERT_INNER:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: %[[CONVERT_OUTER:.*]] = fir.call @_QPargument_dispatch(%[[CONVERT_INNER]]) {{.*}}: (i32) -> i32
+ !HLFIR: fir.convert %[[CONVERT_OUTER]] : (i32) -> f32
+ real_result = argument_base(argument_base(3))
+end subroutine
+
!HLFIR-DAG: func.func private @_QPexternal_variant()
!HLFIR-DAG: func.func private @_QPexternal_base()
!HLFIR-DAG: func.func private @_QPexternal_dispatch_func(i32) -> i32
>From 21078c2ac7a1cc2bbf00e6ca96e82a278abb001a Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Wed, 30 Sep 2026 05:22:17 -0500
Subject: [PATCH 04/12] Fixing dispatch clause handling. Correcting an internal
bug which was introduced after novariants and nocontext was added.
---
flang/lib/Lower/ConvertCall.cpp | 42 ++++++-----------
flang/test/Lower/OpenMP/dispatch.f90 | 70 ++++++++++++++++++++++++++++
2 files changed, 85 insertions(+), 27 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index cc6542b302b90..47a5ab5c1430b 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -514,6 +514,8 @@ Fortran::lower::genCallOpAndResult(
// arguments which can happen in legal program if it was passed as a dummy
// procedure argument earlier with no further type information.
mlir::SymbolRefAttr funcSymbolAttr;
+ mlir::FunctionType funcType = callSiteType;
+ bool mustCastFunc = false;
bool addHostAssociations = false;
if (!funcPointer) {
mlir::FunctionType funcOpType = caller.getFuncOp().getFunctionType();
@@ -534,12 +536,11 @@ Fortran::lower::genCallOpAndResult(
// mismatch due to the extra argument, but the interface is otherwise
// explicit and safe), handle interface mismatch due to F77 implicit
// interface "abuse" with a function address cast if needed.
- if (!addHostAssociations &&
- mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
- loc, converter, callSiteType, funcOpType))
- funcPointer = fir::AddrOfOp::create(builder, loc, funcOpType, symbolAttr);
- else
- funcSymbolAttr = symbolAttr;
+ mustCastFunc = !addHostAssociations &&
+ mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
+ loc, converter, callSiteType, funcOpType);
+ funcType = mustCastFunc ? callSiteType : funcOpType;
+ funcSymbolAttr = symbolAttr;
// Issue a warning if the procedure name conflicts with
// a runtime function name a call to which has been already
@@ -555,29 +556,12 @@ Fortran::lower::genCallOpAndResult(
"Flang - this may lead to undefined behavior")));
}
- mlir::FunctionType funcType =
- funcPointer ? callSiteType : caller.getFuncOp().getFunctionType();
-
// If we have any ignore_tkr(c) dummy args, adjust the function type to
// have these args match the caller.
if (auto modifiedFuncType =
getTypeWithIgnoreTkrC(funcType, caller, builder.getContext())) {
- // Note: funcPointer would only be non-null here, if we are already
- // processing indirect function call. In such case we can re-use the same
- // funcPointer and we'll cast it below the the modified funcType.
- if (!funcPointer) {
- // We want to cast the function to a different type, in order to avoid
- // changing/casting some of the args. The cast will generate a new
- // function pointer, so that we would make a function call not through
- // the original function symbol, but through the new function pointer
- // (an indirect function call).
- mlir::SymbolRefAttr symbolAttr =
- builder.getSymbolRefAttr(caller.getMangledName());
- // Create pointer to original function. This pointer will be cast later.
- funcPointer = fir::AddrOfOp::create(builder, loc, funcType, symbolAttr);
- funcSymbolAttr = {}; // This marks it as indirect call
- }
funcType = *modifiedFuncType;
+ mustCastFunc = true;
}
// OpenMP dispatch `novariants`/`nocontext`: at runtime pick the right target
@@ -613,8 +597,7 @@ Fortran::lower::genCallOpAndResult(
};
// Start from the variant selected with the dispatch construct in context.
- mlir::Value target =
- fir::AddrOfOp::create(builder, loc, funcType, funcSymbolAttr);
+ mlir::Value target = addrOfSym(selectedUlt);
// `nocontext(true)`: re-select the variant with the dispatch construct
// removed from the OpenMP context. That may resolve to a different
@@ -637,10 +620,15 @@ Fortran::lower::genCallOpAndResult(
addrOfSym(baseUlt), target);
funcPointer = target;
- funcSymbolAttr = {}; // Mark as an indirect call.
}
}
+ if (!funcPointer && mustCastFunc)
+ funcPointer = fir::AddrOfOp::create(
+ builder, loc, caller.getFuncOp().getFunctionType(), funcSymbolAttr);
+ if (funcPointer)
+ funcSymbolAttr = {};
+
llvm::SmallVector<mlir::Value> operands;
// First operand of indirect call is the function pointer. Cast it to
// required function type for the call to handle procedures that have a
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index 976441bbfd5fe..daa8a43c89b4b 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -278,6 +278,76 @@ subroutine target_base(value)
real_result = argument_base(argument_base(3))
end subroutine
+! IGNORE_TKR(C) with an allocatable actual requires a function-pointer cast.
+! Dispatch clauses must still select addresses with the adjusted signature.
+!HLFIR-LABEL: func @_QPtest_dispatch_ignore_tkr(
+!HLFIR-SAME: %[[CAST_C1_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[CAST_C2_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[VALUES_ARG:[^:]+]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+subroutine test_dispatch_ignore_tkr(c1, c2, values)
+ implicit none
+ logical :: c1, c2
+ real, allocatable :: values(:)
+ interface
+ subroutine cast_dispatch(values)
+ real, intent(in) :: values(:)
+ !dir$ ignore_tkr(c) values
+ end subroutine
+ subroutine cast_host(values)
+ real, intent(in) :: values(:)
+ !dir$ ignore_tkr(c) values
+ end subroutine
+ subroutine cast_base(values)
+ import :: cast_dispatch, cast_host
+ real, intent(in) :: values(:)
+ !dir$ ignore_tkr(c) values
+ !$omp declare variant(cast_base:cast_dispatch) match(construct={dispatch})
+ !$omp declare variant(cast_base:cast_host) match(device={kind(host)})
+ end subroutine
+ end interface
+
+ !HLFIR: %[[CAST_C1:.*]]:2 = hlfir.declare %[[CAST_C1_ARG]]
+ !HLFIR: %[[CAST_C2:.*]]:2 = hlfir.declare %[[CAST_C2_ARG]]
+ !HLFIR: %[[VALUES:.*]]:2 = hlfir.declare %[[VALUES_ARG]]
+ !HLFIR: omp.dispatch novariants(%[[CAST_NV:.*]]) {
+ !$omp dispatch novariants(c1)
+ !HLFIR: %[[NV_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[NV_DISPATCH:.*]] = fir.convert %[[NV_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[NV_BASE_ADDR:.*]] = fir.address_of(@_QPcast_base) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[NV_BASE:.*]] = fir.convert %[[NV_BASE_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[NV_TARGET:.*]] = arith.select %[[CAST_NV]], %[[NV_BASE]], %[[NV_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[NV_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: omp.terminator
+ call cast_base(values)
+
+ !HLFIR: omp.dispatch nocontext(%[[CAST_NC:.*]]) {
+ !$omp dispatch nocontext(c2)
+ !HLFIR: %[[NC_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[NC_DISPATCH:.*]] = fir.convert %[[NC_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[NC_HOST_ADDR:.*]] = fir.address_of(@_QPcast_host) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[NC_HOST:.*]] = fir.convert %[[NC_HOST_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[NC_TARGET:.*]] = arith.select %[[CAST_NC]], %[[NC_HOST]], %[[NC_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[NC_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: omp.terminator
+ call cast_base(values)
+
+ !HLFIR: %[[CAST_C2_LOAD:.*]] = fir.load %[[CAST_C2]]#0 : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[CAST_C2_I1:.*]] = fir.convert %[[CAST_C2_LOAD]] : (!fir.logical<4>) -> i1
+ !HLFIR: %[[CAST_C1_LOAD:.*]] = fir.load %[[CAST_C1]]#0 : !fir.ref<!fir.logical<4>>
+ !HLFIR: %[[CAST_C1_I1:.*]] = fir.convert %[[CAST_C1_LOAD]] : (!fir.logical<4>) -> i1
+ !HLFIR: omp.dispatch nocontext(%[[CAST_C2_I1]]) novariants(%[[CAST_C1_I1]]) {
+ !$omp dispatch novariants(c1) nocontext(c2)
+ !HLFIR: %[[BOTH_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[CAST_DISPATCH:.*]] = fir.convert %[[BOTH_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[BOTH_HOST_ADDR:.*]] = fir.address_of(@_QPcast_host) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[CAST_HOST:.*]] = fir.convert %[[BOTH_HOST_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[CAST_CONTEXT:.*]] = arith.select %[[CAST_C2_I1]], %[[CAST_HOST]], %[[CAST_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: %[[BOTH_BASE_ADDR:.*]] = fir.address_of(@_QPcast_base) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[CAST_BASE:.*]] = fir.convert %[[BOTH_BASE_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: %[[CAST_TARGET:.*]] = arith.select %[[CAST_C1_I1]], %[[CAST_BASE]], %[[CAST_CONTEXT]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[CAST_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: omp.terminator
+ call cast_base(values)
+end subroutine
+
!HLFIR-DAG: func.func private @_QPexternal_variant()
!HLFIR-DAG: func.func private @_QPexternal_base()
!HLFIR-DAG: func.func private @_QPexternal_dispatch_func(i32) -> i32
>From 957e3920401af713b3a39231f7c1c2f987080583 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Wed, 30 Sep 2026 06:51:15 -0500
Subject: [PATCH 05/12] Removing extra tests in
flang/test/Integration/OpenMP/dispatch.f90. Adding openmp version in
flang/test/Lower/OpenMP/dispatch.f90 runs.
---
flang/test/Integration/OpenMP/dispatch.f90 | 60 ----------------------
flang/test/Lower/OpenMP/dispatch.f90 | 2 +-
2 files changed, 1 insertion(+), 61 deletions(-)
diff --git a/flang/test/Integration/OpenMP/dispatch.f90 b/flang/test/Integration/OpenMP/dispatch.f90
index 202ceeaec850a..249f10ba78a4b 100644
--- a/flang/test/Integration/OpenMP/dispatch.f90
+++ b/flang/test/Integration/OpenMP/dispatch.f90
@@ -130,63 +130,3 @@ subroutine test_novariants_nocontext(c1, c2)
call base_routine()
end subroutine
-
-!CHECK-LABEL: define void @test_external_novariants_(
-!CHECK-SAME: ptr noalias %[[EXT_COND_ARG:[0-9]+]])
-!CHECK: %[[EXT_LOAD:.*]] = load i32, ptr %[[EXT_COND_ARG]], align 4
-!CHECK: %[[EXT_COND:.*]] = icmp ne i32 %[[EXT_LOAD]], 0
-!CHECK: %[[EXT_TARGET:.*]] = select i1 %[[EXT_COND]], ptr @external_base_, ptr @external_variant_
-!CHECK-NEXT: call void %[[EXT_TARGET]]()
-subroutine test_external_novariants(cond)
- implicit none
- logical :: cond
- interface
- subroutine external_variant()
- end subroutine
- subroutine external_base()
- import :: external_variant
- !$omp declare variant(external_base:external_variant) match(construct={dispatch})
- end subroutine
- end interface
-
- !$omp dispatch novariants(cond)
- call external_base()
-end subroutine
-
-!CHECK-LABEL: define i32 @test_external_nocontext_(
-!CHECK-SAME: ptr noalias %[[EXT_NCOND_ARG:[0-9]+]], ptr noalias %[[EXT_VALUE_ARG:[0-9]+]])
-!CHECK: %[[EXT_NLOAD:.*]] = load i32, ptr %[[EXT_NCOND_ARG]], align 4
-!CHECK: %[[EXT_NCOND:.*]] = icmp ne i32 %[[EXT_NLOAD]], 0
-!CHECK: %[[EXT_VALUE:.*]] = load i32, ptr %[[EXT_VALUE_ARG]], align 4
-!CHECK: %[[EXT_NTARGET:.*]] = select i1 %[[EXT_NCOND]], ptr @external_host_func_, ptr @external_dispatch_func_
-!CHECK-NEXT: %[[EXT_RESULT:.*]] = call i32 %[[EXT_NTARGET]](i32 %[[EXT_VALUE]])
-!CHECK: store i32 %[[EXT_RESULT]], ptr %[[EXT_RESULT_ADDR:.*]], align 4
-!CHECK: %[[EXT_RETURN:.*]] = load i32, ptr %[[EXT_RESULT_ADDR]], align 4
-!CHECK: ret i32 %[[EXT_RETURN]]
-integer function test_external_nocontext(cond, value) result(res)
- implicit none
- logical :: cond
- integer :: value
- interface
- integer function external_dispatch_func(value)
- integer, value :: value
- end function
- integer function external_host_func(value)
- integer, value :: value
- end function
- integer function external_base_func(value) result(output)
- import :: external_dispatch_func, external_host_func
- integer, value :: value
- !$omp declare variant(external_base_func:external_dispatch_func) match(construct={dispatch})
- !$omp declare variant(external_base_func:external_host_func) match(device={kind(host)})
- end function
- end interface
-
- !$omp dispatch nocontext(cond)
- res = external_base_func(value)
-end function
-
-!CHECK-DAG: declare void @external_variant_()
-!CHECK-DAG: declare void @external_base_()
-!CHECK-DAG: declare i32 @external_dispatch_func_(i32)
-!CHECK-DAG: declare i32 @external_host_func_(i32)
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index daa8a43c89b4b..3a309f03b2610 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -1,4 +1,4 @@
-!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s --check-prefix=HLFIR
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s --check-prefix=HLFIR
! Variant selection is provided by DECLARE VARIANT with a `construct={dispatch}`
! match: inside a dispatch region the call to the base procedure `foo_dispatch`
>From f42de518dbd09a342b25d591e4bc8d11020ee8f9 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Wed, 30 Sep 2026 13:13:06 -0500
Subject: [PATCH 06/12] Moving processNocontext declaration below
processMergeable.
---
flang/lib/Lower/OpenMP/ClauseProcessor.h | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.h b/flang/lib/Lower/OpenMP/ClauseProcessor.h
index 02149a48b0638..6cfcc85024dc0 100644
--- a/flang/lib/Lower/OpenMP/ClauseProcessor.h
+++ b/flang/lib/Lower/OpenMP/ClauseProcessor.h
@@ -100,10 +100,10 @@ class ClauseProcessor {
const parser::OmpStylizedInstance *parserInitInstance = nullptr,
unsigned instanceIdx = 0) const;
bool processMergeable(mlir::omp::MergeableClauseOps &result) const;
- bool processNogroup(mlir::omp::NogroupClauseOps &result) const;
- bool processNotinbranch(mlir::omp::NotinbranchClauseOps &result) const;
bool processNocontext(lower::StatementContext &stmtCtx,
mlir::omp::NocontextClauseOps &result) const;
+ bool processNogroup(mlir::omp::NogroupClauseOps &result) const;
+ bool processNotinbranch(mlir::omp::NotinbranchClauseOps &result) const;
bool processNovariants(lower::StatementContext &stmtCtx,
mlir::omp::NovariantsClauseOps &result) const;
bool processNowait(mlir::omp::NowaitClauseOps &result) const;
>From 261193f952ab7e38a3cbbccce0ee7d81491d85de Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Thu, 1 Oct 2026 00:04:22 -0500
Subject: [PATCH 07/12] Change in comment.
---
flang/test/Lower/OpenMP/dispatch.f90 | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index 3a309f03b2610..7e85c7e2bc8e4 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -278,8 +278,8 @@ subroutine target_base(value)
real_result = argument_base(argument_base(3))
end subroutine
-! IGNORE_TKR(C) with an allocatable actual requires a function-pointer cast.
-! Dispatch clauses must still select addresses with the adjusted signature.
+! Check novariants and nocontext selection when an allocatable argument
+! to an IGNORE_TKR(C) dummy requires a function-pointer cast.
!HLFIR-LABEL: func @_QPtest_dispatch_ignore_tkr(
!HLFIR-SAME: %[[CAST_C1_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[CAST_C2_ARG:[^:]+]]: !fir.ref<!fir.logical<4>> {{.*}}, %[[VALUES_ARG:[^:]+]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
subroutine test_dispatch_ignore_tkr(c1, c2, values)
>From 8b87b599a4163a287bea184a2856920db44232b8 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Thu, 1 Oct 2026 03:32:07 -0500
Subject: [PATCH 08/12] Formatting error.
---
flang/lib/Lower/ConvertCall.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 4efaafb17a254..7ee24e896d62a 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -600,7 +600,7 @@ Fortran::lower::genCallOpAndResult(
};
// Start from the variant selected with the dispatch construct in context.
- mlir::Value target = addrOfSym(selectedUlt);
+ mlir::Value target = addrOfSym(selectedUlt);
// `nocontext(true)`: re-select the variant with the dispatch construct
// removed from the OpenMP context. That may resolve to a different
>From 4967c788bbf6eac57e99a7a130687f9c6c2cdecb Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Tue, 6 Oct 2026 10:38:03 -0500
Subject: [PATCH 09/12] Handling the issues raised Saieiei.
---
flang/lib/Lower/ConvertCall.cpp | 291 ++++++++++++++-------
flang/test/Fir/OpenMP/dispatch.fir | 87 +++---
flang/test/Integration/OpenMP/dispatch.f90 | 134 +++++++++-
flang/test/Lower/OpenMP/dispatch.f90 | 213 +++++++++++----
4 files changed, 517 insertions(+), 208 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 7ee24e896d62a..287ee65a29001 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -159,6 +159,101 @@ static bool mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
return false;
}
+namespace {
+/// Type used to call a known function from arguments prepared for the call
+/// site, and how the call must be emitted.
+struct DirectCallSignature {
+ mlir::FunctionType type;
+ /// Call through the function address cast to `type`.
+ bool mustCast = false;
+ /// Append the host association tuple to the arguments.
+ bool addHostAssociations = false;
+};
+} // namespace
+
+static DirectCallSignature getDirectCallSignature(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ mlir::FunctionType callSiteType, mlir::func::FuncOp func) {
+ DirectCallSignature signature;
+ mlir::FunctionType funcOpType = func.getFunctionType();
+ if (callSiteType.getNumResults() == funcOpType.getNumResults() &&
+ callSiteType.getNumInputs() + 1 == funcOpType.getNumInputs() &&
+ fir::anyFuncArgsHaveAttr(func, fir::getHostAssocAttrName())) {
+ // The number of arguments is off by one, and we're lowering a function
+ // with host associations. Modify call to include host associations
+ // argument by appending the value at the end of the operands.
+ assert(funcOpType.getInput(findHostAssocTuplePos(func)) ==
+ converter.hostAssocTupleValue().getType());
+ signature.addHostAssociations = true;
+ }
+ // When this is not a call to an internal procedure (where there is a
+ // mismatch due to the extra argument, but the interface is otherwise
+ // explicit and safe), handle interface mismatch due to F77 implicit
+ // interface "abuse" with a function address cast if needed.
+ signature.mustCast = !signature.addHostAssociations &&
+ mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
+ loc, converter, callSiteType, funcOpType);
+ signature.type = signature.mustCast ? callSiteType : funcOpType;
+ return signature;
+}
+
+/// Convert the actual arguments prepared in \p caller to the inputs of
+/// \p funcType and append them to \p operands.
+static void genCallArguments(mlir::Location loc,
+ Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::CallerInterface &caller,
+ mlir::FunctionType funcType,
+ llvm::SmallVectorImpl<mlir::Value> &operands) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ // Deal with potential mismatches in arguments types. Passing an array to a
+ // scalar argument should for instance be tolerated here.
+ for (auto [fst, snd] : llvm::zip(caller.getInputs(), funcType.getInputs())) {
+ // When passing arguments to a procedure that can be called by implicit
+ // interface, allow any character actual arguments to be passed to dummy
+ // arguments of any type and vice versa.
+ mlir::Value cast;
+ auto *context = builder.getContext();
+
+ if (mlir::isa<fir::BoxProcType>(snd) &&
+ mlir::isa<mlir::FunctionType>(fst.getType())) {
+ mlir::FunctionType funcTy = mlir::FunctionType::get(context, {}, {});
+ fir::BoxProcType boxProcTy = builder.getBoxProcType(funcTy);
+ if (mlir::Value host = argumentHostAssocs(converter, fst)) {
+ cast = fir::EmboxProcOp::create(builder, loc, boxProcTy,
+ llvm::ArrayRef<mlir::Value>{fst, host});
+ } else {
+ cast = fir::EmboxProcOp::create(builder, loc, boxProcTy, fst);
+ }
+ } else {
+ mlir::Type fromTy = fir::unwrapRefType(fst.getType());
+ if (fir::isa_builtin_cptr_type(fromTy) &&
+ Fortran::lower::isCPtrArgByValueType(snd)) {
+ cast = genRecordCPtrValueArg(builder, loc, fst, fromTy);
+ } else if (fir::isa_derived(snd) && !fir::isa_derived(fst.getType())) {
+ // TODO: remove this TODO once the old lowering is gone.
+ TODO(loc, "derived type argument passed by value");
+ } else {
+ // With the lowering to HLFIR, box arguments have already been built
+ // according to the attributes, rank, bounds, and type they should have.
+ // Do not attempt any reboxing here that could break this.
+ // When dealing with a dummy character argument (fir.boxchar), the
+ // effective argument might be a non-character raw pointer. This may
+ // happen when calling an implicit interface that was previously called
+ // with a character argument, or when calling an explicit interface with
+ // an IgnoreTKR dummy character arguments. Allow creating a fir.boxchar
+ // from the raw pointer, which requires a non-trivial type conversion.
+ const bool allowCharacterConversions = true;
+ bool isVolatile = fir::isa_volatile_type(snd);
+ cast = builder.createVolatileCast(loc, isVolatile, fst);
+ cast = builder.convertWithSemantics(loc, snd, cast,
+ allowCharacterConversions,
+ /*allowRebox=*/false);
+ }
+ }
+ operands.push_back(cast);
+ }
+}
+
static mlir::Value readDim3Value(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value dim3Addr, llvm::StringRef comp) {
mlir::Type i32Ty = builder.getI32Type();
@@ -521,28 +616,13 @@ Fortran::lower::genCallOpAndResult(
bool mustCastFunc = false;
bool addHostAssociations = false;
if (!funcPointer) {
- mlir::FunctionType funcOpType = caller.getFuncOp().getFunctionType();
mlir::SymbolRefAttr symbolAttr =
builder.getSymbolRefAttr(caller.getMangledName());
- if (callSiteType.getNumResults() == funcOpType.getNumResults() &&
- callSiteType.getNumInputs() + 1 == funcOpType.getNumInputs() &&
- fir::anyFuncArgsHaveAttr(caller.getFuncOp(),
- fir::getHostAssocAttrName())) {
- // The number of arguments is off by one, and we're lowering a function
- // with host associations. Modify call to include host associations
- // argument by appending the value at the end of the operands.
- assert(funcOpType.getInput(findHostAssocTuplePos(caller.getFuncOp())) ==
- converter.hostAssocTupleValue().getType());
- addHostAssociations = true;
- }
- // When this is not a call to an internal procedure (where there is a
- // mismatch due to the extra argument, but the interface is otherwise
- // explicit and safe), handle interface mismatch due to F77 implicit
- // interface "abuse" with a function address cast if needed.
- mustCastFunc = !addHostAssociations &&
- mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
- loc, converter, callSiteType, funcOpType);
- funcType = mustCastFunc ? callSiteType : funcOpType;
+ DirectCallSignature signature = getDirectCallSignature(
+ loc, converter, callSiteType, caller.getFuncOp());
+ funcType = signature.type;
+ mustCastFunc = signature.mustCast;
+ addHostAssociations = signature.addHostAssociations;
funcSymbolAttr = symbolAttr;
// Issue a warning if the procedure name conflicts with
@@ -567,10 +647,13 @@ Fortran::lower::genCallOpAndResult(
mustCastFunc = true;
}
- // OpenMP dispatch `novariants`/`nocontext`: at runtime pick the right target
- // via an indirect call, evaluating arguments once. All candidate procedures
- // share one signature; revisit if declare-variant `adjust_args`/`append_args`
- // land.
+ // OpenMP dispatch `novariants`/`nocontext`: the callee is chosen at runtime.
+ // Collect each condition with the procedure it selects, in priority order;
+ // the procedure selected for the enclosing context is the fallback. Each
+ // procedure is called directly with its own signature, including any host
+ // association argument, using the actual arguments lowered once above.
+ llvm::SmallVector<std::pair<mlir::Value, mlir::func::FuncOp>, 2>
+ dispatchCallees;
if (funcSymbolAttr && Fortran::lower::omp::isDispatchTargetCall(
caller.getCallDescription(), converter)) {
mlir::Value novariantsCond =
@@ -588,19 +671,14 @@ Fortran::lower::genCallOpAndResult(
const Fortran::semantics::Symbol &baseUlt = baseSym->GetUltimate();
const Fortran::semantics::Symbol &selectedUlt =
selectedSym->GetUltimate();
-
- auto addrOfSym =
- [&](const Fortran::semantics::Symbol &sym) -> mlir::Value {
- mlir::func::FuncOp func = Fortran::lower::getOrDeclareFunction(
+ auto getFunc = [&](const Fortran::semantics::Symbol &sym) {
+ return Fortran::lower::getOrDeclareFunction(
Fortran::evaluate::ProcedureDesignator{sym}, converter);
- mlir::Value address =
- fir::AddrOfOp::create(builder, loc, func.getFunctionType(),
- builder.getSymbolRefAttr(func.getSymName()));
- return builder.createConvert(loc, funcType, address);
};
- // Start from the variant selected with the dispatch construct in context.
- mlir::Value target = addrOfSym(selectedUlt);
+ // `novariants(true)` takes precedence: always call the base.
+ if (novariantsCond)
+ dispatchCallees.emplace_back(novariantsCond, getFunc(baseUlt));
// `nocontext(true)`: re-select the variant with the dispatch construct
// removed from the OpenMP context. That may resolve to a different
@@ -613,16 +691,8 @@ Fortran::lower::genCallOpAndResult(
const Fortran::semantics::Symbol &nocontextUlt =
nocontextSym ? nocontextSym->GetUltimate() : baseUlt;
if (&nocontextUlt != &selectedUlt)
- target = mlir::arith::SelectOp::create(
- builder, loc, nocontextCond, addrOfSym(nocontextUlt), target);
+ dispatchCallees.emplace_back(nocontextCond, getFunc(nocontextUlt));
}
-
- // `novariants(true)` takes final precedence: always call the base.
- if (novariantsCond)
- target = mlir::arith::SelectOp::create(builder, loc, novariantsCond,
- addrOfSym(baseUlt), target);
-
- funcPointer = target;
}
}
@@ -644,53 +714,7 @@ Fortran::lower::genCallOpAndResult(
: builder.createConvert(loc, funcType, funcPointer));
}
- // Deal with potential mismatches in arguments types. Passing an array to a
- // scalar argument should for instance be tolerated here.
- for (auto [fst, snd] : llvm::zip(caller.getInputs(), funcType.getInputs())) {
- // When passing arguments to a procedure that can be called by implicit
- // interface, allow any character actual arguments to be passed to dummy
- // arguments of any type and vice versa.
- mlir::Value cast;
- auto *context = builder.getContext();
-
- if (mlir::isa<fir::BoxProcType>(snd) &&
- mlir::isa<mlir::FunctionType>(fst.getType())) {
- mlir::FunctionType funcTy = mlir::FunctionType::get(context, {}, {});
- fir::BoxProcType boxProcTy = builder.getBoxProcType(funcTy);
- if (mlir::Value host = argumentHostAssocs(converter, fst)) {
- cast = fir::EmboxProcOp::create(builder, loc, boxProcTy,
- llvm::ArrayRef<mlir::Value>{fst, host});
- } else {
- cast = fir::EmboxProcOp::create(builder, loc, boxProcTy, fst);
- }
- } else {
- mlir::Type fromTy = fir::unwrapRefType(fst.getType());
- if (fir::isa_builtin_cptr_type(fromTy) &&
- Fortran::lower::isCPtrArgByValueType(snd)) {
- cast = genRecordCPtrValueArg(builder, loc, fst, fromTy);
- } else if (fir::isa_derived(snd) && !fir::isa_derived(fst.getType())) {
- // TODO: remove this TODO once the old lowering is gone.
- TODO(loc, "derived type argument passed by value");
- } else {
- // With the lowering to HLFIR, box arguments have already been built
- // according to the attributes, rank, bounds, and type they should have.
- // Do not attempt any reboxing here that could break this.
- // When dealing with a dummy character argument (fir.boxchar), the
- // effective argument might be a non-character raw pointer. This may
- // happen when calling an implicit interface that was previously called
- // with a character argument, or when calling an explicit interface with
- // an IgnoreTKR dummy character arguments. Allow creating a fir.boxchar
- // from the raw pointer, which requires a non-trivial type conversion.
- const bool allowCharacterConversions = true;
- bool isVolatile = fir::isa_volatile_type(snd);
- cast = builder.createVolatileCast(loc, isVolatile, fst);
- cast = builder.convertWithSemantics(loc, snd, cast,
- allowCharacterConversions,
- /*allowRebox=*/false);
- }
- }
- operands.push_back(cast);
- }
+ genCallArguments(loc, converter, caller, funcType, operands);
// Add host associations as necessary.
if (addHostAssociations)
@@ -851,15 +875,78 @@ Fortran::lower::genCallOpAndResult(
else if (caller.getCallDescription().hasAlwaysInline())
inlineAttr = fir::FortranInlineEnumAttr::get(
builder.getContext(), fir::FortranInlineEnum::always_inline);
- auto call = fir::CallOp::create(
- builder, loc, funcType.getResults(), funcSymbolAttr, operands,
- /*arg_attrs=*/nullptr, /*res_attrs=*/nullptr, procAttrs, inlineAttr,
- /*accessGroups=*/mlir::ArrayAttr{});
- callOp = call;
+ auto genCall = [&](mlir::FunctionType type, mlir::SymbolRefAttr callee,
+ mlir::ValueRange args) {
+ return fir::CallOp::create(builder, loc, type.getResults(), callee, args,
+ /*arg_attrs=*/nullptr, /*res_attrs=*/nullptr,
+ procAttrs, inlineAttr,
+ /*accessGroups=*/mlir::ArrayAttr{});
+ };
+ if (dispatchCallees.empty()) {
+ auto call = genCall(funcType, funcSymbolAttr, operands);
+ callOp = call;
- callNumResults = call.getNumResults();
- if (callNumResults != 0)
- callResult = call.getResult(0);
+ callNumResults = call.getNumResults();
+ if (callNumResults != 0)
+ callResult = call.getResult(0);
+ } else {
+ // Emit `if (c0) call f0 else if (c1) call f1 ... else call selected`.
+ // The abstract result conversion requires a fir.save_result right after
+ // each call, so a result in memory is saved in every branch.
+ llvm::SmallVector<mlir::Type> resultTypes;
+ if (!caller.mustSaveResult())
+ resultTypes.append(funcType.getResults().begin(),
+ funcType.getResults().end());
+ auto finishBranch = [&](fir::CallOp call) {
+ if (caller.mustSaveResult()) {
+ assert(allocatedResult.has_value());
+ fir::SaveResultOp::create(builder, loc, call.getResult(0),
+ fir::getBase(*allocatedResult),
+ arrayResultShape, resultLengths);
+ } else if (!resultTypes.empty()) {
+ fir::ResultOp::create(
+ builder, loc,
+ builder.createConvert(loc, resultTypes[0], call.getResult(0)));
+ }
+ };
+ fir::IfOp outerIf;
+ for (auto [condition, callee] : dispatchCallees) {
+ auto ifOp = fir::IfOp::create(builder, loc, resultTypes, condition,
+ /*withElseRegion=*/true);
+ if (!outerIf)
+ outerIf = ifOp;
+ else if (!resultTypes.empty())
+ fir::ResultOp::create(builder, loc, ifOp.getResults());
+ builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+ DirectCallSignature signature =
+ getDirectCallSignature(loc, converter, callSiteType, callee);
+ if (auto modifiedFuncType = getTypeWithIgnoreTkrC(
+ signature.type, caller, builder.getContext())) {
+ signature.type = *modifiedFuncType;
+ signature.mustCast = true;
+ }
+ mlir::SymbolRefAttr calleeAttr =
+ builder.getSymbolRefAttr(callee.getSymName());
+ llvm::SmallVector<mlir::Value> args;
+ if (signature.mustCast) {
+ mlir::Value address = fir::AddrOfOp::create(
+ builder, loc, callee.getFunctionType(), calleeAttr);
+ args.push_back(builder.createConvert(loc, signature.type, address));
+ calleeAttr = {};
+ }
+ genCallArguments(loc, converter, caller, signature.type, args);
+ if (signature.addHostAssociations)
+ args.push_back(converter.hostAssocTupleValue());
+ finishBranch(genCall(signature.type, calleeAttr, args));
+ builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+ }
+ finishBranch(genCall(funcType, funcSymbolAttr, operands));
+ builder.setInsertionPointAfter(outerIf);
+ callOp = outerIf;
+ callNumResults = outerIf.getNumResults();
+ if (callNumResults != 0)
+ callResult = outerIf.getResult(0);
+ }
}
std::optional<Fortran::evaluate::DynamicType> retTy =
@@ -872,7 +959,7 @@ Fortran::lower::genCallOpAndResult(
const bool mustFinalizeResult =
!isElemental && mustDestroyOrFinalizeFunctionResult(callSiteType, retTy);
- if (caller.mustSaveResult()) {
+ if (caller.mustSaveResult() && dispatchCallees.empty()) {
assert(allocatedResult.has_value());
fir::SaveResultOp::create(builder, loc, callResult,
fir::getBase(*allocatedResult), arrayResultShape,
@@ -1147,6 +1234,12 @@ extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
for (auto resUser : insertBefore->getResult(0).getUsers())
if (auto save_result = llvm::dyn_cast<fir::SaveResultOp>(resUser))
save_result.getMemrefMutable().assign(declare.getFirBase());
+ // A call with a callee chosen at runtime saves the result in each branch.
+ if (insertBefore && insertBefore->getNumRegions() != 0)
+ insertBefore->walk([&](fir::SaveResultOp saveResult) {
+ if (saveResult.getMemref() == firBase)
+ saveResult.getMemrefMutable().assign(declare.getFirBase());
+ });
return declare;
}
namespace {
diff --git a/flang/test/Fir/OpenMP/dispatch.fir b/flang/test/Fir/OpenMP/dispatch.fir
index 6e5670dd461f3..6a3bbc857eb24 100644
--- a/flang/test/Fir/OpenMP/dispatch.fir
+++ b/flang/test/Fir/OpenMP/dispatch.fir
@@ -60,58 +60,61 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
}
return
}
- // novariants: runtime select of base/variant address, then indirect call.
+ // novariants: runtime branch between direct calls to the base and the variant.
// CHECK-LABEL: func.func @omp_dispatch_novariants
func.func @omp_dispatch_novariants(%cond : i1) {
// CHECK: omp.dispatch novariants(%[[COND:.*]]) {
omp.dispatch novariants(%cond) {
- // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- %variant = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- // CHECK: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- %base = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[BASE]], %[[VARIANT]] : () -> ()
- %target = arith.select %cond, %base, %variant : () -> ()
- // CHECK: fir.call %[[TARGET]]()
- fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: fir.if %[[COND]] {
+ fir.if %cond {
+ // CHECK-NEXT: fir.call @_QMfuncsPfoo_dispatch()
+ fir.call @_QMfuncsPfoo_dispatch() fastmath<contract> : () -> ()
+ // CHECK-NEXT: } else {
+ } else {
+ // CHECK-NEXT: fir.call @_QMfuncsPfoo_variant()
+ fir.call @_QMfuncsPfoo_variant() fastmath<contract> : () -> ()
+ }
// CHECK: omp.terminator
omp.terminator
}
return
}
- // nocontext: runtime select of base/variant address, then indirect call.
+ // nocontext: runtime branch between direct calls to the base and the variant.
// CHECK-LABEL: func.func @omp_dispatch_nocontext
func.func @omp_dispatch_nocontext(%cond : i1) {
// CHECK: omp.dispatch nocontext(%[[COND:.*]]) {
omp.dispatch nocontext(%cond) {
- // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- %variant = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- // CHECK: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- %base = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[BASE]], %[[VARIANT]] : () -> ()
- %target = arith.select %cond, %base, %variant : () -> ()
- // CHECK: fir.call %[[TARGET]]()
- fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: fir.if %[[COND]] {
+ fir.if %cond {
+ // CHECK-NEXT: fir.call @_QMfuncsPfoo_dispatch()
+ fir.call @_QMfuncsPfoo_dispatch() fastmath<contract> : () -> ()
+ // CHECK-NEXT: } else {
+ } else {
+ // CHECK-NEXT: fir.call @_QMfuncsPfoo_variant()
+ fir.call @_QMfuncsPfoo_variant() fastmath<contract> : () -> ()
+ }
// CHECK: omp.terminator
omp.terminator
}
return
}
// nocontext with multiple matching variants: the frontend re-resolves variant
- // selection with the dispatch construct removed, so the runtime select picks
+ // selection with the dispatch construct removed, so the runtime branch picks
// between the two variants (device={kind(host)} vs construct={dispatch}),
// not the base procedure.
// CHECK-LABEL: func.func @omp_dispatch_nocontext_variant
func.func @omp_dispatch_nocontext_variant(%cond : i1) {
// CHECK: omp.dispatch nocontext(%[[COND:.*]]) {
omp.dispatch nocontext(%cond) {
- // CHECK: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- %variant = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- // CHECK: %[[HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- %host = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- // CHECK: %[[TARGET:.*]] = arith.select %[[COND]], %[[HOST]], %[[VARIANT]] : () -> ()
- %target = arith.select %cond, %host, %variant : () -> ()
- // CHECK: fir.call %[[TARGET]]()
- fir.call %target() fastmath<contract> : () -> ()
+ // CHECK: fir.if %[[COND]] {
+ fir.if %cond {
+ // CHECK-NEXT: fir.call @_QMfuncsPhost_variant()
+ fir.call @_QMfuncsPhost_variant() fastmath<contract> : () -> ()
+ // CHECK-NEXT: } else {
+ } else {
+ // CHECK-NEXT: fir.call @_QMfuncsPdispatch_variant()
+ fir.call @_QMfuncsPdispatch_variant() fastmath<contract> : () -> ()
+ }
// CHECK: omp.terminator
omp.terminator
}
@@ -122,19 +125,23 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
func.func @omp_dispatch_novariants_nocontext(%c1 : i1, %c2 : i1) {
// CHECK: omp.dispatch nocontext(%[[C2]]) novariants(%[[C1]]) {
omp.dispatch nocontext(%c2) novariants(%c1) {
- // CHECK: %[[BOTH_VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- %variant = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- // CHECK: %[[BOTH_HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- %host = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- // CHECK: %[[CONTEXT_TARGET:.*]] = arith.select %[[C2]], %[[BOTH_HOST]], %[[BOTH_VARIANT]] : () -> ()
- %context_target = arith.select %c2, %host, %variant : () -> ()
- // CHECK: %[[BOTH_BASE:.*]] = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
- %base = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
- // CHECK: %[[BOTH_TARGET:.*]] = arith.select %[[C1]], %[[BOTH_BASE]], %[[CONTEXT_TARGET]] : () -> ()
- %target = arith.select %c1, %base, %context_target : () -> ()
- // CHECK-NEXT: fir.call %[[BOTH_TARGET]]()
- fir.call %target() fastmath<contract> : () -> ()
- // CHECK-NEXT: omp.terminator
+ // CHECK: fir.if %[[C1]] {
+ fir.if %c1 {
+ // CHECK-NEXT: fir.call @_QMfuncsPbase_routine()
+ fir.call @_QMfuncsPbase_routine() fastmath<contract> : () -> ()
+ // CHECK-NEXT: } else {
+ } else {
+ // CHECK-NEXT: fir.if %[[C2]] {
+ fir.if %c2 {
+ // CHECK-NEXT: fir.call @_QMfuncsPhost_variant()
+ fir.call @_QMfuncsPhost_variant() fastmath<contract> : () -> ()
+ // CHECK-NEXT: } else {
+ } else {
+ // CHECK-NEXT: fir.call @_QMfuncsPdispatch_variant()
+ fir.call @_QMfuncsPdispatch_variant() fastmath<contract> : () -> ()
+ }
+ }
+ // CHECK: omp.terminator
omp.terminator
}
return
diff --git a/flang/test/Integration/OpenMP/dispatch.f90 b/flang/test/Integration/OpenMP/dispatch.f90
index 249f10ba78a4b..918b7001b0a04 100644
--- a/flang/test/Integration/OpenMP/dispatch.f90
+++ b/flang/test/Integration/OpenMP/dispatch.f90
@@ -22,28 +22,32 @@
!CHECK: br label %omp.region.cont
!CHECK: omp.region.cont:
-! novariants: runtime select of base/variant address, then indirect call.
+! novariants: runtime branch between direct calls to the base and the variant.
!CHECK-LABEL: define void @test_novariants_(
!CHECK-SAME: ptr noalias %[[ARG:[0-9]+]])
!CHECK: %[[LOAD:.*]] = load i32, ptr %[[ARG]], align 4
!CHECK: %[[COND:.*]] = icmp ne i32 %[[LOAD]], 0
!CHECK: br label %omp.dispatch.region
+!CHECK: [[NV_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPfoo_variant()
+!CHECK: [[NV_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPfoo_dispatch()
!CHECK: omp.dispatch.region:
-!CHECK: %[[TARGET:.*]] = select i1 %[[COND]], ptr @_QMfuncsPfoo_dispatch, ptr @_QMfuncsPfoo_variant
-!CHECK: call void %[[TARGET]]()
-!CHECK: br label %omp.region.cont
+!CHECK-NEXT: br i1 %[[COND]], label %[[NV_BASE]], label %[[NV_VARIANT]]
!CHECK: omp.region.cont:
-! nocontext: runtime select of base/variant address, then indirect call.
+! nocontext: runtime branch between direct calls to the base and the variant.
!CHECK-LABEL: define void @test_nocontext_(
!CHECK-SAME: ptr noalias %[[NARG:[0-9]+]])
!CHECK: %[[NLOAD:.*]] = load i32, ptr %[[NARG]], align 4
!CHECK: %[[NCOND:.*]] = icmp ne i32 %[[NLOAD]], 0
!CHECK: br label %omp.dispatch.region
+!CHECK: [[NC_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPfoo_variant()
+!CHECK: [[NC_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPfoo_dispatch()
!CHECK: omp.dispatch.region:
-!CHECK: %[[NTARGET:.*]] = select i1 %[[NCOND]], ptr @_QMfuncsPfoo_dispatch, ptr @_QMfuncsPfoo_variant
-!CHECK: call void %[[NTARGET]]()
-!CHECK: br label %omp.region.cont
+!CHECK-NEXT: br i1 %[[NCOND]], label %[[NC_BASE]], label %[[NC_VARIANT]]
!CHECK: omp.region.cont:
!CHECK-LABEL: define void @test_novariants_nocontext_(
@@ -53,13 +57,58 @@
!CHECK: %[[C1_LOAD:.*]] = load i32, ptr %[[C1_ARG]], align 4
!CHECK: %[[C1_COND:.*]] = icmp ne i32 %[[C1_LOAD]], 0
!CHECK: br label %omp.dispatch.region
+!CHECK: [[BOTH_DISPATCH:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPdispatch_variant()
+!CHECK: [[BOTH_HOST:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPhost_variant()
+!CHECK: [[BOTH_CONTEXT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: br i1 %[[C2_COND]], label %[[BOTH_HOST]], label %[[BOTH_DISPATCH]]
+!CHECK: [[BOTH_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QMfuncsPbase_routine()
!CHECK: omp.dispatch.region:
-!CHECK: %[[CONTEXT_TARGET:.*]] = select i1 %[[C2_COND]], ptr @_QMfuncsPhost_variant, ptr @_QMfuncsPdispatch_variant
-!CHECK: %[[BOTH_TARGET:.*]] = select i1 %[[C1_COND]], ptr @_QMfuncsPbase_routine, ptr %[[CONTEXT_TARGET]]
-!CHECK-NEXT: call void %[[BOTH_TARGET]]()
-!CHECK-NEXT: br label %omp.region.cont
+!CHECK-NEXT: br i1 %[[C1_COND]], label %[[BOTH_BASE]], label %[[BOTH_CONTEXT]]
!CHECK: omp.region.cont:
+! Target rewriting changes the signature of a COMPLEX result and of a
+! CHARACTER(*) dummy; each branch is a direct call rewritten on its own.
+!CHECK-LABEL: define void @test_complex_result_(
+!CHECK-SAME: ptr noalias %[[CPLX_ARG:[0-9]+]], ptr noalias %{{[0-9]+}})
+!CHECK: %[[CPLX_LOAD:.*]] = load i32, ptr %[[CPLX_ARG]], align 4
+!CHECK: %[[CPLX_COND:.*]] = icmp ne i32 %[[CPLX_LOAD]], 0
+!CHECK: [[CPLX_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call {{.*}}@_QMfuncsPcomplex_variant()
+!CHECK: [[CPLX_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call {{.*}}@_QMfuncsPcomplex_base()
+!CHECK: omp.dispatch.region:
+!CHECK-NEXT: br i1 %[[CPLX_COND]], label %[[CPLX_BASE]], label %[[CPLX_VARIANT]]
+
+!CHECK-LABEL: define void @test_char_dummy_(
+!CHECK-SAME: ptr noalias %[[CHAR_ARG:[0-9]+]])
+!CHECK: %[[CHAR_LOAD:.*]] = load i32, ptr %[[CHAR_ARG]], align 4
+!CHECK: %[[CHAR_COND:.*]] = icmp ne i32 %[[CHAR_LOAD]], 0
+!CHECK: [[CHAR_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK: call void @_QMfuncsPchar_variant(ptr %{{.*}}, i64 %{{.*}})
+!CHECK: [[CHAR_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK: call void @_QMfuncsPchar_base(ptr %{{.*}}, i64 %{{.*}})
+!CHECK: omp.dispatch.region:
+!CHECK: br i1 %[[CHAR_COND]], label %[[CHAR_BASE]], label %[[CHAR_VARIANT]]
+
+! Internal procedures take the host link as a `nest` argument, which only a
+! direct call passes correctly.
+!CHECK-LABEL: define void @test_internal_(
+!CHECK-SAME: ptr noalias %[[INT_ARG:[0-9]+]])
+!CHECK: %[[TUPLE:.*]] = alloca { ptr }
+!CHECK: %[[INT_LOAD:.*]] = load i32, ptr %[[INT_ARG]], align 4
+!CHECK: %[[INT_COND:.*]] = icmp ne i32 %[[INT_LOAD]], 0
+!CHECK: [[INT_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QFtest_internalPinternal_variant(ptr %[[TUPLE]])
+!CHECK: [[INT_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK-NEXT: call void @_QFtest_internalPinternal_base(ptr %[[TUPLE]])
+!CHECK: omp.dispatch.region:
+!CHECK-NEXT: br i1 %[[INT_COND]], label %[[INT_BASE]], label %[[INT_VARIANT]]
+!CHECK: define internal void @_QFtest_internalPinternal_variant(ptr nest
+!CHECK: define internal void @_QFtest_internalPinternal_base(ptr nest
+
module funcs
implicit none
@@ -88,6 +137,26 @@ subroutine base_routine()
print *, "in base_routine"
end subroutine
+ complex function complex_variant() result(r)
+ r = (2.0, 2.0)
+ end function
+
+ complex function complex_base() result(r)
+ !$omp declare variant(complex_base:complex_variant) match(construct={dispatch})
+ r = (1.0, 1.0)
+ end function
+
+ subroutine char_variant(c)
+ character(*), intent(in) :: c
+ print *, "in char_variant ", c
+ end subroutine
+
+ subroutine char_base(c)
+ !$omp declare variant(char_base:char_variant) match(construct={dispatch})
+ character(*), intent(in) :: c
+ print *, "in char_base ", c
+ end subroutine
+
end module funcs
program dispatch_test
@@ -130,3 +199,44 @@ subroutine test_novariants_nocontext(c1, c2)
call base_routine()
end subroutine
+
+subroutine test_complex_result(cond, z)
+ use funcs
+ implicit none
+ logical :: cond
+ complex :: z
+
+ !$omp dispatch novariants(cond)
+ z = complex_base()
+
+end subroutine
+
+subroutine test_char_dummy(cond)
+ use funcs
+ implicit none
+ logical :: cond
+
+ !$omp dispatch nocontext(cond)
+ call char_base("abc")
+
+end subroutine
+
+subroutine test_internal(cond)
+ implicit none
+ logical :: cond
+ integer :: captured
+
+ captured = 1
+ !$omp dispatch novariants(cond)
+ call internal_base()
+
+contains
+ subroutine internal_variant()
+ print *, captured + 1
+ end subroutine
+
+ subroutine internal_base()
+ !$omp declare variant(internal_base:internal_variant) match(construct={dispatch})
+ print *, captured
+ end subroutine
+end subroutine
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index 26a32db6dca52..c44b33a003e81 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -87,48 +87,51 @@ program dispatch_test
!HLFIR: omp.terminator
!HLFIR: }
- ! novariants: runtime select of base/variant address, then indirect call, so
- ! the arguments are evaluated once.
+ ! novariants: a runtime branch between direct calls to the base and the
+ ! variant; the arguments are evaluated once, before the branch.
!HLFIR: %[[COND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
!HLFIR: %[[COND_I1:.*]] = fir.convert %[[COND]] : (!fir.logical<4>) -> i1
!HLFIR: omp.dispatch novariants(%[[COND_I1]]) {
!$omp dispatch novariants(cond)
- !HLFIR: %[[VARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- !HLFIR: %[[BASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- !HLFIR: %[[TARGET:.*]] = arith.select %[[COND_I1]], %[[BASE]], %[[VARIANT]] : () -> ()
- !HLFIR: fir.call %[[TARGET]]() {{.*}}: () -> ()
+ !HLFIR: fir.if %[[COND_I1]] {
+ !HLFIR-NEXT: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QMfuncsPfoo_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: }
call foo_dispatch()
- !HLFIR: omp.terminator
+ !HLFIR-NEXT: omp.terminator
!HLFIR: }
! nocontext: the dispatch construct is dropped from the OpenMP context when
- ! the condition is true, so the same base/variant runtime select is emitted.
+ ! the condition is true, so the same base/variant branch is emitted.
!HLFIR: %[[NCOND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
!HLFIR: %[[NCOND_I1:.*]] = fir.convert %[[NCOND]] : (!fir.logical<4>) -> i1
!HLFIR: omp.dispatch nocontext(%[[NCOND_I1]]) {
!$omp dispatch nocontext(cond)
- !HLFIR: %[[NVARIANT:.*]] = fir.address_of(@_QMfuncsPfoo_variant) : () -> ()
- !HLFIR: %[[NBASE:.*]] = fir.address_of(@_QMfuncsPfoo_dispatch) : () -> ()
- !HLFIR: %[[NTARGET:.*]] = arith.select %[[NCOND_I1]], %[[NBASE]], %[[NVARIANT]] : () -> ()
- !HLFIR: fir.call %[[NTARGET]]() {{.*}}: () -> ()
+ !HLFIR: fir.if %[[NCOND_I1]] {
+ !HLFIR-NEXT: fir.call @_QMfuncsPfoo_dispatch() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QMfuncsPfoo_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: }
call foo_dispatch()
- !HLFIR: omp.terminator
+ !HLFIR-NEXT: omp.terminator
!HLFIR: }
! nocontext with two matching variants: with the dispatch construct removed
! from the context, `construct={dispatch}` no longer matches and selection
- ! re-resolves to the `device={kind(host)}` variant, so the runtime select is
+ ! re-resolves to the `device={kind(host)}` variant, so the runtime branch is
! between the two variants (not the base procedure).
!HLFIR: %[[MCOND:.*]] = fir.load %{{.*}} : !fir.ref<!fir.logical<4>>
!HLFIR: %[[MCOND_I1:.*]] = fir.convert %[[MCOND]] : (!fir.logical<4>) -> i1
!HLFIR: omp.dispatch nocontext(%[[MCOND_I1]]) {
!$omp dispatch nocontext(cond)
- !HLFIR: %[[MVARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- !HLFIR: %[[MHOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- !HLFIR: %[[MTARGET:.*]] = arith.select %[[MCOND_I1]], %[[MHOST]], %[[MVARIANT]] : () -> ()
- !HLFIR: fir.call %[[MTARGET]]() {{.*}}: () -> ()
+ !HLFIR: fir.if %[[MCOND_I1]] {
+ !HLFIR-NEXT: fir.call @_QMfuncsPhost_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QMfuncsPdispatch_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: }
call base_routine()
- !HLFIR: omp.terminator
+ !HLFIR-NEXT: omp.terminator
!HLFIR: }
end program
@@ -147,14 +150,17 @@ subroutine test_novariants_nocontext(c1, c2)
!HLFIR: %[[C1_I1:.*]] = fir.convert %[[C1_LOAD]] : (!fir.logical<4>) -> i1
!HLFIR: omp.dispatch nocontext(%[[C2_I1]]) novariants(%[[C1_I1]]) {
!$omp dispatch novariants(c1) nocontext(c2)
- !HLFIR: %[[BOTH_VARIANT:.*]] = fir.address_of(@_QMfuncsPdispatch_variant) : () -> ()
- !HLFIR: %[[BOTH_HOST:.*]] = fir.address_of(@_QMfuncsPhost_variant) : () -> ()
- !HLFIR: %[[CONTEXT_TARGET:.*]] = arith.select %[[C2_I1]], %[[BOTH_HOST]], %[[BOTH_VARIANT]] : () -> ()
- !HLFIR: %[[BOTH_BASE:.*]] = fir.address_of(@_QMfuncsPbase_routine) : () -> ()
- !HLFIR: %[[BOTH_TARGET:.*]] = arith.select %[[C1_I1]], %[[BOTH_BASE]], %[[CONTEXT_TARGET]] : () -> ()
- !HLFIR: fir.call %[[BOTH_TARGET]]() {{.*}}: () -> ()
+ !HLFIR: fir.if %[[C1_I1]] {
+ !HLFIR-NEXT: fir.call @_QMfuncsPbase_routine() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.if %[[C2_I1]] {
+ !HLFIR-NEXT: fir.call @_QMfuncsPhost_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QMfuncsPdispatch_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: }
call base_routine()
- !HLFIR: omp.terminator
+ !HLFIR-NEXT: omp.terminator
!HLFIR: }
end subroutine
@@ -173,10 +179,11 @@ subroutine external_base()
!HLFIR: omp.dispatch novariants(%[[EXT_COND:.*]]) {
!$omp dispatch novariants(cond)
- !HLFIR: %[[EXT_VARIANT:.*]] = fir.address_of(@_QPexternal_variant) : () -> ()
- !HLFIR: %[[EXT_BASE:.*]] = fir.address_of(@_QPexternal_base) : () -> ()
- !HLFIR: %[[EXT_TARGET:.*]] = arith.select %[[EXT_COND]], %[[EXT_BASE]], %[[EXT_VARIANT]] : () -> ()
- !HLFIR-NEXT: fir.call %[[EXT_TARGET]]() {{.*}}: () -> ()
+ !HLFIR-NEXT: fir.if %[[EXT_COND]] {
+ !HLFIR-NEXT: fir.call @_QPexternal_base() {{.*}}: () -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QPexternal_variant() {{.*}}: () -> ()
+ !HLFIR-NEXT: }
call external_base()
!HLFIR-NEXT: omp.terminator
end subroutine
@@ -210,10 +217,13 @@ integer function external_base_func(value) result(output)
!HLFIR: omp.dispatch nocontext(%[[EXT_NCOND]]) {
!$omp dispatch nocontext(cond)
!HLFIR: %[[EXT_VALUE:.*]] = fir.load %[[EXT_VALUE_ADDR]]#0 : !fir.ref<i32>
- !HLFIR: %[[EXT_DISPATCH:.*]] = fir.address_of(@_QPexternal_dispatch_func) : (i32) -> i32
- !HLFIR: %[[EXT_HOST:.*]] = fir.address_of(@_QPexternal_host_func) : (i32) -> i32
- !HLFIR: %[[EXT_NTARGET:.*]] = arith.select %[[EXT_NCOND]], %[[EXT_HOST]], %[[EXT_DISPATCH]] : (i32) -> i32
- !HLFIR-NEXT: %[[EXT_RESULT:.*]] = fir.call %[[EXT_NTARGET]](%[[EXT_VALUE]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: %[[EXT_RESULT:.*]] = fir.if %[[EXT_NCOND]] -> (i32) {
+ !HLFIR-NEXT: %[[EXT_HOST:.*]] = fir.call @_QPexternal_host_func(%[[EXT_VALUE]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.result %[[EXT_HOST]] : i32
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: %[[EXT_DISPATCH:.*]] = fir.call @_QPexternal_dispatch_func(%[[EXT_VALUE]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.result %[[EXT_DISPATCH]] : i32
+ !HLFIR-NEXT: }
!HLFIR-NEXT: hlfir.assign %[[EXT_RESULT]] to %[[EXT_RESULT_ADDR]]#0 : i32, !fir.ref<i32>
res = external_base_func(value)
!HLFIR-NEXT: omp.terminator
@@ -263,27 +273,37 @@ subroutine target_base(value)
!HLFIR: omp.dispatch nocontext(%[[ARG_C2:.*]]) novariants(%[[ARG_C1:.*]]) {
!$omp dispatch novariants(c1) nocontext(c2)
- !HLFIR-NOT: arith.select
+ !HLFIR-NOT: fir.if
!HLFIR: %[[BOTH_ARG_RESULT:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
- !HLFIR-NEXT: %[[ARG_DISPATCH:.*]] = fir.address_of(@_QPtarget_dispatch) : (i32) -> ()
- !HLFIR-NEXT: %[[ARG_HOST:.*]] = fir.address_of(@_QPtarget_host) : (i32) -> ()
- !HLFIR-NEXT: %[[ARG_CONTEXT:.*]] = arith.select %[[ARG_C2]], %[[ARG_HOST]], %[[ARG_DISPATCH]] : (i32) -> ()
- !HLFIR-NEXT: %[[ARG_BASE:.*]] = fir.address_of(@_QPtarget_base) : (i32) -> ()
- !HLFIR-NEXT: %[[ARG_TARGET:.*]] = arith.select %[[ARG_C1]], %[[ARG_BASE]], %[[ARG_CONTEXT]] : (i32) -> ()
- !HLFIR-NEXT: fir.call %[[ARG_TARGET]](%[[BOTH_ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: fir.if %[[ARG_C1]] {
+ !HLFIR-NEXT: fir.call @_QPtarget_base(%[[BOTH_ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.if %[[ARG_C2]] {
+ !HLFIR-NEXT: fir.call @_QPtarget_host(%[[BOTH_ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QPtarget_dispatch(%[[BOTH_ARG_RESULT]]) {{.*}}: (i32) -> ()
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: }
!HLFIR-NEXT: omp.terminator
call target_base(argument_base(3))
!HLFIR: omp.dispatch nocontext(%[[FUNC_C2:.*]]) novariants(%[[FUNC_C1:.*]]) {
!$omp dispatch novariants(c1) nocontext(c2)
- !HLFIR-NOT: arith.select
+ !HLFIR-NOT: fir.if
!HLFIR: %[[INNER_RESULT:.*]] = fir.call @_QPargument_host(%{{.*}}) {{.*}}: (i32) -> i32
- !HLFIR-NEXT: %[[FUNC_DISPATCH:.*]] = fir.address_of(@_QPargument_dispatch) : (i32) -> i32
- !HLFIR-NEXT: %[[FUNC_HOST:.*]] = fir.address_of(@_QPargument_host) : (i32) -> i32
- !HLFIR-NEXT: %[[FUNC_CONTEXT:.*]] = arith.select %[[FUNC_C2]], %[[FUNC_HOST]], %[[FUNC_DISPATCH]] : (i32) -> i32
- !HLFIR-NEXT: %[[FUNC_BASE:.*]] = fir.address_of(@_QPargument_base) : (i32) -> i32
- !HLFIR-NEXT: %[[FUNC_TARGET:.*]] = arith.select %[[FUNC_C1]], %[[FUNC_BASE]], %[[FUNC_CONTEXT]] : (i32) -> i32
- !HLFIR-NEXT: %[[OUTER_RESULT:.*]] = fir.call %[[FUNC_TARGET]](%[[INNER_RESULT]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: %[[OUTER_RESULT:.*]] = fir.if %[[FUNC_C1]] -> (i32) {
+ !HLFIR-NEXT: %[[FUNC_BASE:.*]] = fir.call @_QPargument_base(%[[INNER_RESULT]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.result %[[FUNC_BASE]] : i32
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: %[[FUNC_CONTEXT:.*]] = fir.if %[[FUNC_C2]] -> (i32) {
+ !HLFIR-NEXT: %[[FUNC_HOST:.*]] = fir.call @_QPargument_host(%[[INNER_RESULT]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.result %[[FUNC_HOST]] : i32
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: %[[FUNC_DISPATCH:.*]] = fir.call @_QPargument_dispatch(%[[INNER_RESULT]]) {{.*}}: (i32) -> i32
+ !HLFIR-NEXT: fir.result %[[FUNC_DISPATCH]] : i32
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: fir.result %[[FUNC_CONTEXT]] : i32
+ !HLFIR-NEXT: }
!HLFIR-NEXT: hlfir.assign %[[OUTER_RESULT]] to %{{.*}} : i32, !fir.ref<i32>
!HLFIR-NEXT: omp.terminator
result = argument_base(argument_base(3))
@@ -329,10 +349,13 @@ subroutine cast_base(values)
!$omp dispatch novariants(c1)
!HLFIR: %[[NV_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[NV_DISPATCH:.*]] = fir.convert %[[NV_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: fir.if %[[CAST_NV]] {
!HLFIR-NEXT: %[[NV_BASE_ADDR:.*]] = fir.address_of(@_QPcast_base) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[NV_BASE:.*]] = fir.convert %[[NV_BASE_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
- !HLFIR-NEXT: %[[NV_TARGET:.*]] = arith.select %[[CAST_NV]], %[[NV_BASE]], %[[NV_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
- !HLFIR-NEXT: fir.call %[[NV_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[NV_BASE]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call %[[NV_DISPATCH]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: }
!HLFIR-NEXT: omp.terminator
call cast_base(values)
@@ -340,10 +363,13 @@ subroutine cast_base(values)
!$omp dispatch nocontext(c2)
!HLFIR: %[[NC_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[NC_DISPATCH:.*]] = fir.convert %[[NC_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: fir.if %[[CAST_NC]] {
!HLFIR-NEXT: %[[NC_HOST_ADDR:.*]] = fir.address_of(@_QPcast_host) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[NC_HOST:.*]] = fir.convert %[[NC_HOST_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
- !HLFIR-NEXT: %[[NC_TARGET:.*]] = arith.select %[[CAST_NC]], %[[NC_HOST]], %[[NC_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
- !HLFIR-NEXT: fir.call %[[NC_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[NC_HOST]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call %[[NC_DISPATCH]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: }
!HLFIR-NEXT: omp.terminator
call cast_base(values)
@@ -355,17 +381,90 @@ subroutine cast_base(values)
!$omp dispatch novariants(c1) nocontext(c2)
!HLFIR: %[[BOTH_DISPATCH_ADDR:.*]] = fir.address_of(@_QPcast_dispatch) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[CAST_DISPATCH:.*]] = fir.convert %[[BOTH_DISPATCH_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
- !HLFIR-NEXT: %[[BOTH_HOST_ADDR:.*]] = fir.address_of(@_QPcast_host) : (!fir.box<!fir.array<?xf32>>) -> ()
- !HLFIR-NEXT: %[[CAST_HOST:.*]] = fir.convert %[[BOTH_HOST_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
- !HLFIR-NEXT: %[[CAST_CONTEXT:.*]] = arith.select %[[CAST_C2_I1]], %[[CAST_HOST]], %[[CAST_DISPATCH]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.if %[[CAST_C1_I1]] {
!HLFIR-NEXT: %[[BOTH_BASE_ADDR:.*]] = fir.address_of(@_QPcast_base) : (!fir.box<!fir.array<?xf32>>) -> ()
!HLFIR-NEXT: %[[CAST_BASE:.*]] = fir.convert %[[BOTH_BASE_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
- !HLFIR-NEXT: %[[CAST_TARGET:.*]] = arith.select %[[CAST_C1_I1]], %[[CAST_BASE]], %[[CAST_CONTEXT]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
- !HLFIR-NEXT: fir.call %[[CAST_TARGET]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: fir.call %[[CAST_BASE]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.if %[[CAST_C2_I1]] {
+ !HLFIR-NEXT: %[[BOTH_HOST_ADDR:.*]] = fir.address_of(@_QPcast_host) : (!fir.box<!fir.array<?xf32>>) -> ()
+ !HLFIR-NEXT: %[[CAST_HOST:.*]] = fir.convert %[[BOTH_HOST_ADDR]] : ((!fir.box<!fir.array<?xf32>>) -> ()) -> ((!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ())
+ !HLFIR-NEXT: fir.call %[[CAST_HOST]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call %[[CAST_DISPATCH]](%[[VALUES]]#0) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: }
!HLFIR-NEXT: omp.terminator
call cast_base(values)
end subroutine
+! An internal base procedure takes the host association tuple, which an
+! external variant does not, so each branch passes its own callee's arguments.
+!HLFIR-LABEL: func @_QPtest_host_association(
+subroutine test_host_association(c1, c2)
+ implicit none
+ logical :: c1, c2
+ integer :: captured, value
+ interface
+ subroutine external_value_variant(value)
+ integer, intent(out) :: value
+ end subroutine
+ end interface
+
+ !HLFIR: %[[VALUE:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFtest_host_associationEvalue"}
+ !HLFIR: %[[TUPLE:.*]] = fir.alloca tuple<!fir.ref<i32>>
+ captured = 37
+
+ !HLFIR: omp.dispatch novariants(%[[HA_NV:.*]]) {
+ !$omp dispatch novariants(c1)
+ !HLFIR-NEXT: fir.if %[[HA_NV]] {
+ !HLFIR-NEXT: fir.call @_QFtest_host_associationPinternal_base(%[[VALUE]]#0, %[[TUPLE]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QPexternal_value_variant(%[[VALUE]]#0) {{.*}}: (!fir.ref<i32>) -> ()
+ !HLFIR-NEXT: }
+ call internal_base(value)
+ !HLFIR-NEXT: omp.terminator
+
+ !HLFIR: omp.dispatch nocontext(%[[HA_NC:.*]]) {
+ !$omp dispatch nocontext(c2)
+ !HLFIR-NEXT: fir.if %[[HA_NC]] {
+ !HLFIR-NEXT: fir.call @_QFtest_host_associationPinternal_base(%[[VALUE]]#0, %[[TUPLE]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QPexternal_value_variant(%[[VALUE]]#0) {{.*}}: (!fir.ref<i32>) -> ()
+ !HLFIR-NEXT: }
+ call internal_base(value)
+ !HLFIR-NEXT: omp.terminator
+
+ ! Both procedures are internal and have the same signature; each is still
+ ! called directly with the tuple.
+ !HLFIR: omp.dispatch novariants(%[[HB_NV:.*]]) {
+ !$omp dispatch novariants(c1)
+ !HLFIR-NEXT: fir.if %[[HB_NV]] {
+ !HLFIR-NEXT: fir.call @_QFtest_host_associationPinternal_both(%[[VALUE]]#0, %[[TUPLE]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.call @_QFtest_host_associationPinternal_variant(%[[VALUE]]#0, %[[TUPLE]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ !HLFIR-NEXT: }
+ call internal_both(value)
+ !HLFIR-NEXT: omp.terminator
+contains
+ subroutine internal_base(value)
+ !$omp declare variant(internal_base:external_value_variant) match(construct={dispatch})
+ integer, intent(out) :: value
+ value = captured
+ end subroutine
+
+ subroutine internal_variant(value)
+ integer, intent(out) :: value
+ value = captured + 1
+ end subroutine
+
+ subroutine internal_both(value)
+ !$omp declare variant(internal_both:internal_variant) match(construct={dispatch})
+ integer, intent(out) :: value
+ value = captured
+ end subroutine
+end subroutine
+
!HLFIR-DAG: func.func private @_QPexternal_variant()
!HLFIR-DAG: func.func private @_QPexternal_base()
!HLFIR-DAG: func.func private @_QPexternal_dispatch_func(i32) -> i32
>From 636ae6245c26f49a358ad9f61f48e8c83af46048 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Tue, 6 Oct 2026 12:33:44 -0500
Subject: [PATCH 10/12] Accounting for the changes in master.
---
flang/test/Fir/OpenMP/dispatch.fir | 4 ++--
flang/test/Integration/OpenMP/dispatch.f90 | 4 ++--
flang/test/Lower/OpenMP/dispatch.f90 | 4 ++--
3 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/flang/test/Fir/OpenMP/dispatch.fir b/flang/test/Fir/OpenMP/dispatch.fir
index 6a3bbc857eb24..f122695556012 100644
--- a/flang/test/Fir/OpenMP/dispatch.fir
+++ b/flang/test/Fir/OpenMP/dispatch.fir
@@ -11,7 +11,7 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
%3 = fir.call @_FortranAioBeginExternalListOutput(%c6_i32, %2, %c35_i32) fastmath<contract> : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
%4 = fir.address_of(@_QQclX696E20666F6F5F76617269616E74) : !fir.ref<!fir.char<1,14>>
%c14 = arith.constant 14 : index
- %5:2 = hlfir.declare %4 typeparams %c14 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX696E20666F6F5F76617269616E74"} : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
+ %5:2 = hlfir.declare %4 typeparams %c14 uniq_name("_QQclX696E20666F6F5F76617269616E74") fortran_attrs<parameter> : (!fir.ref<!fir.char<1,14>>, index) -> (!fir.ref<!fir.char<1,14>>, !fir.ref<!fir.char<1,14>>)
%6 = fir.convert %5#0 : (!fir.ref<!fir.char<1,14>>) -> !fir.ref<i8>
%7 = fir.convert %c14 : (index) -> i64
%8 = fir.call @_FortranAioOutputAscii(%3, %6, %7) fastmath<contract> : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
@@ -28,7 +28,7 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vec
%3 = fir.call @_FortranAioBeginExternalListOutput(%c6_i32, %2, %c40_i32) fastmath<contract> : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
%4 = fir.address_of(@_QQclX696E20666F6F5F6469737061746368) : !fir.ref<!fir.char<1,15>>
%c15 = arith.constant 15 : index
- %5:2 = hlfir.declare %4 typeparams %c15 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX696E20666F6F5F6469737061746368"} : (!fir.ref<!fir.char<1,15>>, index) -> (!fir.ref<!fir.char<1,15>>, !fir.ref<!fir.char<1,15>>)
+ %5:2 = hlfir.declare %4 typeparams %c15 uniq_name("_QQclX696E20666F6F5F6469737061746368") fortran_attrs<parameter> : (!fir.ref<!fir.char<1,15>>, index) -> (!fir.ref<!fir.char<1,15>>, !fir.ref<!fir.char<1,15>>)
%6 = fir.convert %5#0 : (!fir.ref<!fir.char<1,15>>) -> !fir.ref<i8>
%7 = fir.convert %c15 : (index) -> i64
%8 = fir.call @_FortranAioOutputAscii(%3, %6, %7) fastmath<contract> : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
diff --git a/flang/test/Integration/OpenMP/dispatch.f90 b/flang/test/Integration/OpenMP/dispatch.f90
index 918b7001b0a04..cc3743279691a 100644
--- a/flang/test/Integration/OpenMP/dispatch.f90
+++ b/flang/test/Integration/OpenMP/dispatch.f90
@@ -75,9 +75,9 @@
!CHECK-SAME: ptr noalias %[[CPLX_ARG:[0-9]+]], ptr noalias %{{[0-9]+}})
!CHECK: %[[CPLX_LOAD:.*]] = load i32, ptr %[[CPLX_ARG]], align 4
!CHECK: %[[CPLX_COND:.*]] = icmp ne i32 %[[CPLX_LOAD]], 0
-!CHECK: [[CPLX_VARIANT:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK: [[CPLX_VARIANT:omp\.dispatch\.region[0-9]+]]: {{.*}}; preds = %omp.dispatch.region{{$}}
!CHECK-NEXT: call {{.*}}@_QMfuncsPcomplex_variant()
-!CHECK: [[CPLX_BASE:omp\.dispatch\.region[0-9]+]]:{{[^,]*$}}
+!CHECK: [[CPLX_BASE:omp\.dispatch\.region[0-9]+]]: {{.*}}; preds = %omp.dispatch.region{{$}}
!CHECK-NEXT: call {{.*}}@_QMfuncsPcomplex_base()
!CHECK: omp.dispatch.region:
!CHECK-NEXT: br i1 %[[CPLX_COND]], label %[[CPLX_BASE]], label %[[CPLX_VARIANT]]
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index c44b33a003e81..a5257be0ec0ac 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -210,7 +210,7 @@ integer function external_base_func(value) result(output)
end interface
!HLFIR: %[[EXT_COND_ADDR:.*]]:2 = hlfir.declare %[[EXT_COND_ARG]]
- !HLFIR: %[[EXT_RESULT_ADDR:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFtest_external_nocontextEres"}
+ !HLFIR: %[[EXT_RESULT_ADDR:.*]]:2 = hlfir.declare %{{.*}} uniq_name("_QFtest_external_nocontextEres")
!HLFIR: %[[EXT_VALUE_ADDR:.*]]:2 = hlfir.declare %[[EXT_VALUE_ARG]]
!HLFIR: %[[EXT_COND_LOAD:.*]] = fir.load %[[EXT_COND_ADDR]]#0 : !fir.ref<!fir.logical<4>>
!HLFIR: %[[EXT_NCOND:.*]] = fir.convert %[[EXT_COND_LOAD]] : (!fir.logical<4>) -> i1
@@ -411,7 +411,7 @@ subroutine external_value_variant(value)
end subroutine
end interface
- !HLFIR: %[[VALUE:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFtest_host_associationEvalue"}
+ !HLFIR: %[[VALUE:.*]]:2 = hlfir.declare %{{.*}} uniq_name("_QFtest_host_associationEvalue")
!HLFIR: %[[TUPLE:.*]] = fir.alloca tuple<!fir.ref<i32>>
captured = 37
>From f13c35e60a053591d43f63467b22ee07a6ae4926 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Wed, 7 Oct 2026 09:26:31 -0500
Subject: [PATCH 11/12] Changes in flang/test/Lower/OpenMP/dispatch.f90 1)
Incorporating user={condition(score(2): .true.)}) to handle
variant(base_routine:dispatch_variant) being declared below
variant(base_routine:host_variant). 2) Added an extra test with return value
from all variants.
---
flang/test/Lower/OpenMP/dispatch.f90 | 54 +++++++++++++++++++++++++++-
1 file changed, 53 insertions(+), 1 deletion(-)
diff --git a/flang/test/Lower/OpenMP/dispatch.f90 b/flang/test/Lower/OpenMP/dispatch.f90
index a5257be0ec0ac..5769fc42371bc 100644
--- a/flang/test/Lower/OpenMP/dispatch.f90
+++ b/flang/test/Lower/OpenMP/dispatch.f90
@@ -42,8 +42,8 @@ subroutine host_variant()
! `construct={dispatch}` and `host_variant` matches `device={kind(host)}`.
!HLFIR-LABEL: func @_QMfuncsPbase_routine
subroutine base_routine()
- !$omp declare variant(base_routine:dispatch_variant) match(construct={dispatch})
!$omp declare variant(base_routine:host_variant) match(device={kind(host)})
+ !$omp declare variant(base_routine:dispatch_variant) match(construct={dispatch}, user={condition(score(2): .true.)})
print *, "in base_routine"
end subroutine
@@ -465,6 +465,58 @@ subroutine internal_both(value)
end subroutine
end subroutine
+! Each array result is saved in its call's branch to the same result storage.
+!HLFIR-LABEL: func @_QPtest_dispatch_array_result(
+subroutine test_dispatch_array_result(nv, nc, values)
+ implicit none
+ logical :: nv, nc
+ integer :: values(3)
+ interface
+ function array_dispatch(value) result(output)
+ integer, value :: value
+ integer :: output(3)
+ end function
+ function array_user(value) result(output)
+ integer, value :: value
+ integer :: output(3)
+ end function
+ function array_base(value) result(output)
+ import :: array_dispatch, array_user
+ !$omp declare variant(array_base:array_dispatch) match(construct={dispatch})
+ !$omp declare variant(array_base:array_user) match(user={condition(.true.)})
+ integer, value :: value
+ integer :: output(3)
+ end function
+ integer function array_argument()
+ end function
+ end interface
+
+ !HLFIR: omp.dispatch nocontext(%[[ARRAY_NC:.*]]) novariants(%[[ARRAY_NV:.*]]) {
+ !HLFIR: %[[ARRAY_ARG:.*]] = fir.call @_QParray_argument() {{.*}}: () -> i32
+ !HLFIR-NOT: fir.call
+ !HLFIR: %[[ARRAY_SHAPE:.*]] = fir.shape %{{.*}} : (index) -> !fir.shape<1>
+ !HLFIR-NEXT: %[[ARRAY_EXPR:.*]] = hlfir.eval_in_mem shape %[[ARRAY_SHAPE]] : (!fir.shape<1>) -> !hlfir.expr<3xi32> {
+ !HLFIR-NEXT: ^bb0(%[[ARRAY_STORAGE:[^:]+]]: !fir.ref<!fir.array<3xi32>>):
+ !HLFIR-NEXT: fir.if %[[ARRAY_NV]] {
+ !HLFIR-NEXT: %[[ARRAY_BASE:.*]] = fir.call @_QParray_base(%[[ARRAY_ARG]]) {{.*}}: (i32) -> !fir.array<3xi32>
+ !HLFIR-NEXT: fir.save_result %[[ARRAY_BASE]] to %[[ARRAY_STORAGE]](%[[ARRAY_SHAPE]]) : !fir.array<3xi32>, !fir.ref<!fir.array<3xi32>>, !fir.shape<1>
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: fir.if %[[ARRAY_NC]] {
+ !HLFIR-NEXT: %[[ARRAY_USER:.*]] = fir.call @_QParray_user(%[[ARRAY_ARG]]) {{.*}}: (i32) -> !fir.array<3xi32>
+ !HLFIR-NEXT: fir.save_result %[[ARRAY_USER]] to %[[ARRAY_STORAGE]](%[[ARRAY_SHAPE]]) : !fir.array<3xi32>, !fir.ref<!fir.array<3xi32>>, !fir.shape<1>
+ !HLFIR-NEXT: } else {
+ !HLFIR-NEXT: %[[ARRAY_DISPATCH:.*]] = fir.call @_QParray_dispatch(%[[ARRAY_ARG]]) {{.*}}: (i32) -> !fir.array<3xi32>
+ !HLFIR-NEXT: fir.save_result %[[ARRAY_DISPATCH]] to %[[ARRAY_STORAGE]](%[[ARRAY_SHAPE]]) : !fir.array<3xi32>, !fir.ref<!fir.array<3xi32>>, !fir.shape<1>
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: }
+ !HLFIR-NEXT: hlfir.assign %[[ARRAY_EXPR]] to %{{.*}} : !hlfir.expr<3xi32>, !fir.ref<!fir.array<3xi32>>
+ !HLFIR-NEXT: hlfir.destroy %[[ARRAY_EXPR]] : !hlfir.expr<3xi32>
+ !HLFIR-NEXT: omp.terminator
+ !$omp dispatch novariants(nv) nocontext(nc)
+ values = array_base(array_argument())
+end subroutine
+
!HLFIR-DAG: func.func private @_QPexternal_variant()
!HLFIR-DAG: func.func private @_QPexternal_base()
!HLFIR-DAG: func.func private @_QPexternal_dispatch_func(i32) -> i32
>From 39d3f9db7ce03a439108bcb81418ece17aa4b143 Mon Sep 17 00:00:00 2001
From: Sunil Kuravinakop <koops at hpe.com>
Date: Wed, 7 Oct 2026 11:40:38 -0500
Subject: [PATCH 12/12] Formatting error.
---
flang/lib/Lower/ConvertCall.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 361478f5d570c..32d8c751a496f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -19,8 +19,8 @@
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/CustomIntrinsicCall.h"
#include "flang/Lower/HlfirIntrinsics.h"
-#include "flang/Lower/OpenMP.h"
#include "flang/Lower/OpenACC.h"
+#include "flang/Lower/OpenMP.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
More information about the flang-commits
mailing list