[flang-commits] [flang] [flang][OpenMP] Lowering support for declare variant. (PR #206988)

Abid Qadeer via flang-commits flang-commits at lists.llvm.org
Wed Jul 1 06:51:52 PDT 2026


https://github.com/abidh created https://github.com/llvm/llvm-project/pull/206988

Add lowering support for OpenMP DECLARE VARIANT. Each directive is recorded on its base procedure during the structure checks. During call lowering, best variant is picked based on recorded selecter and context.

Assisted by: Cursor

>From 11a8c70a73da2d022abc8b236af23e78363f1b99 Mon Sep 17 00:00:00 2001
From: Abid Qadeer <haqadeer at amd.com>
Date: Tue, 30 Jun 2026 17:36:26 +0100
Subject: [PATCH] [flang][OpenMP] Lowering support for declare variant.

Add lowering support for OpenMP DECLARE VARIANT. Each directive is recorded on
its base procedure during the structure checks. During call lowering, best
variant is picked based on recorded selecter and context.

Assisted by: Cursor
---
 flang/include/flang/Lower/OpenMP.h            |   9 +
 .../flang/Semantics/omp-declare-variant.h     |  32 +++
 flang/include/flang/Semantics/symbol.h        |   9 +
 flang/lib/Lower/CMakeLists.txt                |   1 +
 flang/lib/Lower/CallInterface.cpp             |  33 ++-
 flang/lib/Lower/OpenMP/OpenMP.cpp             |   4 +-
 flang/lib/Lower/OpenMP/Utils.cpp              |  58 +++++
 flang/lib/Semantics/check-omp-variant.cpp     |  35 +--
 ...lare-variant-structured-trait-property.f90 |  30 +++
 .../Todo/declare-variant-target-device.f90    |  14 ++
 .../Lower/OpenMP/Todo/declare-variant.f90     |  17 --
 .../Lower/OpenMP/declare-variant-call.f90     | 200 ++++++++++++++++++
 .../OpenMP/declare-variant-construct.f90      | 162 ++++++++++++++
 .../Lower/OpenMP/declare-variant-device.f90   |  53 +++++
 .../OpenMP/declare-variant-implementation.f90 |  32 +++
 .../Lower/OpenMP/declare-variant-module.f90   |  23 ++
 .../OpenMP/declare-variant-target-device.f90  |  28 +++
 17 files changed, 707 insertions(+), 33 deletions(-)
 create mode 100644 flang/include/flang/Semantics/omp-declare-variant.h
 create mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
 create mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
 delete mode 100644 flang/test/Lower/OpenMP/Todo/declare-variant.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-call.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-construct.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-device.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-implementation.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-module.f90
 create mode 100644 flang/test/Lower/OpenMP/declare-variant-target-device.f90

diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h
index 882ebad9071bc..d2a0592761981 100644
--- a/flang/include/flang/Lower/OpenMP.h
+++ b/flang/include/flang/Lower/OpenMP.h
@@ -105,6 +105,15 @@ void materializeOpenMPDeclareMappers(
     Fortran::lower::AbstractConverter &, Fortran::semantics::SemanticsContext &,
     const Fortran::semantics::Scope *scope = nullptr);
 
+namespace omp {
+/// If \p base carries OpenMP DECLARE VARIANT entries, return the variant symbol
+/// that best matches the enclosing OpenMP context, or nullptr if none matches.
+/// \p base is expected to have variant entries.
+const Fortran::semantics::Symbol *
+resolveDeclareVariantCallee(const Fortran::semantics::Symbol &base,
+                            AbstractConverter &converter);
+} // namespace omp
+
 } // namespace lower
 } // namespace Fortran
 
