[flang-commits] [flang] c5fbabb - [flang][OpenMP] Semantic checks for metadirective loop nests (#207088)
via flang-commits
flang-commits at lists.llvm.org
Fri Jul 10 09:00:29 PDT 2026
Author: Chi-Chun, Chen
Date: 2026-07-10T11:00:23-05:00
New Revision: c5fbabb36e9be13e001cc6b96bfef7b4db33210d
URL: https://github.com/llvm/llvm-project/commit/c5fbabb36e9be13e001cc6b96bfef7b4db33210d
DIFF: https://github.com/llvm/llvm-project/commit/c5fbabb36e9be13e001cc6b96bfef7b4db33210d.diff
LOG: [flang][OpenMP] Semantic checks for metadirective loop nests (#207088)
A loop-associated metadirective variant (`do`, `simd`, ...) is only
resolved during lowering, so it is never checked as a loop construct
during semantic analysis. A malformed or non-canonical associated nest
therefore reaches lowering, which assumes a canonical nest.
This patch validates the nest that follows such a variant (the next
executable construct) during semantics, reusing the diagnostics of a
real loop-associated construct. Each applicable variant is checked
against it:
* Canonical loop: the affected loop must be a canonical DO loop, so a
`DO WHILE`, a pre-6.0 `DO CONCURRENT`, or a `DO` without loop control is
rejected.
* Nest depth: `collapse(n)` and `ordered(n)` must not exceed the depth
of the associated loop nest.
* Rectangularity: loops that must be rectangular (e.g. under `tile`) may
not have bounds that depend on an outer loop's variable.
A loop-associated variant may also have no loop nest at all. This
happens when the metadirective ends the execution part or a non-loop
construct follows it. Such a variant is rejected like a bare loop
directive with no associated loop.
Only variants that could be selected are checked: when a target is
known, a WHEN variant whose device or implementation selector cannot
match it is skipped (runtime `user` conditions never cause a skip).
Part of the feature work for #188820. Builds on top of
[#193664](https://github.com/llvm/llvm-project/issues/193664) and
[#194424](https://github.com/llvm/llvm-project/pull/194424).
Assisted with Copilot.
Added:
flang/test/Semantics/OpenMP/metadirective-loop-applicability.f90
flang/test/Semantics/OpenMP/metadirective-loop-nest.f90
flang/test/Semantics/OpenMP/metadirective-loop-sequence.f90
Modified:
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
flang/lib/Semantics/check-omp-variant.cpp
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index bb8145384d9ee..68d7a166be0fb 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -205,6 +205,12 @@ void OmpStructureChecker::Enter(const parser::ModuleSubprogram &) {
}
void OmpStructureChecker::Enter(const parser::SpecificationPart &) {
+ // Clear pending metadirective loop variants at the start of a program unit.
+ // An empty partStack_ marks the unit's top-level specification part, so a
+ // nested one such as an interface body does not reset them.
+ if (partStack_.empty()) {
+ metadirectiveLoopVariants_.clear();
+ }
partStack_.push_back(PartKind::SpecificationPart);
}
@@ -217,6 +223,11 @@ void OmpStructureChecker::Enter(const parser::ExecutionPart &) {
}
void OmpStructureChecker::Leave(const parser::ExecutionPart &) {
+ if (!metadirectiveLoopVariants_.empty()) {
+ // No loop nest followed the metadirective in this execution part, so its
+ // loop-associated variants were never validated.
+ CheckMetadirectiveVariantsWithoutLoop();
+ }
partStack_.pop_back();
}
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 97906e636298e..3d4cdd08d07ca 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -141,6 +141,9 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
void Enter(const parser::OmpMetadirectiveDirective &);
void Leave(const parser::OmpMetadirectiveDirective &);
+ void Enter(const parser::ExecutionPartConstruct &);
+ void Leave(const parser::OmpClause::When &);
+
void Enter(const parser::OmpContextSelector &);
void Leave(const parser::OmpContextSelector &);
@@ -280,6 +283,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
void CheckDistLinear(const parser::OpenMPLoopConstruct &x);
// check-omp-variant.cpp
+ void CheckMetadirectiveVariantsWithoutLoop();
void CheckOmpDeclareVariantDirective(
const parser::OmpDeclareVariantDirective &);
void CheckDeclareVariantUserConditions(const parser::OmpContextSelector &);
@@ -488,6 +492,14 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
};
std::vector<PartKind> partStack_;
+ struct MetadirectiveLoopVariant {
+ const parser::traits::OmpContextSelectorSpecification *selector;
+ const parser::OmpDirectiveSpecification *spec;
+ };
+ std::vector<MetadirectiveLoopVariant> metadirectiveLoopVariants_;
+ const parser::traits::OmpContextSelectorSpecification *currentWhenSelector_{
+ nullptr};
+
std::multimap<const parser::Label,
std::pair<parser::CharBlock, const parser::OpenMPConstruct *>>
sourceLabels_;
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index 1eff064dcbc80..d4438ef6db607 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -43,6 +43,17 @@ using namespace Fortran::semantics::omp;
void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
OmpVerifyModifiers(
x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
+ // Record this WHEN clause's context selector so the variant directive it
+ // controls can be paired with it for static-applicability matching.
+ if (const auto &modifiers{std::get<0>(x.v.t)};
+ modifiers && modifiers->size() == 1) {
+ currentWhenSelector_ =
+ &std::get<parser::modifier::OmpContextSelector>(modifiers->front().u);
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OmpClause::When &) {
+ currentWhenSelector_ = nullptr;
}
void OmpStructureChecker::CheckContextSelectorSpecification(
@@ -575,6 +586,12 @@ void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
PushContextAndClauseSets(
std::get<parser::OmpDirectiveName>(x.t).source, dirId);
+
+ // Record each variant directive. A loop-associated one is later validated
+ // against the loop nest that follows the metadirective.
+ if (dirId != llvm::omp::Directive::OMPD_metadirective) {
+ metadirectiveLoopVariants_.push_back({currentWhenSelector_, &x});
+ }
}
void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &x) {
@@ -585,12 +602,174 @@ void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &x) {
void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
EnterDirectiveNest(MetadirectiveNest);
+ metadirectiveLoopVariants_.clear();
}
void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
ExitDirectiveNest(MetadirectiveNest);
}
+// Return true if the variant guarded by `selector` might be selected, so its
+// associated loop must still be checked. Skip it only when it is provably
+// unselectable.
+static bool mayVariantBeSelected(
+ const parser::traits::OmpContextSelectorSpecification *selector,
+ SemanticsContext &context, OmpVariantMatchContext &matchContext) {
+ if (!selector ||
+ FindUnsupportedSelectorFeature(*selector, context) !=
+ UnsupportedSelectorFeature::None) {
+ return true;
+ }
+ llvm::omp::VariantMatchInfo vmi;
+ (void)MakeVariantMatchInfo(vmi, *selector, context);
+ const auto &required{vmi.RequiredTraits};
+ using TP = llvm::omp::TraitProperty;
+ // In the default "match all" mode, a required trait that can never match
+ // (e.g. a compile-time-false condition or an invalid device/implementation
+ // property) makes the variant unselectable. match_any and match_none tolerate
+ // such traits, so only reject variants in the default mode.
+ bool matchAll{
+ !required.test(unsigned(TP::implementation_extension_match_any)) &&
+ !required.test(unsigned(TP::implementation_extension_match_none))};
+ if (matchAll &&
+ (required.test(unsigned(TP::user_condition_false)) ||
+ required.test(unsigned(TP::invalid)))) {
+ return false;
+ }
+ // Matching a device or implementation selector requires a known target.
+ if (context.targetTriple().empty()) {
+ return true;
+ }
+ return llvm::omp::isVariantApplicableInContext(
+ vmi, matchContext, /*DeviceOrImplementationSetOnly=*/true);
+}
+
+// Check a loop-associated metadirective's variants against the loop nest they
+// apply to. The nest is not attached to the directive in the parse tree. It is
+// the next executable construct, either a following sibling or the first
+// execution-part construct for a declarative metadirective.
+void OmpStructureChecker::Enter(const parser::ExecutionPartConstruct &x) {
+ if (metadirectiveLoopVariants_.empty()) {
+ return;
+ }
+ if (parser::Unwrap<parser::CompilerDirective>(x)) {
+ return;
+ }
+ // This is the first construct after the metadirective. It consumes the
+ // pending variants, whether or not it is a loop nest.
+ if (!parser::Unwrap<parser::DoConstruct>(x)) {
+ // A non-loop construct follows, so a loop-associated variant has no loop
+ // nest to associate with.
+ CheckMetadirectiveVariantsWithoutLoop();
+ return;
+ }
+
+ // A loop nest follows. Take the pending variants off the worklist and
+ // validate them against it.
+ std::vector<MetadirectiveLoopVariant> variants;
+ variants.swap(metadirectiveLoopVariants_);
+
+ unsigned version{context_.langOptions().OpenMPVersion};
+ LoopSequence sequence(x, version, /*allowAllLoops=*/true, &context_);
+ const parser::DoConstruct &rootLoop{*parser::Unwrap<parser::DoConstruct>(x)};
+ const auto &[haveSemantic, havePerfect]{sequence.depth()};
+
+ const auto MsgRequiresCanonical{
+ "This construct requires a canonical loop %s"_err_en_US};
+ const auto MsgNotValidAffectedLoop{
+ "%s is not a valid affected loop"_because_en_US};
+
+ auto checkRootLoopCanonical =
+ [&](const parser::OmpDirectiveSpecification &spec, bool isSequence) {
+ parser::CharBlock source{*parser::GetSource(rootLoop)};
+ Reason reason;
+ if (rootLoop.IsDoWhile()) {
+ reason.Say(source, MsgNotValidAffectedLoop, "DO WHILE loop");
+ } else if (rootLoop.IsDoConcurrent() && !IsDoConcurrentLegal(version)) {
+ reason.Say(source, MsgNotValidAffectedLoop, "DO CONCURRENT loop");
+ } else if (!rootLoop.GetLoopControl()) {
+ reason.Say(
+ source, MsgNotValidAffectedLoop, "DO loop without loop control");
+ }
+
+ if (!reason) {
+ return true;
+ }
+
+ auto &msg{context_.Say(spec.DirName().source, MsgRequiresCanonical,
+ isSequence ? "sequence" : "nest")};
+ reason.AttachTo(msg);
+ return false;
+ };
+
+ // Build the matching context once for the static-applicability gate below.
+ OmpVariantMatchContext matchContext{context_};
+
+ for (const MetadirectiveLoopVariant &variant : variants) {
+ const parser::OmpDirectiveSpecification *spec{variant.spec};
+ // Skip variants that can never be selected on this compilation target so
+ // that their associated loop is not diagnosed.
+ if (!mayVariantBeSelected(variant.selector, context_, matchContext)) {
+ continue;
+ }
+ auto assoc{llvm::omp::getDirectiveAssociation(spec->DirId())};
+ if (assoc == llvm::omp::Association::LoopNest) {
+ if (!checkRootLoopCanonical(*spec, /*isSequence=*/false)) {
+ continue;
+ }
+
+ auto [needDepth, needPerfect]{
+ GetAffectedNestDepthWithReason(*spec, version, &context_)};
+ auto haveDepth{needPerfect ? havePerfect : haveSemantic};
+ if (!needDepth || *needDepth.value <= 0 || !haveDepth ||
+ *haveDepth.value <= 0) {
+ continue;
+ }
+ if (*needDepth.value > *haveDepth.value) {
+ std::string_view perfectTxt{needPerfect ? " perfect" : ""};
+ auto &msg{context_.Say(spec->DirName().source,
+ "This construct requires a%s nest of depth %" PRId64
+ ", but the associated nest is a%s nest of depth %" PRId64
+ ""_err_en_US,
+ perfectTxt, *needDepth.value, perfectTxt, *haveDepth.value)};
+ haveDepth.reason.AttachTo(msg);
+ needDepth.reason.AttachTo(msg);
+ } else {
+ CheckRectangularNest(*spec, sequence);
+ }
+ } else if (assoc == llvm::omp::Association::LoopSeq) {
+ (void)checkRootLoopCanonical(*spec, /*isSequence=*/true);
+ }
+ }
+}
+
+// Diagnose loop-associated metadirective variants that are not followed by a
+// loop nest, either because the metadirective is the last construct in the
+// execution part or because a non-loop construct follows it. Variants that
+// cannot be selected on this target are skipped.
+void OmpStructureChecker::CheckMetadirectiveVariantsWithoutLoop() {
+ std::vector<MetadirectiveLoopVariant> variants;
+ variants.swap(metadirectiveLoopVariants_);
+
+ OmpVariantMatchContext matchContext{context_};
+ const auto MsgShouldContainDoOr{
+ "This construct should contain a DO-loop or a loop-%s-generating construct"_err_en_US};
+
+ for (const MetadirectiveLoopVariant &variant : variants) {
+ if (!mayVariantBeSelected(variant.selector, context_, matchContext)) {
+ continue;
+ }
+ auto assoc{llvm::omp::getDirectiveAssociation(variant.spec->DirId())};
+ if (assoc == llvm::omp::Association::LoopNest) {
+ context_.Say(
+ variant.spec->DirName().source, MsgShouldContainDoOr, "nest");
+ } else if (assoc == llvm::omp::Association::LoopSeq) {
+ context_.Say(
+ variant.spec->DirName().source, MsgShouldContainDoOr, "sequence");
+ }
+ }
+}
+
static const parser::traits::OmpContextSelectorSpecification *
getMatchClauseContextSelector(const parser::OmpDirectiveSpecification &spec) {
for (const parser::OmpClause &clause : spec.Clauses().v) {
diff --git a/flang/test/Semantics/OpenMP/metadirective-loop-applicability.f90 b/flang/test/Semantics/OpenMP/metadirective-loop-applicability.f90
new file mode 100644
index 0000000000000..e7112a3843411
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-loop-applicability.f90
@@ -0,0 +1,118 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=51
+
+! Static applicability of loop-associated METADIRECTIVE variants
+
+! device={kind(nohost)} cannot match during host compilation so semantic check is skipped
+! for this variant.
+subroutine f01(n, a)
+ integer :: n, a(n, n), i, j
+ !$omp metadirective when(device={kind(nohost)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine f02(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! Variant not skipped since a non-constant user condition may be selected at run time.
+subroutine f03(n, a, flag)
+ integer :: n, a(n, n), i, j
+ logical :: flag
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(user={condition(flag)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! A dead WHEN clause must not suppress the unguarded DEFAULT variant.
+subroutine f04(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(device={kind(nohost)}: nothing) default(do collapse(3))
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! A user condition that folds to a compile-time false makes the variant
+! unselectable, so its loop is skipped and DEFAULT applies.
+subroutine f05(n, a)
+ integer :: n, a(n, n), i, j
+ logical, parameter :: use_variant = .false.
+ !$omp metadirective when(user={condition(use_variant)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! A user condition that folds to a compile-time true keeps the variant, so its
+! loop is still checked.
+subroutine f06(n, a)
+ integer :: n, a(n, n), i, j
+ logical, parameter :: use_variant = .true.
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(user={condition(use_variant)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! An unknown implementation VENDOR never matches, so the variant is skipped.
+subroutine f07(n, a)
+ integer :: n, a(n, n), i, j
+ !$omp metadirective when(implementation={vendor(bogus_vendor)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! An unknown device ARCH never matches, so the variant is skipped.
+subroutine f08(n, a)
+ integer :: n, a(n, n), i, j
+ !$omp metadirective when(device={arch(bogus_arch)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! MATCH_NONE is satisfied by the unmatched (invalid) vendor, so the variant
+! stays selectable and its loop must still be checked.
+subroutine f09(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(bogus_vendor), extension(match_none)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
diff --git a/flang/test/Semantics/OpenMP/metadirective-loop-nest.f90 b/flang/test/Semantics/OpenMP/metadirective-loop-nest.f90
new file mode 100644
index 0000000000000..ef9b092c9c77b
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-loop-nest.f90
@@ -0,0 +1,154 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=51
+
+subroutine collapse_too_deep(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine ordered_too_deep(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: ORDERED clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do ordered(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine collapse_too_deep_exec(n, a)
+ integer :: n, a(n, n), i, j
+ a = 0
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(3)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine collapse_too_deep_compiler_directive(n, a)
+ integer :: n, a(n, n), i, j
+ a = 0
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(3)) default(nothing)
+ !dir$ ivdep
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine noncanonical_do_while(n)
+ integer :: n, i
+ i = 0
+ !ERROR: This construct requires a canonical loop nest
+ !$omp metadirective when(implementation={vendor(llvm)}: do) default(nothing)
+ !BECAUSE: DO WHILE loop is not a valid affected loop
+ do while (i < n)
+ i = i + 1
+ end do
+end subroutine
+
+subroutine noncanonical_do_concurrent(n, a)
+ integer :: n, a(n), i
+ !ERROR: This construct requires a canonical loop nest
+ !$omp metadirective when(implementation={vendor(llvm)}: do) default(nothing)
+ !BECAUSE: DO CONCURRENT loop is not a valid affected loop
+ do concurrent(i=1:n)
+ a(i) = i
+ end do
+end subroutine
+
+subroutine noncanonical_no_control(n)
+ integer :: n, i
+ i = 0
+ !ERROR: This construct requires a canonical loop nest
+ !$omp metadirective when(implementation={vendor(llvm)}: do) default(nothing)
+ !BECAUSE: DO loop without loop control is not a valid affected loop
+ do
+ i = i + 1
+ if (i >= n) exit
+ end do
+end subroutine
+
+subroutine collapse_too_deep_interface(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a perfect nest of depth 3, but the associated nest is a perfect nest of depth 2
+ !BECAUSE: COLLAPSE clause was specified with argument 3
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(3)) default(nothing)
+ interface
+ subroutine ext()
+ end subroutine
+ end interface
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine tile_non_rectangular(n, a)
+ integer :: n, a(n, n), i, j
+ !ERROR: This construct requires a rectangular loop nest, but the associated nest is not
+ !BECAUSE: None of the loops affected by TILE can be non-rectangular
+ !$omp metadirective when(implementation={vendor(llvm)}: tile sizes(2, 2)) default(nothing)
+ do i = 1, n
+ !BECAUSE: The upper bound of the affected loop uses iteration variables of enclosing loops: 'i'
+ do j = 1, i
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine collapse_valid(n, a)
+ integer :: n, a(n, n), i, j
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(2)) default(nothing)
+ do i = 1, n
+ do j = 1, n
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+subroutine collapse_non_rectangular_valid(n, a)
+ integer :: n, a(n, n), i, j
+ !$omp metadirective when(implementation={vendor(llvm)}: do collapse(2)) default(nothing)
+ do i = 1, n
+ do j = 1, i
+ a(j, i) = i
+ end do
+ end do
+end subroutine
+
+! A loop-associated variant with no loop nest to associate with is in error,
+! whether the metadirective is the last construct in the execution part ...
+subroutine no_loop_at_end()
+ !ERROR: This construct should contain a DO-loop or a loop-nest-generating construct
+ !$omp metadirective when(implementation={vendor(llvm)}: do) default(nothing)
+end subroutine
+
+! ... or is followed by a non-loop construct.
+subroutine no_loop_before_stmt(a)
+ integer :: a
+ !ERROR: This construct should contain a DO-loop or a loop-nest-generating construct
+ !$omp metadirective when(implementation={vendor(llvm)}: parallel do) default(nothing)
+ a = 0
+end subroutine
+
+! A variant that cannot be selected on this target needs no loop nest.
+subroutine no_loop_dead_variant()
+ !$omp metadirective when(device={kind(nohost)}: do) default(nothing)
+end subroutine
diff --git a/flang/test/Semantics/OpenMP/metadirective-loop-sequence.f90 b/flang/test/Semantics/OpenMP/metadirective-loop-sequence.f90
new file mode 100644
index 0000000000000..c893b63a5505a
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-loop-sequence.f90
@@ -0,0 +1,13 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+! A loop-sequence-associated METADIRECTIVE variant (FUSE) with no loop sequence
+! to associate with is diagnosed like the loop-nest case, but names a sequence.
+subroutine no_sequence_at_end()
+ !ERROR: This construct should contain a DO-loop or a loop-sequence-generating construct
+ !$omp metadirective when(implementation={vendor(llvm)}: fuse) otherwise(nothing)
+end subroutine
+
+! A variant that cannot be selected on this target needs no loop sequence.
+subroutine no_sequence_dead_variant()
+ !$omp metadirective when(device={kind(nohost)}: fuse) otherwise(nothing)
+end subroutine
More information about the flang-commits
mailing list