[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
Thu Oct 1 01:37:52 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 1/8] 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 df14d13b76a4bdd..a815cb229871987 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 a554bb61a68fb2b..9eb2e8fd8ec8fd8 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 380dfa14eaae1e8..160ab22c20b9bd1 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 000000000000000..d1a437be5664b6c
--- /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 01370af0a00a7cc..860befaf43247b0 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 2/8] 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 863a4ebc897d4b1..a21cc4be0f6d334 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 8c70c8145b82000..eef88028df91ca4 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 b871f630d3dae42..e5a5a479cf6c9c9 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 6b0e0cf606f48f0..02149a48b063808 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 a815cb229871987..dc88184c7663ef0 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 b52c03ff63fed04..7b1bf0b67a8c6a8 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 7fde1825b006a23..f1f9643e54cbebf 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 000000000000000..6e5670dd461f376
--- /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 000000000000000..202ceeaec850a7c
--- /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 160ab22c20b9bd1..ccf32f2dad19376 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 d1a437be5664b6c..1dc562906738f85 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 af0d6856ab9480c..ad617a7afe9c4f8 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 3/8] 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 a21cc4be0f6d334..6dfc96b6ecc287b 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 9885345bed3a5cc..e2db53f938c77ce 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 eef88028df91ca4..cc6542b302b90fb 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 dc88184c7663ef0..c50f64e4af05faa 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 1dc562906738f85..976441bbfd5fe40 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 4/8] 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 cc6542b302b90fb..47a5ab5c1430b9a 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 976441bbfd5fe40..daa8a43c89b4bc3 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 5/8] 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 202ceeaec850a7c..249f10ba78a4b06 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 daa8a43c89b4bc3..3a309f03b26107c 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 6/8] 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 02149a48b063808..6cfcc85024dc00a 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 7/8] 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 3a309f03b26107c..7e85c7e2bc8e491 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 8/8] 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 4efaafb17a25489..7ee24e896d62aa8 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
More information about the flang-commits
mailing list