diff --git a/flang/include/flang/Semantics/omp-declare-variant.h b/flang/include/flang/Semantics/omp-declare-variant.h
new file mode 100644
index 0000000000000..2184bd54b79aa
--- /dev/null
+++ b/flang/include/flang/Semantics/omp-declare-variant.h
@@ -0,0 +1,32 @@
+//===-- flang/Semantics/omp-declare-variant.h -------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
+#define FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
+
+#include "flang/Common/reference.h"
+
+namespace Fortran::parser {
+inline namespace traits {
+struct OmpContextSelectorSpecification;
+} // namespace traits
+} // namespace Fortran::parser
+
+namespace Fortran::semantics {
+class Symbol;
+
+// Information about a DECLARE VARIANT directive that will be recorded on its
+// base procedure.
+struct OmpDeclareVariantEntry {
+  common::Reference<const Symbol> variant;
+  const parser::traits::OmpContextSelectorSpecification *matchSelector{nullptr};
+};
+
+} // namespace Fortran::semantics
+
+#endif // FORTRAN_SEMANTICS_OMP_DECLARE_VARIANT_H_
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index e0511b5b4803d..624ea02fa3525 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -14,6 +14,7 @@
 #include "flang/Common/reference.h"
 #include "flang/Common/visit.h"
 #include "flang/Semantics/module-dependences.h"
+#include "flang/Semantics/omp-declare-variant.h"
 #include "flang/Support/Fortran.h"
 #include "llvm/ADT/DenseMapInfo.h"
 #include "llvm/Frontend/OpenMP/OMP.h"
@@ -307,6 +308,13 @@ class SubprogramDetails : public WithBindName, public WithOmpDeclarative {
     openACCRoutineInfos_.push_back(info);
   }
 
+  const std::vector<OmpDeclareVariantEntry> &ompDeclareVariants() const {
+    return ompDeclareVariants_;
+  }
+  void addOmpDeclareVariant(OmpDeclareVariantEntry &&entry) {
+    ompDeclareVariants_.push_back(std::move(entry));
+  }
+
 private:
   bool isInterface_{false}; // true if this represents an interface-body
   bool isDummy_{false}; // true when interface of dummy procedure
@@ -325,6 +333,7 @@ class SubprogramDetails : public WithBindName, public WithOmpDeclarative {
   std::vector<std::int64_t> cudaLaunchBounds_, cudaClusterDims_;
   // OpenACC routine information
   std::vector<OpenACCRoutineInfo> openACCRoutineInfos_;
+  std::vector<OmpDeclareVariantEntry> ompDeclareVariants_;
 
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const SubprogramDetails &);
diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index f5424c78b9a98..2db97f4f7ec45 100644
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -76,6 +76,7 @@ add_flang_library(FortranLower
   MIFDialect
 
   LINK_COMPONENTS
+  FrontendOpenMP
   Support
 
   MLIR_DEPS
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 3fcf314faefb6..cb3be13e8c9ba 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -11,6 +11,7 @@
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/OpenACC.h"
+#include "flang/Lower/OpenMP.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Support/Utils.h"
@@ -61,13 +62,39 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
   return procRef.hasAlternateReturns();
 }
 
+/// If \p proc refers to a base procedure that carries OpenMP DECLARE VARIANT
+/// entries, return the variant selected for the enclosing OpenMP context: a
+/// direct call to the base is then lowered as a call to that variant. Returns
+/// nullptr when \p proc is not such a base call, or when no variant matches the
+/// context, so the base procedure is used as usual.
+static const Fortran::semantics::Symbol *
+getOmpDeclareVariantCallee(const Fortran::evaluate::ProcedureDesignator &proc,
+                           Fortran::lower::AbstractConverter &converter) {
+  const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
+  if (!symbol)
+    return nullptr;
+  const Fortran::semantics::Symbol &ultimate{symbol->GetUltimate()};
+  // Only pay the cost of declare-variant resolution when the callee actually
+  // carries variant entries; this avoids overhead on every other call.
+  const auto *details =
+      ultimate.detailsIf<Fortran::semantics::SubprogramDetails>();
+  if (!details || details->ompDeclareVariants().empty())
+    return nullptr;
+  return Fortran::lower::omp::resolveDeclareVariantCallee(ultimate, converter);
+}
+
 /// Return the binding label (from BIND(C...)) or the mangled name of the
 /// symbol.
 static std::string
 getProcMangledName(const Fortran::evaluate::ProcedureDesignator &proc,
                    Fortran::lower::AbstractConverter &converter) {
-  if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
+  if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol()) {
+    // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
+    if (const Fortran::semantics::Symbol *variant =
+            getOmpDeclareVariantCallee(proc, converter))
+      return converter.mangleName(*variant);
     return converter.mangleName(symbol->GetUltimate());
+  }
   assert(proc.GetSpecificIntrinsic() &&
          "expected intrinsic procedure in designator");
   return proc.GetName();
@@ -79,6 +106,10 @@ std::string Fortran::lower::CallerInterface::getMangledName() const {
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CallerInterface::getProcedureSymbol() const {
+  // A matching OpenMP DECLARE VARIANT call targets the variant procedure.
+  if (const Fortran::semantics::Symbol *variant =
+          getOmpDeclareVariantCallee(procRef.proc(), converter))
+    return variant;
   return procRef.proc().GetSymbol();
 }
 
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index ea8c279962508..39a185ab1b9f4 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -4477,8 +4477,8 @@ static void
 genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
        semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
        const parser::OmpDeclareVariantDirective &declareVariantDirective) {
-  if (!semaCtx.langOptions().OpenMPSimd)
-    TODO(converter.getCurrentLocation(), "OmpDeclareVariantDirective");
+  // No lowering for the declarative directive itself; the recorded variants are
+  // resolved at call sites (see resolveDeclareVariantCallee in CallInterface).
 }
 
 static ReductionProcessor::GenCombinerCBTy processReductionCombiner(
diff --git a/flang/lib/Lower/OpenMP/Utils.cpp b/flang/lib/Lower/OpenMP/Utils.cpp
index 382292b6c6c13..308a8597dc657 100644
--- a/flang/lib/Lower/OpenMP/Utils.cpp
+++ b/flang/lib/Lower/OpenMP/Utils.cpp
@@ -20,6 +20,7 @@
 #include <flang/Lower/AbstractConverter.h>
 #include <flang/Lower/ConvertType.h>
 #include <flang/Lower/DirectivesCommon.h>
+#include <flang/Lower/OpenMP.h>
 #include <flang/Lower/OpenMP/Clauses.h>
 #include <flang/Lower/PFTBuilder.h>
 #include <flang/Lower/Support/PrivateReductionUtils.h>
@@ -30,7 +31,10 @@
 #include <flang/Parser/openmp-utils.h>
 #include <flang/Parser/parse-tree.h>
 #include <flang/Parser/tools.h>
+#include <flang/Semantics/omp-declare-variant.h>
 #include <flang/Semantics/openmp-utils.h>
+#include <flang/Semantics/scope.h>
+#include <flang/Semantics/symbol.h>
 #include <flang/Semantics/tools.h>
 #include <flang/Semantics/type.h>
 #include <flang/Utils/OpenMP.h>
@@ -1350,6 +1354,60 @@ void collectEnclosingConstructTraits(
   std::reverse(constructTraits.begin(), constructTraits.end());
 }
 
+const semantics::Symbol *
+resolveDeclareVariantCallee(const semantics::Symbol &base,
+                            AbstractConverter &converter) {
+  const semantics::Symbol &ultimate{base.GetUltimate()};
+
+  const auto *details{ultimate.detailsIf<semantics::SubprogramDetails>()};
+  assert(details && !details->ompDeclareVariants().empty() &&
+         "resolveDeclareVariantCallee called on symbol with no variants");
+
+  semantics::SemanticsContext &semaCtx{ultimate.owner().context()};
+  llvm::SmallVector<llvm::omp::VariantMatchInfo, 4> vmis;
+  llvm::SmallVector<const semantics::Symbol *, 4> variants;
+  for (const semantics::OmpDeclareVariantEntry &entry :
+       details->ompDeclareVariants()) {
+    // Variant selection cannot yet honour some selector features that the
+    // parser/semantics otherwise accept; reject them before building the match
+    // info (MakeVariantMatchInfo asserts none are present). This mirrors how
+    // METADIRECTIVE lowering rejects the same features.
+    if (entry.matchSelector) {
+      switch (semantics::omp::FindUnsupportedSelectorFeature(
+          *entry.matchSelector, semaCtx)) {
+      case semantics::omp::UnsupportedSelectorFeature::TargetDevice:
+        TODO(converter.getCurrentLocation(),
+             "target_device selector in DECLARE VARIANT");
+        break;
+      case semantics::omp::UnsupportedSelectorFeature::
+          ClauseOrExtensionProperty:
+        TODO(converter.getCurrentLocation(),
+             "clause or extension trait matching in DECLARE VARIANT");
+        break;
+      case semantics::omp::UnsupportedSelectorFeature::None:
+        break;
+      }
+    }
+    llvm::omp::VariantMatchInfo &vmi{vmis.emplace_back()};
+    if (entry.matchSelector)
+      semantics::omp::MakeVariantMatchInfo(vmi, *entry.matchSelector, semaCtx);
+    variants.push_back(&entry.variant.get());
+  }
+
+  llvm::SmallVector<llvm::omp::TraitProperty, 8> constructTraits;
+  collectEnclosingConstructTraits(
+      converter.getFirOpBuilder().getInsertionBlock()->getParentOp(),
+      constructTraits);
+  FlangOMPContext ompCtx{converter.getModuleOp(), constructTraits};
+
+  const int bestIdx{llvm::omp::getBestVariantMatchForContext(vmis, ompCtx)};
+  // Return nullptr when no variant matches the current context; the caller
+  // will fall back to the base symbol.
+  if (bestIdx < 0)
+    return nullptr;
+  return variants[bestIdx];
+}
+
 } // namespace omp
 } // namespace lower
 } // namespace Fortran
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index a60f46ba760d9..a52b189879147 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -20,6 +20,7 @@
 #include "flang/Parser/characters.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/omp-declare-variant.h"
 #include "flang/Semantics/openmp-modifiers.h"
 #include "flang/Semantics/openmp-utils.h"
 #include "flang/Semantics/symbol.h"
@@ -740,6 +741,14 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
       },
       arg.u);
 
+  const parser::traits::OmpContextSelectorSpecification *matchSelector{
+      getMatchClauseContextSelector(spec)};
+  if (!matchSelector) {
+    context_.Say(x.source,
+        "DECLARE_VARIANT directive requires a MATCH clause"_err_en_US);
+    return;
+  }
+
   if (base && variant) {
     base = &base->GetUltimate();
     variant = &variant->GetUltimate();
@@ -750,22 +759,22 @@ void OmpStructureChecker::CheckOmpDeclareVariantDirective(
       context_.Say(arg.source,
           "Variant '%s' was already specified for '%s' in another DECLARE VARIANT directive"_err_en_US,
           variant->name(), base->name());
-    } else if (!hasArgModifiers) {
-      // adjust_args/append_args perform the "transformation for its OpenMP
-      // context", so the variant interface intentionally differs from the
-      // base; skip the same-interface check until they are supported.
-      CheckDeclareVariantInterface(context_, *base, *variant, arg.source);
+    } else {
+      if (!hasArgModifiers) {
+        // adjust_args/append_args perform the "transformation for its OpenMP
+        // context", so the variant interface intentionally differs from the
+        // base; skip the same-interface check until they are supported.
+        CheckDeclareVariantInterface(context_, *base, *variant, arg.source);
+      }
+      // Record the variant on its base procedure.
+      if (base->has<SubprogramDetails>()) {
+        auto &details{const_cast<Symbol &>(*base).get<SubprogramDetails>()};
+        details.addOmpDeclareVariant(
+            OmpDeclareVariantEntry{*variant, matchSelector});
+      }
     }
   }
 
-  const parser::traits::OmpContextSelectorSpecification *matchSelector{
-      getMatchClauseContextSelector(spec)};
-  if (!matchSelector) {
-    context_.Say(x.source,
-        "DECLARE_VARIANT directive requires a MATCH clause"_err_en_US);
-    return;
-  }
-
   EnterDirectiveNest(ContextSelectorNest);
   CheckContextSelectorSpecification(*matchSelector);
   CheckDeclareVariantUserConditions(*matchSelector);
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
new file mode 100644
index 0000000000000..738a57f88d7c2
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-structured-trait-property.f90
@@ -0,0 +1,30 @@
+! RUN: %not_todo_cmd %flang_fc1 -cpp -DCLAUSE_PROPERTY -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+! RUN: %not_todo_cmd %flang_fc1 -cpp -DEXTENSION_PROPERTY -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: clause or extension trait matching in DECLARE VARIANT
+
+#ifdef CLAUSE_PROPERTY
+subroutine test_clause_property
+  call base_clause()
+end subroutine
+
+subroutine base_clause
+  !$omp declare variant (base_clause:vsub) match (construct={simd(simdlen(8))})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine
+#endif
+
+#ifdef EXTENSION_PROPERTY
+subroutine test_extension_property
+  call base_ext()
+end subroutine
+
+subroutine base_ext
+  !$omp declare variant (base_ext:vsub) match (implementation={my_trait(foo(bar))})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine
+#endif
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
new file mode 100644
index 0000000000000..f9997c58a9dfc
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/declare-variant-target-device.f90
@@ -0,0 +1,14 @@
+! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: target_device selector in DECLARE VARIANT
+
+subroutine test_target_device
+  call base()
+end subroutine
+
+subroutine base
+  !$omp declare variant (base:vsub) match (target_device={kind(host)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine
diff --git a/flang/test/Lower/OpenMP/Todo/declare-variant.f90 b/flang/test/Lower/OpenMP/Todo/declare-variant.f90
deleted file mode 100644
index 5719ef3afdee1..0000000000000
--- a/flang/test/Lower/OpenMP/Todo/declare-variant.f90
+++ /dev/null
@@ -1,17 +0,0 @@
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
-
-! CHECK: not yet implemented: OmpDeclareVariantDirective
-
-subroutine sb1
-  integer :: x
-  x = 1
-  call sub(x)
-contains
-  subroutine vsub (v1)
-    integer, value :: v1
-  end
-  subroutine sub (v1)
-    !$omp declare variant(vsub), match(construct={dispatch})
-    integer, value :: v1
-  end
-end subroutine
diff --git a/flang/test/Lower/OpenMP/declare-variant-call.f90 b/flang/test/Lower/OpenMP/declare-variant-call.f90
new file mode 100644
index 0000000000000..1371f5e26355e
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-call.f90
@@ -0,0 +1,200 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! Lowering tests for DECLARE VARIANT callee resolution at call sites.
+! The declarative directive is not lowered; variant selection rewrites
+! procedure calls inside matching OpenMP regions.
+
+subroutine test_sequential_vs_parallel
+  call base()
+  !$omp parallel
+  call base()
+  !$omp end parallel
+end subroutine test_sequential_vs_parallel
+
+subroutine base
+  !$omp declare variant (base:vsub) match (construct={parallel})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base
+
+! CHECK-LABEL: func.func @_QPtest_sequential_vs_parallel
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+
+subroutine test_teams_vs_parallel
+  !$omp parallel
+  call base2()
+  !$omp end parallel
+  !$omp teams
+  call base2()
+  !$omp end teams
+end subroutine test_teams_vs_parallel
+
+subroutine base2
+  !$omp declare variant (base2:vsub_par) match (construct={parallel})
+  !$omp declare variant (base2:vsub_teams) match (construct={teams})
+contains
+  subroutine vsub_par
+  end subroutine
+  subroutine vsub_teams
+  end subroutine
+end subroutine base2
+
+! CHECK-LABEL: func.func @_QPtest_teams_vs_parallel
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase2Pvsub_par(){{.*}}: () -> ()
+! CHECK: omp.teams
+! CHECK: fir.call @_QFbase2Pvsub_teams(){{.*}}: () -> ()
+
+subroutine test_user_condition_false
+  !$omp parallel
+  call base3()
+  !$omp end parallel
+end subroutine test_user_condition_false
+
+subroutine base3
+  !$omp declare variant (base3:vsub) match (user={condition(.false.)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base3
+
+! CHECK-LABEL: func.func @_QPtest_user_condition_false
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase3(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase3Pvsub
+
+subroutine test_user_condition_true
+  !$omp parallel
+  call base4()
+  !$omp end parallel
+end subroutine test_user_condition_true
+
+subroutine base4
+  !$omp declare variant (base4:vsub) match (user={condition(.true.)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base4
+
+! CHECK-LABEL: func.func @_QPtest_user_condition_true
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase4Pvsub(){{.*}}: () -> ()
+
+subroutine test_omitted_base_name
+  !$omp parallel
+  call host()
+  !$omp end parallel
+end subroutine test_omitted_base_name
+
+subroutine host
+  !$omp declare variant (vsub) match (construct={parallel})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine host
+
+! CHECK-LABEL: func.func @_QPtest_omitted_base_name
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFhostPvsub(){{.*}}: () -> ()
+
+subroutine test_call_with_args
+  integer :: x
+  x = 1
+  call base5(x)
+  !$omp parallel
+  call base5(x)
+  !$omp end parallel
+end subroutine test_call_with_args
+
+subroutine base5(n)
+  integer, intent(in) :: n
+  !$omp declare variant (base5:vsub) match (construct={parallel})
+contains
+  subroutine vsub(n)
+    integer, intent(in) :: n
+  end subroutine
+end subroutine base5
+
+! CHECK-LABEL: func.func @_QPtest_call_with_args
+! CHECK: fir.call @_QPbase5(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase5Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+
+subroutine test_no_variant_recorded
+  call plain()
+  !$omp parallel
+  call plain()
+  !$omp end parallel
+end subroutine test_no_variant_recorded
+
+subroutine plain
+end subroutine plain
+
+! CHECK-LABEL: func.func @_QPtest_no_variant_recorded
+! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPplain(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFplainP
+
+subroutine test_nested_parallel
+  !$omp parallel
+    !$omp parallel
+    call base6()
+    !$omp end parallel
+  !$omp end parallel
+end subroutine test_nested_parallel
+
+subroutine base6
+  !$omp declare variant (base6:vsub) match (construct={parallel})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base6
+
+! CHECK-LABEL: func.func @_QPtest_nested_parallel
+! CHECK: omp.parallel
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase6Pvsub(){{.*}}: () -> ()
+
+subroutine test_parallel_do
+  integer :: i
+  !$omp parallel do
+  do i = 1, 2
+    call base7(i)
+  end do
+end subroutine test_parallel_do
+
+subroutine base7(n)
+  integer, intent(in) :: n
+  !$omp declare variant (base7:vsub) match (construct={parallel})
+contains
+  subroutine vsub(n)
+    integer, intent(in) :: n
+  end subroutine
+end subroutine base7
+
+! CHECK-LABEL: func.func @_QPtest_parallel_do
+! CHECK: fir.call @_QFbase7Pvsub(%{{.*}}){{.*}}: (!fir.ref<i32>) -> ()
+
+subroutine test_target_construct
+  call base8()
+  !$omp target
+  call base8()
+  !$omp end target
+end subroutine test_target_construct
+
+subroutine base8
+  !$omp declare variant (base8:vsub) match (construct={target})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base8
+
+! CHECK-LABEL: func.func @_QPtest_target_construct
+! CHECK: fir.call @_QPbase8(){{.*}}: () -> ()
+! CHECK: omp.target
+! CHECK: fir.call @_QFbase8Pvsub(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-construct.f90 b/flang/test/Lower/OpenMP/declare-variant-construct.f90
new file mode 100644
index 0000000000000..23de6ade634dd
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-construct.f90
@@ -0,0 +1,162 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! DECLARE VARIANT callee resolution with combined/composite construct
+! selectors.
+
+! The combined directive selector decomposes to {target, teams}; it matches
+! only when both constructs enclose the call.
+
+! CHECK-LABEL: func.func @_QPtest_combined_match
+! CHECK: omp.target
+! CHECK: omp.teams
+! CHECK: fir.call @_QFbase_ttPvsub(){{.*}}: () -> ()
+subroutine test_combined_match
+  !$omp target
+  !$omp teams
+  call base_tt()
+  !$omp end teams
+  !$omp end target
+end subroutine test_combined_match
+
+subroutine base_tt
+  !$omp declare variant (base_tt:vsub) match (construct={target teams})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_tt
+
+! Only `target` encloses the call, so the {target, teams} selector does not
+! match and the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_combined_partial
+! CHECK: omp.target
+! CHECK: fir.call @_QPbase_tt2(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_tt2Pvsub
+subroutine test_combined_partial
+  !$omp target
+  call base_tt2()
+  !$omp end target
+end subroutine test_combined_partial
+
+subroutine base_tt2
+  !$omp declare variant (base_tt2:vsub) match (construct={target teams})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_tt2
+
+! CHECK-LABEL: func.func @_QPtest_set_match
+! CHECK: omp.target
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
+subroutine test_set_match
+  !$omp target
+  !$omp parallel
+  call base_tp()
+  !$omp end parallel
+  !$omp end target
+end subroutine test_set_match
+
+subroutine base_tp
+  !$omp declare variant (base_tp:vsub) match (construct={target, parallel})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_tp
+
+! Inside `parallel` alone the {target, parallel} selector is not satisfied,
+! so the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_set_no_match
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase_tp2(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_tp2Pvsub
+subroutine test_set_no_match
+  !$omp parallel
+  call base_tp2()
+  !$omp end parallel
+end subroutine test_set_no_match
+
+subroutine base_tp2
+  !$omp declare variant (base_tp2:vsub) match (construct={target, parallel})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_tp2
+
+! A `teams` construct between `target` and `parallel` does not prevent the
+! match: {target, parallel} matches as an ordered subsequence of the enclosing
+! target>teams>parallel context.
+
+! CHECK-LABEL: func.func @_QPtest_set_match_nested_teams
+! CHECK: omp.target
+! CHECK: omp.teams
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_tpPvsub(){{.*}}: () -> ()
+subroutine test_set_match_nested_teams
+  !$omp target
+  !$omp teams
+  !$omp parallel
+  call base_tp()
+  !$omp end parallel
+  !$omp end teams
+  !$omp end target
+end subroutine test_set_match_nested_teams
+
+subroutine base_rank
+  !$omp declare variant (base_rank:vsub_par) match (construct={parallel})
+  !$omp declare variant (base_rank:vsub_tp) match (construct={target, parallel})
+contains
+  subroutine vsub_par
+  end subroutine
+  subroutine vsub_tp
+  end subroutine
+end subroutine base_rank
+
+! Inside target>parallel both variants apply; the more specific
+! {target, parallel} selector outranks {parallel}.
+
+! CHECK-LABEL: func.func @_QPtest_rank_specific
+! CHECK: omp.target
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_rankPvsub_tp(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_rankPvsub_par
+subroutine test_rank_specific
+  !$omp target
+  !$omp parallel
+  call base_rank()
+  !$omp end parallel
+  !$omp end target
+end subroutine test_rank_specific
+
+! Inside parallel alone only {parallel} applies.
+
+! CHECK-LABEL: func.func @_QPtest_rank_parallel_only
+! CHECK: omp.parallel
+! CHECK: fir.call @_QFbase_rankPvsub_par(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_rankPvsub_tp
+subroutine test_rank_parallel_only
+  !$omp parallel
+  call base_rank()
+  !$omp end parallel
+end subroutine test_rank_parallel_only
+
+subroutine base_score
+  !$omp declare variant (base_score:vsub_lo) match (user={condition(score(1): .true.)})
+  !$omp declare variant (base_score:vsub_hi) match (user={condition(score(100): .true.)})
+contains
+  subroutine vsub_lo
+  end subroutine
+  subroutine vsub_hi
+  end subroutine
+end subroutine base_score
+
+! Both conditions are statically true; the higher score wins.
+
+! CHECK-LABEL: func.func @_QPtest_score_ranking
+! CHECK: fir.call @_QFbase_scorePvsub_hi(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_scorePvsub_lo
+subroutine test_score_ranking
+  call base_score()
+end subroutine test_score_ranking
diff --git a/flang/test/Lower/OpenMP/declare-variant-device.f90 b/flang/test/Lower/OpenMP/declare-variant-device.f90
new file mode 100644
index 0000000000000..1191d6312b551
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-device.f90
@@ -0,0 +1,53 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_device_kind_host
+! CHECK: fir.call @_QFbase_hostPvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase_host
+subroutine test_device_kind_host
+  call base_host()
+end subroutine test_device_kind_host
+
+subroutine base_host
+  !$omp declare variant (base_host:vsub) match (device={kind(host)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_host
+
+! kind(nohost) does not match on a host compilation: the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_device_kind_nohost
+! CHECK: fir.call @_QPbase_nohost(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_nohostPvsub
+subroutine test_device_kind_nohost
+  call base_nohost()
+end subroutine test_device_kind_nohost
+
+subroutine base_nohost
+  !$omp declare variant (base_nohost:vsub) match (device={kind(nohost)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_nohost
+
+! A device kind that matches neither host nor nohost also does not select
+! a variant.
+
+! CHECK-LABEL: func.func @_QPtest_device_no_match
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QPbase(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbasePvsub
+subroutine test_device_no_match
+  call base()
+  !$omp parallel
+  call base()
+  !$omp end parallel
+end subroutine test_device_no_match
+
+subroutine base
+  !$omp declare variant (base:vsub) match (device={kind(fpga)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base
diff --git a/flang/test/Lower/OpenMP/declare-variant-implementation.f90 b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
new file mode 100644
index 0000000000000..07f5124bee035
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-implementation.f90
@@ -0,0 +1,32 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_vendor_llvm
+! CHECK: fir.call @_QFbase_llvmPvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase_llvm
+subroutine test_vendor_llvm
+  call base_llvm()
+end subroutine test_vendor_llvm
+
+subroutine base_llvm
+  !$omp declare variant (base_llvm:vsub) match (implementation={vendor(llvm)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_llvm
+
+! An unknown vendor does not match: the base call is kept.
+
+! CHECK-LABEL: func.func @_QPtest_vendor_unknown
+! CHECK: fir.call @_QPbase_unknown(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QFbase_unknownPvsub
+subroutine test_vendor_unknown
+  call base_unknown()
+end subroutine test_vendor_unknown
+
+subroutine base_unknown
+  !$omp declare variant (base_unknown:vsub) match (implementation={vendor("unknown")})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base_unknown
diff --git a/flang/test/Lower/OpenMP/declare-variant-module.f90 b/flang/test/Lower/OpenMP/declare-variant-module.f90
new file mode 100644
index 0000000000000..aa75473a9582b
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-module.f90
@@ -0,0 +1,23 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 %s -o - | FileCheck %s
+
+module m
+contains
+  subroutine base
+    !$omp declare variant (base:vsub) match (construct={parallel})
+  contains
+    subroutine vsub
+    end subroutine
+  end subroutine base
+
+  subroutine caller
+    call base()
+    !$omp parallel
+    call base()
+    !$omp end parallel
+  end subroutine caller
+end module m
+
+! CHECK-LABEL: func.func @_QMmPcaller
+! CHECK: fir.call @_QMmPbase(){{.*}}: () -> ()
+! CHECK: omp.parallel
+! CHECK: fir.call @_QMmFbasePvsub(){{.*}}: () -> ()
diff --git a/flang/test/Lower/OpenMP/declare-variant-target-device.f90 b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
new file mode 100644
index 0000000000000..45549cb7c444d
--- /dev/null
+++ b/flang/test/Lower/OpenMP/declare-variant-target-device.f90
@@ -0,0 +1,28 @@
+! RUN: %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 \
+! RUN:   -fopenmp-is-target-device %s -o - | FileCheck %s
+
+subroutine base
+  !$omp declare variant (base:vsub) match (device={kind(nohost)})
+contains
+  subroutine vsub
+  end subroutine
+end subroutine base
+
+subroutine device_caller
+  !$omp declare target to(device_caller) device_type(nohost)
+  call base()
+end subroutine device_caller
+
+subroutine target_region_caller
+  !$omp target
+  call base()
+  !$omp end target
+end subroutine target_region_caller
+
+! CHECK-LABEL: func.func @_QPdevice_caller
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()
+! CHECK-NOT: fir.call @_QPbase
+
+! CHECK-LABEL: func.func @_QPtarget_region_caller
+! CHECK: omp.target
+! CHECK: fir.call @_QFbasePvsub(){{.*}}: () -> ()



More information about the flang-commits mailing list