[flang-commits] [flang] ba116a8 - [flang][OpenMP] Split check-omp-structure.cpp into smaller files, NFC (#146359)
via flang-commits
flang-commits at lists.llvm.org
Tue Jul 1 09:12:04 PDT 2025
Author: Krzysztof Parzyszek
Date: 2025-07-01T11:12:00-05:00
New Revision: ba116a8bed9ae093575bd316bf8847bb016177dd
URL: https://github.com/llvm/llvm-project/commit/ba116a8bed9ae093575bd316bf8847bb016177dd
DIFF: https://github.com/llvm/llvm-project/commit/ba116a8bed9ae093575bd316bf8847bb016177dd.diff
LOG: [flang][OpenMP] Split check-omp-structure.cpp into smaller files, NFC (#146359)
Create these new files in flang/lib/Semantics:
openmp-utils.cpp/.h - Common utilities
check-omp-atomic.cpp - Atomic-related checks
check-omp-loop.cpp - Loop constructs/clauses
check-omp-metadirective.cpp - Metadirective-related checks
Update lists of included headers, std in particular.
---------
Co-authored-by: Jack Styles <jack.styles at arm.com>
Added:
flang/lib/Semantics/check-omp-atomic.cpp
flang/lib/Semantics/check-omp-loop.cpp
flang/lib/Semantics/check-omp-metadirective.cpp
flang/lib/Semantics/openmp-utils.cpp
flang/lib/Semantics/openmp-utils.h
Modified:
flang/lib/Semantics/CMakeLists.txt
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
Removed:
################################################################################
diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt
index c0fda3631c01f..109bc2dbb8569 100644
--- a/flang/lib/Semantics/CMakeLists.txt
+++ b/flang/lib/Semantics/CMakeLists.txt
@@ -20,6 +20,9 @@ add_flang_library(FortranSemantics
check-io.cpp
check-namelist.cpp
check-nullify.cpp
+ check-omp-atomic.cpp
+ check-omp-loop.cpp
+ check-omp-metadirective.cpp
check-omp-structure.cpp
check-purity.cpp
check-return.cpp
@@ -34,12 +37,13 @@ add_flang_library(FortranSemantics
mod-file.cpp
openmp-dsa.cpp
openmp-modifiers.cpp
+ openmp-utils.cpp
pointer-assignment.cpp
program-tree.cpp
- resolve-labels.cpp
resolve-directives.cpp
- resolve-names-utils.cpp
+ resolve-labels.cpp
resolve-names.cpp
+ resolve-names-utils.cpp
rewrite-parse-tree.cpp
runtime-type-info.cpp
scope.cpp
diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
new file mode 100644
index 0000000000000..047c604693460
--- /dev/null
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -0,0 +1,1295 @@
+//===-- lib/Semantics/check-omp-atomic.cpp --------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Semantic checks related to the ATOMIC construct.
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-omp-structure.h"
+#include "openmp-utils.h"
+
+#include "flang/Common/indirection.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/symbol.h"
+#include "flang/Semantics/tools.h"
+#include "flang/Semantics/type.h"
+
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/STLExtras.h"
+#include "llvm/Frontend/OpenMP/OMP.h"
+#include "llvm/Support/ErrorHandling.h"
+
+#include <cassert>
+#include <list>
+#include <optional>
+#include <string_view>
+#include <tuple>
+#include <utility>
+#include <variant>
+#include <vector>
+
+namespace Fortran::semantics {
+
+using namespace Fortran::semantics::omp;
+
+namespace operation = Fortran::evaluate::operation;
+
+template <typename T, typename U>
+static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
+ return !(e == f);
+}
+
+// There is no consistent way to get the source of a given ActionStmt, so
+// extract the source information from Statement<ActionStmt> when we can,
+// and keep it around for error reporting in further analyses.
+struct SourcedActionStmt {
+ const parser::ActionStmt *stmt{nullptr};
+ parser::CharBlock source;
+
+ operator bool() const { return stmt != nullptr; }
+};
+
+struct AnalyzedCondStmt {
+ SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted
+ parser::CharBlock source;
+ SourcedActionStmt ift, iff;
+};
+
+static SourcedActionStmt GetActionStmt(
+ const parser::ExecutionPartConstruct *x) {
+ if (x == nullptr) {
+ return SourcedActionStmt{};
+ }
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
+ using ActionStmt = parser::Statement<parser::ActionStmt>;
+ if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
+ return SourcedActionStmt{&stmt->statement, stmt->source};
+ }
+ }
+ return SourcedActionStmt{};
+}
+
+static SourcedActionStmt GetActionStmt(const parser::Block &block) {
+ if (block.size() == 1) {
+ return GetActionStmt(&block.front());
+ }
+ return SourcedActionStmt{};
+}
+
+// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption
+// is that the ActionStmt will be either an assignment or a pointer-assignment,
+// otherwise return std::nullopt.
+// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where
+// the "typedAssignment" is unset. This can happen if there are semantic errors
+// in the purported assignment.
+static std::optional<evaluate::Assignment> GetEvaluateAssignment(
+ const parser::ActionStmt *x) {
+ if (x == nullptr) {
+ return std::nullopt;
+ }
+
+ using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
+ using PointerAssignmentStmt =
+ common::Indirection<parser::PointerAssignmentStmt>;
+ using TypedAssignment = parser::AssignmentStmt::TypedAssignment;
+
+ return common::visit(
+ [](auto &&s) -> std::optional<evaluate::Assignment> {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ if constexpr (std::is_same_v<BareS, AssignmentStmt> ||
+ std::is_same_v<BareS, PointerAssignmentStmt>) {
+ const TypedAssignment &typed{s.value().typedAssignment};
+ // ForwardOwningPointer typedAssignment
+ // `- GenericAssignmentWrapper ^.get()
+ // `- std::optional<Assignment> ^->v
+ return typed.get()->v;
+ } else {
+ return std::nullopt;
+ }
+ },
+ x->u);
+}
+
+static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(
+ const parser::ExecutionPartConstruct *x) {
+ if (x == nullptr) {
+ return std::nullopt;
+ }
+
+ // Extract the evaluate::Expr from ScalarLogicalExpr.
+ auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {
+ // ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>
+ const parser::Expr &expr{logical.thing.thing.value()};
+ return GetEvaluateExpr(expr);
+ }};
+
+ // Recognize either
+ // ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or
+ // ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.
+
+ if (auto &&action{GetActionStmt(x)}) {
+ if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(
+ &action.stmt->u)}) {
+ const parser::IfStmt &s{ifs->value()};
+ auto &&maybeCond{
+ getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};
+ auto &thenStmt{
+ std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};
+ if (maybeCond) {
+ return AnalyzedCondStmt{std::move(*maybeCond), action.source,
+ SourcedActionStmt{&thenStmt.statement, thenStmt.source},
+ SourcedActionStmt{}};
+ }
+ }
+ return std::nullopt;
+ }
+
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
+ if (auto *ifc{
+ std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {
+ using ElseBlock = parser::IfConstruct::ElseBlock;
+ using ElseIfBlock = parser::IfConstruct::ElseIfBlock;
+ const parser::IfConstruct &s{ifc->value()};
+
+ if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {
+ // Not expecting any else-if statements.
+ return std::nullopt;
+ }
+ auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};
+ auto &&maybeCond{getFromLogical(
+ std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};
+ if (!maybeCond) {
+ return std::nullopt;
+ }
+
+ if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {
+ AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
+ GetActionStmt(std::get<parser::Block>(s.t)),
+ GetActionStmt(std::get<parser::Block>(maybeElse->t))};
+ if (result.ift.stmt && result.iff.stmt) {
+ return result;
+ }
+ } else {
+ AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
+ GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};
+ if (result.ift.stmt) {
+ return result;
+ }
+ }
+ }
+ return std::nullopt;
+ }
+
+ return std::nullopt;
+}
+
+static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
+ parser::CharBlock source) {
+ // Find => in the range, if not found, find = that is not a part of
+ // <=, >=, ==, or /=.
+ auto trim{[](std::string_view v) {
+ const char *begin{v.data()};
+ const char *end{begin + v.size()};
+ while (*begin == ' ' && begin != end) {
+ ++begin;
+ }
+ while (begin != end && end[-1] == ' ') {
+ --end;
+ }
+ assert(begin != end && "Source should not be empty");
+ return parser::CharBlock(begin, end - begin);
+ }};
+
+ std::string_view sv(source.begin(), source.size());
+
+ if (auto where{sv.find("=>")}; where != sv.npos) {
+ std::string_view lhs(sv.data(), where);
+ std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);
+ return std::make_pair(trim(lhs), trim(rhs));
+ }
+
+ // Go backwards, since all the exclusions above end with a '='.
+ for (size_t next{source.size()}; next > 1; --next) {
+ if (sv[next - 1] == '=' && !llvm::is_contained("<>=/", sv[next - 2])) {
+ std::string_view lhs(sv.data(), next - 1);
+ std::string_view rhs(sv.data() + next, sv.size() - next);
+ return std::make_pair(trim(lhs), trim(rhs));
+ }
+ }
+ llvm_unreachable("Could not find assignment operator");
+}
+
+static bool IsCheckForAssociated(const SomeExpr &cond) {
+ return GetTopLevelOperation(cond).first == operation::Operator::Associated;
+}
+
+static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
+ // This ignores function calls, so it will accept "f(x) = f(x) + 1"
+ // for example.
+ return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;
+}
+
+static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {
+ if (value) {
+ expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),
+ evaluate::GenericExprWrapper::Deleter);
+ }
+}
+
+static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,
+ std::optional<evaluate::Assignment> value) {
+ if (value) {
+ assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),
+ evaluate::GenericAssignmentWrapper::Deleter);
+ }
+}
+
+static parser::OpenMPAtomicConstruct::Analysis::Op MakeAtomicAnalysisOp(
+ int what,
+ const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {
+ parser::OpenMPAtomicConstruct::Analysis::Op operation;
+ operation.what = what;
+ SetAssignment(operation.assign, maybeAssign);
+ return operation;
+}
+
+static parser::OpenMPAtomicConstruct::Analysis MakeAtomicAnalysis(
+ const SomeExpr &atom, const MaybeExpr &cond,
+ parser::OpenMPAtomicConstruct::Analysis::Op &&op0,
+ parser::OpenMPAtomicConstruct::Analysis::Op &&op1) {
+ // Defined in flang/include/flang/Parser/parse-tree.h
+ //
+ // struct Analysis {
+ // struct Kind {
+ // static constexpr int None = 0;
+ // static constexpr int Read = 1;
+ // static constexpr int Write = 2;
+ // static constexpr int Update = Read | Write;
+ // static constexpr int Action = 3; // Bits containing N, R, W, U
+ // static constexpr int IfTrue = 4;
+ // static constexpr int IfFalse = 8;
+ // static constexpr int Condition = 12; // Bits containing IfTrue, IfFalse
+ // };
+ // struct Op {
+ // int what;
+ // TypedAssignment assign;
+ // };
+ // TypedExpr atom, cond;
+ // Op op0, op1;
+ // };
+
+ parser::OpenMPAtomicConstruct::Analysis an;
+ SetExpr(an.atom, atom);
+ SetExpr(an.cond, cond);
+ an.op0 = std::move(op0);
+ an.op1 = std::move(op1);
+ return an;
+}
+
+/// Check if `expr` satisfies the following conditions for x and v:
+///
+/// [6.0:189:10-12]
+/// - x and v (as applicable) are either scalar variables or
+/// function references with scalar data pointer result of non-character
+/// intrinsic type or variables that are non-polymorphic scalar pointers
+/// and any length type parameter must be constant.
+void OmpStructureChecker::CheckAtomicType(
+ SymbolRef sym, parser::CharBlock source, std::string_view name) {
+ const DeclTypeSpec *typeSpec{sym->GetType()};
+ if (!typeSpec) {
+ return;
+ }
+
+ if (!IsPointer(sym)) {
+ using Category = DeclTypeSpec::Category;
+ Category cat{typeSpec->category()};
+ if (cat == Category::Character) {
+ context_.Say(source,
+ "Atomic variable %s cannot have CHARACTER type"_err_en_US, name);
+ } else if (cat != Category::Numeric && cat != Category::Logical) {
+ context_.Say(source,
+ "Atomic variable %s should have an intrinsic type"_err_en_US, name);
+ }
+ return;
+ }
+
+ // Variable is a pointer.
+ if (typeSpec->IsPolymorphic()) {
+ context_.Say(source,
+ "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
+ name);
+ return;
+ }
+
+ // Go over all length parameters, if any, and check if they are
+ // explicit.
+ if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
+ if (llvm::any_of(derived->parameters(), [](auto &&entry) {
+ // "entry" is a map entry
+ return entry.second.isLen() && !entry.second.isExplicit();
+ })) {
+ context_.Say(source,
+ "Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,
+ name);
+ }
+ }
+}
+
+void OmpStructureChecker::CheckAtomicVariable(
+ const SomeExpr &atom, parser::CharBlock source) {
+ if (atom.Rank() != 0) {
+ context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
+ atom.AsFortran());
+ }
+
+ std::vector<SomeExpr> dsgs{GetAllDesignators(atom)};
+ assert(dsgs.size() == 1 && "Should have a single top-level designator");
+ evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
+
+ CheckAtomicType(syms.back(), source, atom.AsFortran());
+
+ if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
+ context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
+ atom.AsFortran());
+ }
+}
+
+void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
+ llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
+ parser::CharBlock source) {
+ if (auto *expr{HasStorageOverlap(base, exprs)}) {
+ context_.Say(source,
+ "Within atomic operation %s and %s access the same storage"_warn_en_US,
+ base.AsFortran(), expr->AsFortran());
+ }
+}
+
+void OmpStructureChecker::ErrorShouldBeVariable(
+ const MaybeExpr &expr, parser::CharBlock source) {
+ if (expr) {
+ context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,
+ expr->AsFortran());
+ } else {
+ context_.Say(source, "Atomic expression should be a variable"_err_en_US);
+ }
+}
+
+std::pair<const parser::ExecutionPartConstruct *,
+ const parser::ExecutionPartConstruct *>
+OmpStructureChecker::CheckUpdateCapture(
+ const parser::ExecutionPartConstruct *ec1,
+ const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {
+ // Decide which statement is the atomic update and which is the capture.
+ //
+ // The two allowed cases are:
+ // x = ... atomic-var = ...
+ // ... = x capture-var = atomic-var (with optional converts)
+ // or
+ // ... = x capture-var = atomic-var (with optional converts)
+ // x = ... atomic-var = ...
+ //
+ // The case of 'a = b; b = a' is ambiguous, so pick the first one as capture
+ // (which makes more sense, as it captures the original value of the atomic
+ // variable).
+ //
+ // If the two statements don't fit these criteria, return a pair of default-
+ // constructed values.
+ using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,
+ const parser::ExecutionPartConstruct *>;
+
+ SourcedActionStmt act1{GetActionStmt(ec1)};
+ SourcedActionStmt act2{GetActionStmt(ec2)};
+ auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};
+ auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};
+ if (!maybeAssign1 || !maybeAssign2) {
+ if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {
+ context_.Say(source,
+ "ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);
+ }
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ auto as1{*maybeAssign1}, as2{*maybeAssign2};
+
+ auto isUpdateCapture{
+ [](const evaluate::Assignment &u, const evaluate::Assignment &c) {
+ return IsSameOrConvertOf(c.rhs, u.lhs);
+ }};
+
+ // Do some checks that narrow down the possible choices for the update
+ // and the capture statements. This will help to emit better diagnostics.
+ // 1. An assignment could be an update (cbu) if the left-hand side is a
+ // subexpression of the right-hand side.
+ // 2. An assignment could be a capture (cbc) if the right-hand side is
+ // a variable (or a function ref), with potential type conversions.
+ bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
+ bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
+ bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
+ bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
+
+ // We want to diagnose cases where both assignments cannot be an update,
+ // or both cannot be a capture, as well as cases where either assignment
+ // cannot be any of these two.
+ //
+ // If we organize these boolean values into a matrix
+ // |cbu1 cbu2|
+ // |cbc1 cbc2|
+ // then we want to diagnose cases where the matrix has a zero (i.e. "false")
+ // row or column, including the case where everything is zero. All these
+ // cases correspond to the determinant of the matrix being 0, which suggests
+ // that checking the det may be a convenient diagnostic check. There is only
+ // one additional case where the det is 0, which is when the matrix is all 1
+ // ("true"). The "all true" case represents the situation where both
+ // assignments could be an update as well as a capture. On the other hand,
+ // whenever det != 0, the roles of the update and the capture can be
+ // unambiguously assigned to as1 and as2 [1].
+ //
+ // [1] This can be easily verified by hand: there are 10 2x2 matrices with
+ // det = 0, leaving 6 cases where det != 0:
+ // 0 1 0 1 1 0 1 0 1 1 1 1
+ // 1 0 1 1 0 1 1 1 0 1 1 0
+ // In each case the classification is unambiguous.
+
+ // |cbu1 cbu2|
+ // det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1
+ int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};
+
+ auto errorCaptureShouldRead{[&](const parser::CharBlock &source,
+ const std::string &expr) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,
+ expr);
+ }};
+
+ auto errorNeitherWorks{[&]() {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);
+ }};
+
+ auto makeSelectionFromDet{[&](int det) -> ReturnTy {
+ // If det != 0, then the checks unambiguously suggest a specific
+ // categorization.
+ // If det == 0, then this function should be called only if the
+ // checks haven't ruled out any possibility, i.e. when both assigments
+ // could still be either updates or captures.
+ if (det > 0) {
+ // as1 is update, as2 is capture
+ if (isUpdateCapture(as1, as2)) {
+ return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);
+ } else {
+ errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());
+ return std::make_pair(nullptr, nullptr);
+ }
+ } else if (det < 0) {
+ // as2 is update, as1 is capture
+ if (isUpdateCapture(as2, as1)) {
+ return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
+ } else {
+ errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());
+ return std::make_pair(nullptr, nullptr);
+ }
+ } else {
+ bool updateFirst{isUpdateCapture(as1, as2)};
+ bool captureFirst{isUpdateCapture(as2, as1)};
+ if (updateFirst && captureFirst) {
+ // If both assignment could be the update and both could be the
+ // capture, emit a warning about the ambiguity.
+ context_.Say(act1.source,
+ "In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);
+ return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
+ }
+ if (updateFirst != captureFirst) {
+ const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};
+ const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};
+ return std::make_pair(upd, cap);
+ }
+ assert(!updateFirst && !captureFirst);
+ errorNeitherWorks();
+ return std::make_pair(nullptr, nullptr);
+ }
+ }};
+
+ if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {
+ return makeSelectionFromDet(det);
+ }
+ assert(det == 0 && "Prior checks should have covered det != 0");
+
+ // If neither of the statements is an RMW update, it could still be a
+ // "write" update. Pretty much any assignment can be a write update, so
+ // recompute det with cbu1 = cbu2 = true.
+ if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {
+ return makeSelectionFromDet(writeDet);
+ }
+
+ // It's only errors from here on.
+
+ if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {
+ errorNeitherWorks();
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ // The remaining cases are that
+ // - no candidate for update, or for capture,
+ // - one of the assigments cannot be anything.
+
+ if (!cbu1 && !cbu2) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ } else if (!cbc1 && !cbc2) {
+ context_.Say(source,
+ "In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {
+ auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;
+ context_.Say(src,
+ "In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);
+ return std::make_pair(nullptr, nullptr);
+ }
+
+ // All cases should have been covered.
+ llvm_unreachable("Unchecked condition");
+}
+
+void OmpStructureChecker::CheckAtomicCaptureAssignment(
+ const evaluate::Assignment &capture, const SomeExpr &atom,
+ parser::CharBlock source) {
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &cap{capture.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ } else {
+ CheckAtomicVariable(atom, rsrc);
+ // This part should have been checked prior to calling this function.
+ assert(*GetConvertInput(capture.rhs) == atom &&
+ "This cannot be a capture assignment");
+ CheckStorageOverlap(atom, {cap}, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicReadAssignment(
+ const evaluate::Assignment &read, parser::CharBlock source) {
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+
+ if (auto maybe{GetConvertInput(read.rhs)}) {
+ const SomeExpr &atom{*maybe};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ } else {
+ CheckAtomicVariable(atom, rsrc);
+ CheckStorageOverlap(atom, {read.lhs}, source);
+ }
+ } else {
+ ErrorShouldBeVariable(read.rhs, rsrc);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicWriteAssignment(
+ const evaluate::Assignment &write, parser::CharBlock source) {
+ // [6.0:190:13-15]
+ // A write structured block is write-statement, a write statement that has
+ // one of the following forms:
+ // x = expr
+ // x => expr
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &atom{write.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ } else {
+ CheckAtomicVariable(atom, lsrc);
+ CheckStorageOverlap(atom, {write.rhs}, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdateAssignment(
+ const evaluate::Assignment &update, parser::CharBlock source) {
+ // [6.0:191:1-7]
+ // An update structured block is update-statement, an update statement
+ // that has one of the following forms:
+ // x = x operator expr
+ // x = expr operator x
+ // x = intrinsic-procedure-name (x)
+ // x = intrinsic-procedure-name (x, expr-list)
+ // x = intrinsic-procedure-name (expr-list, x)
+ auto [lsrc, rsrc]{SplitAssignmentSource(source)};
+ const SomeExpr &atom{update.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, rsrc);
+ // Skip other checks.
+ return;
+ }
+
+ CheckAtomicVariable(atom, lsrc);
+
+ std::pair<operation::Operator, std::vector<SomeExpr>> top{
+ operation::Operator::Unknown, {}};
+ if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
+ top = GetTopLevelOperation(*maybeInput);
+ }
+ switch (top.first) {
+ case operation::Operator::Add:
+ case operation::Operator::Sub:
+ case operation::Operator::Mul:
+ case operation::Operator::Div:
+ case operation::Operator::And:
+ case operation::Operator::Or:
+ case operation::Operator::Eqv:
+ case operation::Operator::Neqv:
+ case operation::Operator::Min:
+ case operation::Operator::Max:
+ case operation::Operator::Identity:
+ break;
+ case operation::Operator::Call:
+ context_.Say(source,
+ "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Convert:
+ context_.Say(source,
+ "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Intrinsic:
+ context_.Say(source,
+ "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ case operation::Operator::Constant:
+ case operation::Operator::Unknown:
+ context_.Say(
+ source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);
+ return;
+ default:
+ assert(
+ top.first != operation::Operator::Identity && "Handle this separately");
+ context_.Say(source,
+ "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,
+ operation::ToString(top.first));
+ return;
+ }
+ // Check how many times `atom` occurs as an argument, if it's a subexpression
+ // of an argument, and collect the non-atom arguments.
+ std::vector<SomeExpr> nonAtom;
+ MaybeExpr subExpr;
+ auto atomCount{[&]() {
+ int count{0};
+ for (const SomeExpr &arg : top.second) {
+ if (IsSameOrConvertOf(arg, atom)) {
+ ++count;
+ } else {
+ if (!subExpr && IsSubexpressionOf(atom, arg)) {
+ subExpr = arg;
+ }
+ nonAtom.push_back(arg);
+ }
+ }
+ return count;
+ }()};
+
+ bool hasError{false};
+ if (subExpr) {
+ context_.Say(rsrc,
+ "The atomic variable %s cannot be a proper subexpression of an argument (here: %s) in the update operation"_err_en_US,
+ atom.AsFortran(), subExpr->AsFortran());
+ hasError = true;
+ }
+ if (top.first == operation::Operator::Identity) {
+ // This is "x = y".
+ assert((atomCount == 0 || atomCount == 1) && "Unexpected count");
+ if (atomCount == 0) {
+ context_.Say(rsrc,
+ "The atomic variable %s should appear as an argument in the update operation"_err_en_US,
+ atom.AsFortran());
+ hasError = true;
+ }
+ } else {
+ if (atomCount == 0) {
+ context_.Say(rsrc,
+ "The atomic variable %s should appear as an argument of the top-level %s operator"_err_en_US,
+ atom.AsFortran(), operation::ToString(top.first));
+ hasError = true;
+ } else if (atomCount > 1) {
+ context_.Say(rsrc,
+ "The atomic variable %s should be exactly one of the arguments of the top-level %s operator"_err_en_US,
+ atom.AsFortran(), operation::ToString(top.first));
+ hasError = true;
+ }
+ }
+
+ if (!hasError) {
+ CheckStorageOverlap(atom, nonAtom, source);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
+ const SomeExpr &cond, parser::CharBlock condSource,
+ const evaluate::Assignment &assign, parser::CharBlock assignSource) {
+ auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};
+ const SomeExpr &atom{assign.lhs};
+
+ if (!IsVarOrFunctionRef(atom)) {
+ ErrorShouldBeVariable(atom, arsrc);
+ // Skip other checks.
+ return;
+ }
+
+ CheckAtomicVariable(atom, alsrc);
+
+ auto top{GetTopLevelOperation(cond)};
+ // Missing arguments to operations would have been diagnosed by now.
+
+ switch (top.first) {
+ case operation::Operator::Associated:
+ if (atom != top.second.front()) {
+ context_.Say(assignSource,
+ "The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);
+ }
+ break;
+ // x equalop e | e equalop x (allowing "e equalop x" is an extension)
+ case operation::Operator::Eq:
+ case operation::Operator::Eqv:
+ // x ordop expr | expr ordop x
+ case operation::Operator::Lt:
+ case operation::Operator::Gt: {
+ const SomeExpr &arg0{top.second[0]};
+ const SomeExpr &arg1{top.second[1]};
+ if (IsSameOrConvertOf(arg0, atom)) {
+ CheckStorageOverlap(atom, {arg1}, condSource);
+ } else if (IsSameOrConvertOf(arg1, atom)) {
+ CheckStorageOverlap(atom, {arg0}, condSource);
+ } else {
+ assert(top.first != operation::Operator::Identity &&
+ "Handle this separately");
+ context_.Say(assignSource,
+ "An argument of the %s operator should be the target of the assignment"_err_en_US,
+ operation::ToString(top.first));
+ }
+ break;
+ }
+ case operation::Operator::Identity:
+ case operation::Operator::True:
+ case operation::Operator::False:
+ break;
+ default:
+ assert(
+ top.first != operation::Operator::Identity && "Handle this separately");
+ context_.Say(condSource,
+ "The %s operator is not a valid condition for ATOMIC operation"_err_en_US,
+ operation::ToString(top.first));
+ break;
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(
+ const AnalyzedCondStmt &update, parser::CharBlock source) {
+ // The condition/statements must be:
+ // - cond: x equalop e ift: x = d iff: -
+ // - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)
+ // - cond: associated(x) ift: x => expr iff: -
+ // - cond: associated(x, e) ift: x => expr iff: -
+
+ // The if-true statement must be present, and must be an assignment.
+ auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};
+ if (!maybeAssign) {
+ if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {
+ context_.Say(update.ift.source,
+ "In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);
+ } else {
+ context_.Say(
+ source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);
+ }
+ return;
+ }
+ const evaluate::Assignment assign{*maybeAssign};
+ const SomeExpr &atom{assign.lhs};
+
+ CheckAtomicConditionalUpdateAssignment(
+ update.cond, update.source, assign, update.ift.source);
+
+ CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);
+
+ if (update.iff) {
+ context_.Say(update.iff.source,
+ "In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdateOnly(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {
+ const SomeExpr &atom{maybeUpdate->lhs};
+ CheckAtomicUpdateAssignment(*maybeUpdate, action.source);
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Update, maybeUpdate),
+ MakeAtomicAnalysisOp(Analysis::None));
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);
+ }
+ } else {
+ context_.Say(x.source,
+ "ATOMIC UPDATE operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdate(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ // Allowable forms are (single-statement):
+ // - if ...
+ // - x = (... ? ... : x)
+ // and two-statement:
+ // - r = cond ; if (r) ...
+
+ const parser::ExecutionPartConstruct *ust{nullptr}; // update
+ const parser::ExecutionPartConstruct *cst{nullptr}; // condition
+
+ if (body.size() == 1) {
+ ust = &body.front();
+ } else if (body.size() == 2) {
+ cst = &body.front();
+ ust = &body.back();
+ } else {
+ context_.Say(source,
+ "ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);
+ return;
+ }
+
+ // Flang doesn't support conditional-expr yet, so all update statements
+ // are if-statements.
+
+ // IfStmt: if (...) ...
+ // IfConstruct: if (...) then ... endif
+ auto maybeUpdate{AnalyzeConditionalStmt(ust)};
+ if (!maybeUpdate) {
+ context_.Say(source,
+ "In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);
+ return;
+ }
+
+ AnalyzedCondStmt &update{*maybeUpdate};
+
+ if (SourcedActionStmt action{GetActionStmt(cst)}) {
+ // The "condition" statement must be `r = cond`.
+ if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {
+ if (maybeCond->lhs != update.cond) {
+ context_.Say(update.source,
+ "In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,
+ maybeCond->lhs.AsFortran());
+ } else {
+ // If it's "r = ...; if (r) ..." then put the original condition
+ // in `update`.
+ update.cond = maybeCond->rhs;
+ }
+ } else {
+ context_.Say(action.source,
+ "In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);
+ }
+ }
+
+ evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};
+
+ CheckAtomicConditionalUpdateStmt(update, source);
+ if (IsCheckForAssociated(update.cond)) {
+ if (!IsPointerAssignment(assign)) {
+ context_.Say(source,
+ "The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);
+ }
+ } else {
+ if (IsPointerAssignment(assign)) {
+ context_.Say(source,
+ "The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);
+ }
+ }
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(assign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Update | Analysis::IfTrue, assign),
+ MakeAtomicAnalysisOp(Analysis::None));
+}
+
+void OmpStructureChecker::CheckAtomicUpdateCapture(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ if (body.size() != 2) {
+ context_.Say(source,
+ "ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);
+ return;
+ }
+
+ auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};
+ if (!uec || !cec) {
+ // Diagnostics already emitted.
+ return;
+ }
+ SourcedActionStmt uact{GetActionStmt(uec)};
+ SourcedActionStmt cact{GetActionStmt(cec)};
+ // The "dereferences" of std::optional are guaranteed to be valid after
+ // CheckUpdateCapture.
+ evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};
+ evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};
+
+ const SomeExpr &atom{update.lhs};
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ int action;
+
+ if (IsMaybeAtomicWrite(update)) {
+ action = Analysis::Write;
+ CheckAtomicWriteAssignment(update, uact.source);
+ } else {
+ action = Analysis::Update;
+ CheckAtomicUpdateAssignment(update, uact.source);
+ }
+ CheckAtomicCaptureAssignment(capture, atom, cact.source);
+
+ if (IsPointerAssignment(update) != IsPointerAssignment(capture)) {
+ context_.Say(cact.source,
+ "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
+ return;
+ }
+
+ if (GetActionStmt(&body.front()).stmt == uact.stmt) {
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(action, update),
+ MakeAtomicAnalysisOp(Analysis::Read, capture));
+ } else {
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Read, capture),
+ MakeAtomicAnalysisOp(action, update));
+ }
+}
+
+void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(
+ const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
+ parser::CharBlock source) {
+ // There are two
diff erent variants of this:
+ // (1) conditional-update and capture separately:
+ // This form only allows single-statement updates, i.e. the update
+ // form "r = cond; if (r) ..." is not allowed.
+ // (2) conditional-update combined with capture in a single statement:
+ // This form does allow the condition to be calculated separately,
+ // i.e. "r = cond; if (r) ...".
+ // Regardless of what form it is, the actual update assignment is a
+ // proper write, i.e. "x = d", where d does not depend on x.
+
+ AnalyzedCondStmt update;
+ SourcedActionStmt capture;
+ bool captureAlways{true}, captureFirst{true};
+
+ auto extractCapture{[&]() {
+ capture = update.iff;
+ captureAlways = false;
+ update.iff = SourcedActionStmt{};
+ }};
+
+ auto classifyNonUpdate{[&](const SourcedActionStmt &action) {
+ // The non-update statement is either "r = cond" or the capture.
+ if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {
+ if (update.cond == maybeAssign->lhs) {
+ // If this is "r = cond; if (r) ...", then update the condition.
+ update.cond = maybeAssign->rhs;
+ update.source = action.source;
+ // In this form, the update and the capture are combined into
+ // an IF-THEN-ELSE statement.
+ extractCapture();
+ } else {
+ // Assume this is the capture-statement.
+ capture = action;
+ }
+ }
+ }};
+
+ if (body.size() == 2) {
+ // This could be
+ // - capture; conditional-update (in any order), or
+ // - r = cond; if (r) capture-update
+ const parser::ExecutionPartConstruct *st1{&body.front()};
+ const parser::ExecutionPartConstruct *st2{&body.back()};
+ // In either case, the conditional statement can be analyzed by
+ // AnalyzeConditionalStmt, whereas the other statement cannot.
+ if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {
+ update = *maybeUpdate1;
+ classifyNonUpdate(GetActionStmt(st2));
+ captureFirst = false;
+ } else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {
+ update = *maybeUpdate2;
+ classifyNonUpdate(GetActionStmt(st1));
+ } else {
+ // None of the statements are conditional, this rules out the
+ // "r = cond; if (r) ..." and the "capture + conditional-update"
+ // variants. This could still be capture + write (which is classified
+ // as conditional-update-capture in the spec).
+ auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};
+ if (!uec || !cec) {
+ // Diagnostics already emitted.
+ return;
+ }
+ SourcedActionStmt uact{GetActionStmt(uec)};
+ SourcedActionStmt cact{GetActionStmt(cec)};
+ update.ift = uact;
+ capture = cact;
+ if (uec == st1) {
+ captureFirst = false;
+ }
+ }
+ } else if (body.size() == 1) {
+ if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {
+ update = *maybeUpdate;
+ // This is the form with update and capture combined into an IF-THEN-ELSE
+ // statement. The capture-statement is always the ELSE branch.
+ extractCapture();
+ } else {
+ goto invalid;
+ }
+ } else {
+ context_.Say(source,
+ "ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);
+ return;
+ invalid:
+ context_.Say(source,
+ "Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);
+ return;
+ }
+
+ // The update must have a form `x = d` or `x => d`.
+ if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {
+ const SomeExpr &atom{maybeWrite->lhs};
+ CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);
+ if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {
+ CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);
+
+ if (IsPointerAssignment(*maybeWrite) !=
+ IsPointerAssignment(*maybeCapture)) {
+ context_.Say(capture.source,
+ "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
+ return;
+ }
+ } else {
+ if (!IsAssignment(capture.stmt)) {
+ context_.Say(capture.source,
+ "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);
+ }
+ return;
+ }
+ } else {
+ if (!IsAssignment(update.ift.stmt)) {
+ context_.Say(update.ift.source,
+ "In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);
+ }
+ return;
+ }
+
+ // update.iff should be empty here, the capture statement should be
+ // stored in "capture".
+
+ // Fill out the analysis in the AST node.
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ bool condUnused{std::visit(
+ [](auto &&s) {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {
+ return true;
+ } else {
+ return false;
+ }
+ },
+ update.cond.u)};
+
+ int updateWhen{!condUnused ? Analysis::IfTrue : 0};
+ int captureWhen{!captureAlways ? Analysis::IfFalse : 0};
+
+ evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};
+ evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};
+
+ if (captureFirst) {
+ x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign),
+ MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign));
+ } else {
+ x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
+ MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign),
+ MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign));
+ }
+}
+
+void OmpStructureChecker::CheckAtomicRead(
+ const parser::OpenMPAtomicConstruct &x) {
+ // [6.0:190:5-7]
+ // A read structured block is read-statement, a read statement that has one
+ // of the following forms:
+ // v = x
+ // v => x
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &block{std::get<parser::Block>(x.t)};
+
+ // Read cannot be conditional or have a capture statement.
+ if (x.IsCompare() || x.IsCapture()) {
+ context_.Say(dirSpec.source,
+ "ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);
+ return;
+ }
+
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {
+ CheckAtomicReadAssignment(*maybeRead, action.source);
+
+ if (auto maybe{GetConvertInput(maybeRead->rhs)}) {
+ const SomeExpr &atom{*maybe};
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Read, maybeRead),
+ MakeAtomicAnalysisOp(Analysis::None));
+ }
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ x.source, "ATOMIC READ operation should be an assignment"_err_en_US);
+ }
+ } else {
+ context_.Say(x.source,
+ "ATOMIC READ operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicWrite(
+ const parser::OpenMPAtomicConstruct &x) {
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &block{std::get<parser::Block>(x.t)};
+
+ // Write cannot be conditional or have a capture statement.
+ if (x.IsCompare() || x.IsCapture()) {
+ context_.Say(dirSpec.source,
+ "ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);
+ return;
+ }
+
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (body.size() == 1) {
+ SourcedActionStmt action{GetActionStmt(&body.front())};
+ if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {
+ const SomeExpr &atom{maybeWrite->lhs};
+ CheckAtomicWriteAssignment(*maybeWrite, action.source);
+
+ using Analysis = parser::OpenMPAtomicConstruct::Analysis;
+ x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
+ MakeAtomicAnalysisOp(Analysis::Write, maybeWrite),
+ MakeAtomicAnalysisOp(Analysis::None));
+ } else if (!IsAssignment(action.stmt)) {
+ context_.Say(
+ x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);
+ }
+ } else {
+ context_.Say(x.source,
+ "ATOMIC WRITE operation should have a single statement"_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckAtomicUpdate(
+ const parser::OpenMPAtomicConstruct &x) {
+ auto &block{std::get<parser::Block>(x.t)};
+
+ bool isConditional{x.IsCompare()};
+ bool isCapture{x.IsCapture()};
+ const parser::Block &body{GetInnermostExecPart(block)};
+
+ if (isConditional && isCapture) {
+ CheckAtomicConditionalUpdateCapture(x, body, x.source);
+ } else if (isConditional) {
+ CheckAtomicConditionalUpdate(x, body, x.source);
+ } else if (isCapture) {
+ CheckAtomicUpdateCapture(x, body, x.source);
+ } else { // update-only
+ CheckAtomicUpdateOnly(x, body, x.source);
+ }
+}
+
+void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
+ if (visitedAtomicSource_.empty())
+ visitedAtomicSource_ = x.source;
+
+ // All of the following groups have the "exclusive" property, i.e. at
+ // most one clause from each group is allowed.
+ // The exclusivity-checking code should eventually be unified for all
+ // clauses, with clause groups defined in OMP.td.
+ std::array atomic{llvm::omp::Clause::OMPC_read,
+ llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};
+ std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,
+ llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,
+ llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};
+
+ auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,
+ std::string_view name,
+ const parser::OmpClauseList &clauses) {
+ const parser::OmpClause *present{nullptr};
+ for (const parser::OmpClause &clause : clauses.v) {
+ llvm::omp::Clause id{clause.Id()};
+ if (!llvm::is_contained(group, id)) {
+ continue;
+ }
+ if (present == nullptr) {
+ present = &clause;
+ continue;
+ } else if (id == present->Id()) {
+ // Ignore repetitions of the same clause, those will be diagnosed
+ // separately.
+ continue;
+ }
+ parser::MessageFormattedText txt(
+ "At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,
+ name.data());
+ parser::Message message(clause.source, txt);
+ message.Attach(present->source,
+ "Previous clause from this group provided here"_en_US);
+ context_.Say(std::move(message));
+ return;
+ }
+ }};
+
+ auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
+ auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);
+ llvm::omp::Clause kind{x.GetKind()};
+
+ checkExclusive(atomic, "atomic", dirSpec.Clauses());
+ checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());
+
+ switch (kind) {
+ case llvm::omp::Clause::OMPC_read:
+ CheckAtomicRead(x);
+ break;
+ case llvm::omp::Clause::OMPC_write:
+ CheckAtomicWrite(x);
+ break;
+ case llvm::omp::Clause::OMPC_update:
+ CheckAtomicUpdate(x);
+ break;
+ default:
+ break;
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
+ dirContext_.pop_back();
+}
+
+} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp
new file mode 100644
index 0000000000000..b82e2f7342d85
--- /dev/null
+++ b/flang/lib/Semantics/check-omp-loop.cpp
@@ -0,0 +1,671 @@
+//===-- lib/Semantics/check-omp-loop.cpp ----------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Semantic checks for constructs and clauses related to loops.
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-omp-structure.h"
+
+#include "check-directive-structure.h"
+#include "openmp-utils.h"
+
+#include "flang/Common/idioms.h"
+#include "flang/Common/visit.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/parse-tree-visitor.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
+#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol.h"
+#include "flang/Semantics/tools.h"
+#include "flang/Semantics/type.h"
+
+#include "llvm/Frontend/OpenMP/OMP.h"
+
+#include <cstdint>
+#include <map>
+#include <optional>
+#include <string>
+#include <tuple>
+#include <variant>
+
+namespace {
+using namespace Fortran;
+
+class AssociatedLoopChecker {
+public:
+ AssociatedLoopChecker(
+ semantics::SemanticsContext &context, std::int64_t level)
+ : context_{context}, level_{level} {}
+
+ template <typename T> bool Pre(const T &) { return true; }
+ template <typename T> void Post(const T &) {}
+
+ bool Pre(const parser::DoConstruct &dc) {
+ level_--;
+ const auto &doStmt{
+ std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
+ const auto &constructName{
+ std::get<std::optional<parser::Name>>(doStmt.statement.t)};
+ if (constructName) {
+ constructNamesAndLevels_.emplace(
+ constructName.value().ToString(), level_);
+ }
+ if (level_ >= 0) {
+ if (dc.IsDoWhile()) {
+ context_.Say(doStmt.source,
+ "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
+ }
+ if (!dc.GetLoopControl()) {
+ context_.Say(doStmt.source,
+ "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
+ }
+ }
+ return true;
+ }
+
+ void Post(const parser::DoConstruct &dc) { level_++; }
+
+ bool Pre(const parser::CycleStmt &cyclestmt) {
+ std::map<std::string, std::int64_t>::iterator it;
+ bool err{false};
+ if (cyclestmt.v) {
+ it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
+ err = (it != constructNamesAndLevels_.end() && it->second > 0);
+ } else { // If there is no label then use the level of the last enclosing DO
+ err = level_ > 0;
+ }
+ if (err) {
+ context_.Say(*source_,
+ "CYCLE statement to non-innermost associated loop of an OpenMP DO "
+ "construct"_err_en_US);
+ }
+ return true;
+ }
+
+ bool Pre(const parser::ExitStmt &exitStmt) {
+ std::map<std::string, std::int64_t>::iterator it;
+ bool err{false};
+ if (exitStmt.v) {
+ it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
+ err = (it != constructNamesAndLevels_.end() && it->second >= 0);
+ } else { // If there is no label then use the level of the last enclosing DO
+ err = level_ >= 0;
+ }
+ if (err) {
+ context_.Say(*source_,
+ "EXIT statement terminates associated loop of an OpenMP DO "
+ "construct"_err_en_US);
+ }
+ return true;
+ }
+
+ bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
+ source_ = &actionstmt.source;
+ return true;
+ }
+
+private:
+ semantics::SemanticsContext &context_;
+ const parser::CharBlock *source_;
+ std::int64_t level_;
+ std::map<std::string, std::int64_t> constructNamesAndLevels_;
+};
+} // namespace
+
+namespace Fortran::semantics {
+
+using namespace Fortran::semantics::omp;
+
+void OmpStructureChecker::HasInvalidDistributeNesting(
+ const parser::OpenMPLoopConstruct &x) {
+ bool violation{false};
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+ if (llvm::omp::topDistributeSet.test(beginDir.v)) {
+ // `distribute` region has to be nested
+ if (!CurrentDirectiveIsNested()) {
+ violation = true;
+ } else {
+ // `distribute` region has to be strictly nested inside `teams`
+ if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
+ violation = true;
+ }
+ }
+ }
+ if (violation) {
+ context_.Say(beginDir.source,
+ "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
+ "region."_err_en_US);
+ }
+}
+void OmpStructureChecker::HasInvalidLoopBinding(
+ const parser::OpenMPLoopConstruct &x) {
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+
+ auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
+ const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+ for (const auto &clause : clauseList.v) {
+ if (const auto *bindClause{
+ std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
+ if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {
+ context_.Say(beginDir.source, msg);
+ }
+ }
+ }
+ };
+
+ if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
+ CurrentDirectiveIsNested() &&
+ llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
+ teamsBindingChecker(
+ "`BIND(TEAMS)` must be specified since the `LOOP` region is "
+ "strictly nested inside a `TEAMS` region."_err_en_US);
+ }
+
+ if (OmpDirectiveSet{
+ llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
+ .test(beginDir.v)) {
+ teamsBindingChecker(
+ "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
+ "combined with a `TEAMS` construct."_err_en_US);
+ }
+}
+
+void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
+ // Check the following:
+ // The only OpenMP constructs that can be encountered during execution of
+ // a simd region are the `atomic` construct, the `loop` construct, the `simd`
+ // construct and the `ordered` construct with the `simd` clause.
+
+ // Check if the parent context has the SIMD clause
+ // Please note that we use GetContext() instead of GetContextParent()
+ // because PushContextAndClauseSets() has not been called on the
+ // current context yet.
+ // TODO: Check for declare simd regions.
+ bool eligibleSIMD{false};
+ common::visit(
+ common::visitors{
+ // Allow `!$OMP ORDERED SIMD`
+ [&](const parser::OpenMPBlockConstruct &c) {
+ const auto &beginBlockDir{
+ std::get<parser::OmpBeginBlockDirective>(c.t)};
+ const auto &beginDir{
+ std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+ if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
+ const auto &clauses{
+ std::get<parser::OmpClauseList>(beginBlockDir.t)};
+ for (const auto &clause : clauses.v) {
+ if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
+ eligibleSIMD = true;
+ break;
+ }
+ }
+ }
+ },
+ [&](const parser::OpenMPStandaloneConstruct &c) {
+ if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
+ &c.u)}) {
+ llvm::omp::Directive dirId{ssc->v.DirId()};
+ if (dirId == llvm::omp::Directive::OMPD_ordered) {
+ for (const parser::OmpClause &x : ssc->v.Clauses().v) {
+ if (x.Id() == llvm::omp::Clause::OMPC_simd) {
+ eligibleSIMD = true;
+ break;
+ }
+ }
+ } else if (dirId == llvm::omp::Directive::OMPD_scan) {
+ eligibleSIMD = true;
+ }
+ }
+ },
+ // Allowing SIMD and loop construct
+ [&](const parser::OpenMPLoopConstruct &c) {
+ const auto &beginLoopDir{
+ std::get<parser::OmpBeginLoopDirective>(c.t)};
+ const auto &beginDir{
+ std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+ if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
+ (beginDir.v == llvm::omp::Directive::OMPD_do_simd) ||
+ (beginDir.v == llvm::omp::Directive::OMPD_loop)) {
+ eligibleSIMD = true;
+ }
+ },
+ [&](const parser::OpenMPAtomicConstruct &c) {
+ // Allow `!$OMP ATOMIC`
+ eligibleSIMD = true;
+ },
+ [&](const auto &c) {},
+ },
+ c.u);
+ if (!eligibleSIMD) {
+ context_.Say(parser::FindSourceLocation(c),
+ "The only OpenMP constructs that can be encountered during execution "
+ "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
+ "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
+ "construct with the `SIMD` clause."_err_en_US);
+ }
+}
+
+void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
+ loopStack_.push_back(&x);
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+
+ PushContextAndClauseSets(beginDir.source, beginDir.v);
+
+ // check matching, End directive is optional
+ if (const auto &endLoopDir{
+ std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
+ const auto &endDir{
+ std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
+
+ CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
+
+ AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endLoopDir->t));
+ }
+
+ if (llvm::omp::allSimdSet.test(GetContext().directive)) {
+ EnterDirectiveNest(SIMDNest);
+ }
+
+ // Combined target loop constructs are target device constructs. Keep track of
+ // whether any such construct has been visited to later check that REQUIRES
+ // directives for target-related options don't appear after them.
+ if (llvm::omp::allTargetSet.test(beginDir.v)) {
+ deviceConstructFound_ = true;
+ }
+
+ if (beginDir.v == llvm::omp::Directive::OMPD_do) {
+ // 2.7.1 do-clause -> private-clause |
+ // firstprivate-clause |
+ // lastprivate-clause |
+ // linear-clause |
+ // reduction-clause |
+ // schedule-clause |
+ // collapse-clause |
+ // ordered-clause
+
+ // nesting check
+ HasInvalidWorksharingNesting(
+ beginDir.source, llvm::omp::nestedWorkshareErrSet);
+ }
+ SetLoopInfo(x);
+
+ auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
+ if (optLoopCons.has_value()) {
+ if (const auto &doConstruct{
+ std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
+ const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
+ CheckNoBranching(doBlock, beginDir.v, beginDir.source);
+ }
+ }
+ CheckLoopItrVariableIsInt(x);
+ CheckAssociatedLoopConstraints(x);
+ HasInvalidDistributeNesting(x);
+ HasInvalidLoopBinding(x);
+ if (CurrentDirectiveIsNested() &&
+ llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
+ HasInvalidTeamsNesting(beginDir.v, beginDir.source);
+ }
+ if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
+ (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
+ CheckDistLinear(x);
+ }
+}
+
+const parser::Name OmpStructureChecker::GetLoopIndex(
+ const parser::DoConstruct *x) {
+ using Bounds = parser::LoopControl::Bounds;
+ return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
+}
+
+void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
+ auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
+ if (optLoopCons.has_value()) {
+ if (const auto &loopConstruct{
+ std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
+ const parser::DoConstruct *loop{&*loopConstruct};
+ if (loop && loop->IsDoNormal()) {
+ const parser::Name &itrVal{GetLoopIndex(loop)};
+ SetLoopIv(itrVal.symbol);
+ }
+ }
+ }
+}
+
+void OmpStructureChecker::CheckLoopItrVariableIsInt(
+ const parser::OpenMPLoopConstruct &x) {
+ auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
+ if (optLoopCons.has_value()) {
+ if (const auto &loopConstruct{
+ std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
+
+ for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
+ if (loop->IsDoNormal()) {
+ const parser::Name &itrVal{GetLoopIndex(loop)};
+ if (itrVal.symbol) {
+ const auto *type{itrVal.symbol->GetType()};
+ if (!type->IsNumeric(TypeCategory::Integer)) {
+ context_.Say(itrVal.source,
+ "The DO loop iteration"
+ " variable must be of the type integer."_err_en_US,
+ itrVal.ToString());
+ }
+ }
+ }
+ // Get the next DoConstruct if block is not empty.
+ const auto &block{std::get<parser::Block>(loop->t)};
+ const auto it{block.begin()};
+ loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
+ : nullptr;
+ }
+ }
+ }
+}
+
+std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
+ const parser::OpenMPLoopConstruct &x) {
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+ std::int64_t orderedCollapseLevel{1};
+ std::int64_t orderedLevel{1};
+ std::int64_t collapseLevel{1};
+
+ for (const auto &clause : clauseList.v) {
+ if (const auto *collapseClause{
+ std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
+ if (const auto v{GetIntValue(collapseClause->v)}) {
+ collapseLevel = *v;
+ }
+ }
+ if (const auto *orderedClause{
+ std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
+ if (const auto v{GetIntValue(orderedClause->v)}) {
+ orderedLevel = *v;
+ }
+ }
+ }
+ if (orderedLevel >= collapseLevel) {
+ orderedCollapseLevel = orderedLevel;
+ } else {
+ orderedCollapseLevel = collapseLevel;
+ }
+ return orderedCollapseLevel;
+}
+
+void OmpStructureChecker::CheckAssociatedLoopConstraints(
+ const parser::OpenMPLoopConstruct &x) {
+ std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
+ AssociatedLoopChecker checker{context_, ordCollapseLevel};
+ parser::Walk(x, checker);
+}
+
+void OmpStructureChecker::CheckDistLinear(
+ const parser::OpenMPLoopConstruct &x) {
+
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+
+ SymbolSourceMap indexVars;
+
+ // Collect symbols of all the variables from linear clauses
+ for (auto &clause : clauses.v) {
+ if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
+ auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};
+ GetSymbolsInObjectList(objects, indexVars);
+ }
+ }
+
+ if (!indexVars.empty()) {
+ // Get collapse level, if given, to find which loops are "associated."
+ std::int64_t collapseVal{GetOrdCollapseLevel(x)};
+ // Include the top loop if no collapse is specified
+ if (collapseVal == 0) {
+ collapseVal = 1;
+ }
+
+ // Match the loop index variables with the collected symbols from linear
+ // clauses.
+ auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
+ if (optLoopCons.has_value()) {
+ if (const auto &loopConstruct{
+ std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
+ for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
+ if (loop->IsDoNormal()) {
+ const parser::Name &itrVal{GetLoopIndex(loop)};
+ if (itrVal.symbol) {
+ // Remove the symbol from the collected set
+ indexVars.erase(&itrVal.symbol->GetUltimate());
+ }
+ collapseVal--;
+ if (collapseVal == 0) {
+ break;
+ }
+ }
+ // Get the next DoConstruct if block is not empty.
+ const auto &block{std::get<parser::Block>(loop->t)};
+ const auto it{block.begin()};
+ loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
+ : nullptr;
+ }
+ }
+ }
+
+ // Show error for the remaining variables
+ for (auto &[symbol, source] : indexVars) {
+ const Symbol &root{GetAssociationRoot(*symbol)};
+ context_.Say(source,
+ "Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,
+ root.name());
+ }
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+
+ // A few semantic checks for InScan reduction are performed below as SCAN
+ // constructs inside LOOP may add the relevant information. Scan reduction is
+ // supported only in loop constructs, so same checks are not applicable to
+ // other directives.
+ using ReductionModifier = parser::OmpReductionModifier;
+ for (const auto &clause : clauseList.v) {
+ if (const auto *reductionClause{
+ std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
+ auto &modifiers{OmpGetModifiers(reductionClause->v)};
+ auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};
+ if (maybeModifier &&
+ maybeModifier->v == ReductionModifier::Value::Inscan) {
+ const auto &objectList{
+ std::get<parser::OmpObjectList>(reductionClause->v.t)};
+ auto checkReductionSymbolInScan = [&](const parser::Name *name) {
+ if (auto &symbol = name->symbol) {
+ if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
+ !symbol->test(Symbol::Flag::OmpExclusiveScan)) {
+ context_.Say(name->source,
+ "List item %s must appear in EXCLUSIVE or "
+ "INCLUSIVE clause of an "
+ "enclosed SCAN directive"_err_en_US,
+ name->ToString());
+ }
+ }
+ };
+ for (const auto &ompObj : objectList.v) {
+ common::visit(
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ if (const auto *name{semantics::getDesignatorNameIfDataRef(
+ designator)}) {
+ checkReductionSymbolInScan(name);
+ }
+ },
+ [&](const auto &name) { checkReductionSymbolInScan(&name); },
+ },
+ ompObj.u);
+ }
+ }
+ }
+ }
+ if (llvm::omp::allSimdSet.test(GetContext().directive)) {
+ ExitDirectiveNest(SIMDNest);
+ }
+ dirContext_.pop_back();
+
+ assert(!loopStack_.empty() && "Expecting non-empty loop stack");
+#ifndef NDEBUG
+ const LoopConstruct &top{loopStack_.back()};
+ auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
+ assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
+#endif
+ loopStack_.pop_back();
+}
+
+void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
+ const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
+ ResetPartialContext(dir.source);
+ switch (dir.v) {
+ // 2.7.1 end-do -> END DO [nowait-clause]
+ // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
+ case llvm::omp::Directive::OMPD_do:
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
+ break;
+ case llvm::omp::Directive::OMPD_do_simd:
+ PushContextAndClauseSets(
+ dir.source, llvm::omp::Directive::OMPD_end_do_simd);
+ break;
+ default:
+ // no clauses are allowed
+ break;
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
+ if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
+ (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
+ dirContext_.pop_back();
+ }
+}
+
+void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
+ CheckAllowedClause(llvm::omp::Clause::OMPC_linear);
+ unsigned version{context_.langOptions().OpenMPVersion};
+ llvm::omp::Directive dir{GetContext().directive};
+ parser::CharBlock clauseSource{GetContext().clauseSource};
+ const parser::OmpLinearModifier *linearMod{nullptr};
+
+ SymbolSourceMap symbols;
+ auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
+ CheckCrayPointee(objects, "LINEAR", false);
+ GetSymbolsInObjectList(objects, symbols);
+
+ auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {
+ if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
+ auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
+ context_.Say(source,
+ "The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,
+ symbol->name(), desc.name.str());
+ }
+ }};
+
+ if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {
+ auto &modifiers{OmpGetModifiers(x.v)};
+ linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);
+ if (linearMod) {
+ // 2.7 Loop Construct Restriction
+ if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {
+ context_.Say(clauseSource,
+ "A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,
+ ContextDirectiveAsFortran());
+ return;
+ }
+
+ auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
+ for (auto &[symbol, source] : symbols) {
+ if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {
+ CheckIntegerNoRef(symbol, source);
+ } else {
+ if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&
+ !IsPolymorphic(*symbol)) {
+ context_.Say(source,
+ "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,
+ symbol->name(), desc.name.str());
+ }
+ }
+ if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||
+ linearMod->v == parser::OmpLinearModifier::Value::Uval) {
+ if (!IsDummy(*symbol) || IsValue(*symbol)) {
+ context_.Say(source,
+ "If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,
+ desc.name.str(), symbol->name());
+ }
+ }
+ } // for (symbol, source)
+
+ if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {
+ context_.Say(OmpGetModifierSource(modifiers, linearMod),
+ "The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,
+ ThisVersion(version));
+ }
+ }
+ }
+
+ // OpenMP 5.2: Ordered clause restriction
+ if (const auto *clause{
+ FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {
+ const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};
+ if (orderedClause.v) {
+ return;
+ }
+ }
+
+ // OpenMP 5.2: Linear clause Restrictions
+ for (auto &[symbol, source] : symbols) {
+ if (!linearMod) {
+ // Already checked this with the modifier present.
+ CheckIntegerNoRef(symbol, source);
+ }
+ if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {
+ context_.Say(source,
+ "The list item `%s` must be a dummy argument"_err_en_US,
+ symbol->name());
+ }
+ if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {
+ context_.Say(source,
+ "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,
+ symbol->name());
+ }
+ if (FindCommonBlockContaining(*symbol)) {
+ context_.Say(source,
+ "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,
+ symbol->name());
+ }
+ }
+}
+
+void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
+ Base::Enter(x);
+ loopStack_.push_back(&x);
+}
+
+void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
+ assert(!loopStack_.empty() && "Expecting non-empty loop stack");
+#ifndef NDEBUG
+ const LoopConstruct &top = loopStack_.back();
+ auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
+ assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
+#endif
+ loopStack_.pop_back();
+ Base::Leave(x);
+}
+
+} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-omp-metadirective.cpp b/flang/lib/Semantics/check-omp-metadirective.cpp
new file mode 100644
index 0000000000000..03487da64f1bf
--- /dev/null
+++ b/flang/lib/Semantics/check-omp-metadirective.cpp
@@ -0,0 +1,548 @@
+//===-- lib/Semantics/check-omp-metadirective.cpp -------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Semantic checks for METADIRECTIVE and related constructs/clauses.
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-omp-structure.h"
+
+#include "openmp-utils.h"
+
+#include "flang/Common/idioms.h"
+#include "flang/Common/indirection.h"
+#include "flang/Common/visit.h"
+#include "flang/Parser/characters.h"
+#include "flang/Parser/message.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/tools.h"
+
+#include "llvm/Frontend/OpenMP/OMP.h"
+
+#include <list>
+#include <map>
+#include <optional>
+#include <set>
+#include <string>
+#include <tuple>
+#include <utility>
+#include <variant>
+
+namespace Fortran::semantics {
+
+using namespace Fortran::semantics::omp;
+
+void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
+ CheckAllowedClause(llvm::omp::Clause::OMPC_when);
+ OmpVerifyModifiers(
+ x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
+}
+
+void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
+ EnterDirectiveNest(ContextSelectorNest);
+
+ using SetName = parser::OmpTraitSetSelectorName;
+ std::map<SetName::Value, const SetName *> visited;
+
+ for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
+ auto &name{std::get<SetName>(traitSet.t)};
+ auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
+ if (!unique) {
+ std::string showName{parser::ToUpperCaseLetters(name.ToString())};
+ parser::MessageFormattedText txt(
+ "Repeated trait set name %s in a context specifier"_err_en_US,
+ showName);
+ parser::Message message(name.source, txt);
+ message.Attach(prev->second->source,
+ "Previous trait set %s provided here"_en_US, showName);
+ context_.Say(std::move(message));
+ }
+ CheckTraitSetSelector(traitSet);
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
+ ExitDirectiveNest(ContextSelectorNest);
+}
+
+const std::list<parser::OmpTraitProperty> &
+OmpStructureChecker::GetTraitPropertyList(
+ const parser::OmpTraitSelector &trait) {
+ static const std::list<parser::OmpTraitProperty> empty{};
+ auto &[_, maybeProps]{trait.t};
+ if (maybeProps) {
+ using PropertyList = std::list<parser::OmpTraitProperty>;
+ return std::get<PropertyList>(maybeProps->t);
+ } else {
+ return empty;
+ }
+}
+
+std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
+ const parser::OmpTraitProperty &property) {
+ using MaybeClause = std::optional<llvm::omp::Clause>;
+
+ // The parser for OmpClause will only succeed if the clause was
+ // given with all required arguments.
+ // If this is a string or complex extension with a clause name,
+ // treat it as a clause and let the trait checker deal with it.
+
+ auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
+ auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
+ if (id != llvm::omp::Clause::OMPC_unknown) {
+ return id;
+ } else {
+ return std::nullopt;
+ }
+ }};
+
+ return common::visit( //
+ common::visitors{
+ [&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
+ return getClauseFromString(x.v);
+ },
+ [&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
+ return x.value().Id();
+ },
+ [&](const parser::ScalarExpr &x) -> MaybeClause {
+ return std::nullopt;
+ },
+ [&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
+ using ExtProperty = parser::OmpTraitPropertyExtension;
+ if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
+ return getClauseFromString(name->v);
+ } else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
+ return getClauseFromString(
+ std::get<parser::OmpTraitPropertyName>(cpx->t).v);
+ }
+ return std::nullopt;
+ },
+ },
+ property.u);
+}
+
+void OmpStructureChecker::CheckTraitSelectorList(
+ const std::list<parser::OmpTraitSelector> &traits) {
+ // [6.0:322:20]
+ // Each trait-selector-name may only be specified once in a trait selector
+ // set.
+
+ // Cannot store OmpTraitSelectorName directly, because it's not copyable.
+ using TraitName = parser::OmpTraitSelectorName;
+ using BareName = decltype(TraitName::u);
+ std::map<BareName, const TraitName *> visited;
+
+ for (const parser::OmpTraitSelector &trait : traits) {
+ auto &name{std::get<TraitName>(trait.t)};
+
+ auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
+ if (!unique) {
+ std::string showName{parser::ToUpperCaseLetters(name.ToString())};
+ parser::MessageFormattedText txt(
+ "Repeated trait name %s in a trait set"_err_en_US, showName);
+ parser::Message message(name.source, txt);
+ message.Attach(prev->second->source,
+ "Previous trait %s provided here"_en_US, showName);
+ context_.Say(std::move(message));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitSetSelector(
+ const parser::OmpTraitSetSelector &traitSet) {
+
+ // Trait Set | Allowed traits | D-traits | X-traits | Score |
+ //
+ // Construct | Simd, directive-name | Yes | No | No |
+ // Device | Arch, Isa, Kind | No | Yes | No |
+ // Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
+ // | Extension, Requires | | | |
+ // | Vendor | | | |
+ // Target_Device | Arch, Device_Num, Isa | No | Yes | No |
+ // | Kind, Uid | | | |
+ // User | Condition | No | No | Yes |
+
+ struct TraitSetConfig {
+ std::set<parser::OmpTraitSelectorName::Value> allowed;
+ bool allowsDirectiveTraits;
+ bool allowsExtensionTraits;
+ bool allowsScore;
+ };
+
+ using SName = parser::OmpTraitSetSelectorName::Value;
+ using TName = parser::OmpTraitSelectorName::Value;
+
+ static const std::map<SName, TraitSetConfig> configs{
+ {SName::Construct, //
+ {{TName::Simd}, true, false, false}},
+ {SName::Device, //
+ {{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
+ {SName::Implementation, //
+ {{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
+ TName::Vendor},
+ false, true, true}},
+ {SName::Target_Device, //
+ {{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
+ TName::Uid},
+ false, true, false}},
+ {SName::User, //
+ {{TName::Condition}, false, false, true}},
+ };
+
+ auto checkTraitSet{[&](const TraitSetConfig &config) {
+ auto &[setName, traits]{traitSet.t};
+ auto usn{parser::ToUpperCaseLetters(setName.ToString())};
+
+ // Check if there are any duplicate traits.
+ CheckTraitSelectorList(traits);
+
+ for (const parser::OmpTraitSelector &trait : traits) {
+ // Don't use structured bindings here, because they cannot be captured
+ // before C++20.
+ auto &traitName = std::get<parser::OmpTraitSelectorName>(trait.t);
+ auto &maybeProps =
+ std::get<std::optional<parser::OmpTraitSelector::Properties>>(
+ trait.t);
+
+ // Check allowed traits
+ common::visit( //
+ common::visitors{
+ [&](parser::OmpTraitSelectorName::Value v) {
+ if (!config.allowed.count(v)) {
+ context_.Say(traitName.source,
+ "%s is not a valid trait for %s trait set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()), usn);
+ }
+ },
+ [&](llvm::omp::Directive) {
+ if (!config.allowsDirectiveTraits) {
+ context_.Say(traitName.source,
+ "Directive name is not a valid trait for %s trait set"_err_en_US,
+ usn);
+ }
+ },
+ [&](const std::string &) {
+ if (!config.allowsExtensionTraits) {
+ context_.Say(traitName.source,
+ "Extension traits are not valid for %s trait set"_err_en_US,
+ usn);
+ }
+ },
+ },
+ traitName.u);
+
+ // Check score
+ if (maybeProps) {
+ auto &[maybeScore, _]{maybeProps->t};
+ if (maybeScore) {
+ CheckTraitScore(*maybeScore);
+ }
+ }
+
+ // Check the properties of the individual traits
+ CheckTraitSelector(traitSet, trait);
+ }
+ }};
+
+ checkTraitSet(
+ configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
+}
+
+void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
+ // [6.0:322:23]
+ // A score-expression must be a non-negative constant integer expression.
+ if (auto value{GetIntValue(score)}; !value || value < 0) {
+ context_.Say(score.source,
+ "SCORE expression must be a non-negative constant integer expression"_err_en_US);
+ }
+}
+
+bool OmpStructureChecker::VerifyTraitPropertyLists(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ using TraitName = parser::OmpTraitSelectorName;
+ using PropertyList = std::list<parser::OmpTraitProperty>;
+ auto &[traitName, maybeProps]{trait.t};
+
+ auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
+ const std::string &message) {
+ bool foundInvalid{false};
+ for (const parser::OmpTraitProperty &prop : properties) {
+ if (!isValid(prop)) {
+ if (foundInvalid) {
+ context_.Say(
+ prop.source, "More invalid properties are present"_err_en_US);
+ break;
+ }
+ context_.Say(prop.source, "%s"_err_en_US, message);
+ foundInvalid = true;
+ }
+ }
+ return !foundInvalid;
+ }};
+
+ bool invalid{false};
+
+ if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
+ // Directive-name traits don't have properties.
+ if (maybeProps) {
+ context_.Say(trait.source,
+ "Directive-name traits cannot have properties"_err_en_US);
+ invalid = true;
+ }
+ }
+ // Ignore properties on extension traits.
+
+ // See `TraitSelectorParser` in openmp-parser.cpp
+ if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
+ switch (*v) {
+ // name-list properties
+ case parser::OmpTraitSelectorName::Value::Arch:
+ case parser::OmpTraitSelectorName::Value::Extension:
+ case parser::OmpTraitSelectorName::Value::Isa:
+ case parser::OmpTraitSelectorName::Value::Kind:
+ case parser::OmpTraitSelectorName::Value::Uid:
+ case parser::OmpTraitSelectorName::Value::Vendor:
+ if (maybeProps) {
+ auto isName{[](const parser::OmpTraitProperty &prop) {
+ return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isName, "Trait property should be a name");
+ }
+ break;
+ // clause-list
+ case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
+ case parser::OmpTraitSelectorName::Value::Requires:
+ case parser::OmpTraitSelectorName::Value::Simd:
+ if (maybeProps) {
+ auto isClause{[&](const parser::OmpTraitProperty &prop) {
+ return GetClauseFromProperty(prop).has_value();
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isClause, "Trait property should be a clause");
+ }
+ break;
+ // expr-list
+ case parser::OmpTraitSelectorName::Value::Condition:
+ case parser::OmpTraitSelectorName::Value::Device_Num:
+ if (maybeProps) {
+ auto isExpr{[](const parser::OmpTraitProperty &prop) {
+ return std::holds_alternative<parser::ScalarExpr>(prop.u);
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isExpr, "Trait property should be a scalar expression");
+ }
+ break;
+ } // switch
+ }
+
+ return !invalid;
+}
+
+void OmpStructureChecker::CheckTraitSelector(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ using TraitName = parser::OmpTraitSelectorName;
+ auto &[traitName, maybeProps]{trait.t};
+
+ // Only do the detailed checks if the property lists are valid.
+ if (VerifyTraitPropertyLists(traitSet, trait)) {
+ if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
+ std::holds_alternative<std::string>(traitName.u)) {
+ // No properties here: directives don't have properties, and
+ // we don't implement any extension traits now.
+ return;
+ }
+
+ // Specific traits we want to check.
+ // Limitations:
+ // (1) The properties for these traits are defined in "Additional
+ // Definitions for the OpenMP API Specification". It's not clear how
+ // to define them in a portable way, and how to verify their validity,
+ // especially if they get replaced by their integer values (in case
+ // they are defined as enums).
+ // (2) These are entirely implementation-defined, and at the moment
+ // there is no known schema to validate these values.
+ auto v{std::get<TraitName::Value>(traitName.u)};
+ switch (v) {
+ case TraitName::Value::Arch:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Atomic_Default_Mem_Order:
+ CheckTraitADMO(traitSet, trait);
+ break;
+ case TraitName::Value::Condition:
+ CheckTraitCondition(traitSet, trait);
+ break;
+ case TraitName::Value::Device_Num:
+ CheckTraitDeviceNum(traitSet, trait);
+ break;
+ case TraitName::Value::Extension:
+ // Ignore
+ break;
+ case TraitName::Value::Isa:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Kind:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Requires:
+ CheckTraitRequires(traitSet, trait);
+ break;
+ case TraitName::Value::Simd:
+ CheckTraitSimd(traitSet, trait);
+ break;
+ case TraitName::Value::Uid:
+ // Unchecked, TBD(2)
+ break;
+ case TraitName::Value::Vendor:
+ // Unchecked, TBD(1)
+ break;
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitADMO(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single clause property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ } else {
+ const parser::OmpTraitProperty &property{properties.front()};
+ auto clauseId{*GetClauseFromProperty(property)};
+ // Check that the clause belongs to the memory-order clause-set.
+ // Clause sets will hopefully be autogenerated at some point.
+ switch (clauseId) {
+ case llvm::omp::Clause::OMPC_acq_rel:
+ case llvm::omp::Clause::OMPC_acquire:
+ case llvm::omp::Clause::OMPC_relaxed:
+ case llvm::omp::Clause::OMPC_release:
+ case llvm::omp::Clause::OMPC_seq_cst:
+ break;
+ default:
+ context_.Say(property.source,
+ "%s trait requires a clause from the memory-order clause set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitCondition(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single expression property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ } else {
+ const parser::OmpTraitProperty &property{properties.front()};
+ auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
+
+ auto maybeType{GetDynamicType(scalarExpr.thing.value())};
+ if (!maybeType || maybeType->category() != TypeCategory::Logical) {
+ context_.Say(property.source,
+ "%s trait requires a single LOGICAL expression"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitDeviceNum(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single expression property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+ // No other checks at the moment.
+}
+
+void OmpStructureChecker::CheckTraitRequires(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ for (const parser::OmpTraitProperty &property : properties) {
+ auto clauseId{*GetClauseFromProperty(property)};
+ if (!llvm::omp::isAllowedClauseForDirective(
+ llvm::omp::OMPD_requires, clauseId, version)) {
+ context_.Say(property.source,
+ "%s trait requires a clause from the requirement clause set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitSimd(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ for (const parser::OmpTraitProperty &property : properties) {
+ auto clauseId{*GetClauseFromProperty(property)};
+ if (!llvm::omp::isAllowedClauseForDirective(
+ llvm::omp::OMPD_declare_simd, clauseId, version)) {
+ context_.Say(property.source,
+ "%s trait requires a clause that is allowed on the %s directive"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()),
+ parser::ToUpperCaseLetters(
+ getDirectiveName(llvm::omp::OMPD_declare_simd)));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
+void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
+ EnterDirectiveNest(MetadirectiveNest);
+ PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
+}
+
+void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
+ ExitDirectiveNest(MetadirectiveNest);
+ dirContext_.pop_back();
+}
+
+} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index e080bce3cac3a..30eff01256c61 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -7,27 +7,56 @@
//===----------------------------------------------------------------------===//
#include "check-omp-structure.h"
+
+#include "check-directive-structure.h"
#include "definable.h"
+#include "openmp-utils.h"
#include "resolve-names-utils.h"
-#include "flang/Evaluate/check-expression.h"
-#include "flang/Evaluate/expression.h"
+
+#include "flang/Common/idioms.h"
+#include "flang/Common/indirection.h"
+#include "flang/Common/visit.h"
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/characters.h"
+#include "flang/Parser/message.h"
+#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include "flang/Semantics/expression.h"
+#include "flang/Semantics/openmp-directive-sets.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/scope.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
+#include "flang/Semantics/type.h"
+#include "flang/Support/Fortran-features.h"
+
+#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/STLExtras.h"
-#include "llvm/ADT/StringSwitch.h"
+#include "llvm/ADT/StringRef.h"
+#include "llvm/Frontend/OpenMP/OMP.h"
+
+#include <algorithm>
+#include <cassert>
+#include <cstdint>
+#include <iterator>
+#include <list>
+#include <map>
+#include <optional>
+#include <set>
+#include <string>
+#include <tuple>
+#include <type_traits>
+#include <utility>
#include <variant>
namespace Fortran::semantics {
-template <typename T, typename U>
-static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
- return !(e == f);
-}
+using namespace Fortran::semantics::omp;
// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
#define CHECK_SIMPLE_CLAUSE(X, Y) \
@@ -53,66 +82,6 @@ static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
CheckAllowedClause(llvm::omp::Y); \
}
-std::string ThisVersion(unsigned version) {
- std::string tv{
- std::to_string(version / 10) + "." + std::to_string(version % 10)};
- return "OpenMP v" + tv;
-}
-
-std::string TryVersion(unsigned version) {
- return "try -fopenmp-version=" + std::to_string(version);
-}
-
-static const parser::Designator *GetDesignatorFromObj(
- const parser::OmpObject &object) {
- return std::get_if<parser::Designator>(&object.u);
-}
-
-static const parser::DataRef *GetDataRefFromObj(
- const parser::OmpObject &object) {
- if (auto *desg{GetDesignatorFromObj(object)}) {
- return std::get_if<parser::DataRef>(&desg->u);
- }
- return nullptr;
-}
-
-static const parser::ArrayElement *GetArrayElementFromObj(
- const parser::OmpObject &object) {
- if (auto *dataRef{GetDataRefFromObj(object)}) {
- using ElementIndirection = common::Indirection<parser::ArrayElement>;
- if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {
- return &ind->value();
- }
- }
- return nullptr;
-}
-
-static bool IsVarOrFunctionRef(const MaybeExpr &expr) {
- if (expr) {
- return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
- evaluate::IsVariable(*expr);
- } else {
- return false;
- }
-}
-
-static std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
- const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
- // ForwardOwningPointer typedExpr
- // `- GenericExprWrapper ^.get()
- // `- std::optional<Expr> ^->v
- return typedExpr.get()->v;
-}
-
-static std::optional<evaluate::DynamicType> GetDynamicType(
- const parser::Expr &parserExpr) {
- if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
- return maybeExpr->GetType();
- } else {
- return std::nullopt;
- }
-}
-
// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
// statements and the expressions enclosed in an OpenMP Workshare construct
class OmpWorkshareBlockChecker {
@@ -172,85 +141,6 @@ class OmpWorkshareBlockChecker {
parser::CharBlock source_;
};
-class AssociatedLoopChecker {
-public:
- AssociatedLoopChecker(SemanticsContext &context, std::int64_t level)
- : context_{context}, level_{level} {}
-
- template <typename T> bool Pre(const T &) { return true; }
- template <typename T> void Post(const T &) {}
-
- bool Pre(const parser::DoConstruct &dc) {
- level_--;
- const auto &doStmt{
- std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
- const auto &constructName{
- std::get<std::optional<parser::Name>>(doStmt.statement.t)};
- if (constructName) {
- constructNamesAndLevels_.emplace(
- constructName.value().ToString(), level_);
- }
- if (level_ >= 0) {
- if (dc.IsDoWhile()) {
- context_.Say(doStmt.source,
- "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
- }
- if (!dc.GetLoopControl()) {
- context_.Say(doStmt.source,
- "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
- }
- }
- return true;
- }
-
- void Post(const parser::DoConstruct &dc) { level_++; }
-
- bool Pre(const parser::CycleStmt &cyclestmt) {
- std::map<std::string, std::int64_t>::iterator it;
- bool err{false};
- if (cyclestmt.v) {
- it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
- err = (it != constructNamesAndLevels_.end() && it->second > 0);
- } else { // If there is no label then use the level of the last enclosing DO
- err = level_ > 0;
- }
- if (err) {
- context_.Say(*source_,
- "CYCLE statement to non-innermost associated loop of an OpenMP DO "
- "construct"_err_en_US);
- }
- return true;
- }
-
- bool Pre(const parser::ExitStmt &exitStmt) {
- std::map<std::string, std::int64_t>::iterator it;
- bool err{false};
- if (exitStmt.v) {
- it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
- err = (it != constructNamesAndLevels_.end() && it->second >= 0);
- } else { // If there is no label then use the level of the last enclosing DO
- err = level_ >= 0;
- }
- if (err) {
- context_.Say(*source_,
- "EXIT statement terminates associated loop of an OpenMP DO "
- "construct"_err_en_US);
- }
- return true;
- }
-
- bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
- source_ = &actionstmt.source;
- return true;
- }
-
-private:
- SemanticsContext &context_;
- const parser::CharBlock *source_;
- std::int64_t level_;
- std::map<std::string, std::int64_t> constructNamesAndLevels_;
-};
-
// `OmpUnitedTaskDesignatorChecker` is used to check if the designator
// can appear within the TASK construct
class OmpUnitedTaskDesignatorChecker {
@@ -318,18 +208,6 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
return CheckAllowed(clause);
}
-bool OmpStructureChecker::IsCommonBlock(const Symbol &sym) {
- return sym.detailsIf<CommonBlockDetails>() != nullptr;
-}
-
-bool OmpStructureChecker::IsVariableListItem(const Symbol &sym) {
- return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
-}
-
-bool OmpStructureChecker::IsExtendedListItem(const Symbol &sym) {
- return IsVariableListItem(sym) || sym.IsSubprogram();
-}
-
bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
// Definition of close nesting:
//
@@ -371,60 +249,6 @@ bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
return false;
}
-namespace {
-struct ContiguousHelper {
- ContiguousHelper(SemanticsContext &context)
- : fctx_(context.foldingContext()) {}
-
- template <typename Contained>
- std::optional<bool> Visit(const common::Indirection<Contained> &x) {
- return Visit(x.value());
- }
- template <typename Contained>
- std::optional<bool> Visit(const common::Reference<Contained> &x) {
- return Visit(x.get());
- }
- template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
- return common::visit([&](auto &&s) { return Visit(s); }, x.u);
- }
- template <typename T>
- std::optional<bool> Visit(const evaluate::Designator<T> &x) {
- return common::visit(
- [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
- }
- template <typename T> std::optional<bool> Visit(const T &) {
- // Everything else.
- return std::nullopt;
- }
-
-private:
- evaluate::FoldingContext &fctx_;
-};
-} // namespace
-
-// Return values:
-// - std::optional<bool>{true} if the object is known to be contiguous
-// - std::optional<bool>{false} if the object is known not to be contiguous
-// - std::nullopt if the object contiguity cannot be determined
-std::optional<bool> OmpStructureChecker::IsContiguous(
- const parser::OmpObject &object) {
- return common::visit( //
- common::visitors{
- [&](const parser::Name &x) {
- // Any member of a common block must be contiguous.
- return std::optional<bool>{true};
- },
- [&](const parser::Designator &x) {
- evaluate::ExpressionAnalyzer ea{context_};
- if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
- return ContiguousHelper{context_}.Visit(*maybeExpr);
- }
- return std::optional<bool>{};
- },
- },
- object.u);
-}
-
void OmpStructureChecker::CheckVariableListItem(
const SymbolSourceMap &symbols) {
for (auto &[symbol, source] : symbols) {
@@ -522,62 +346,6 @@ bool OmpStructureChecker::HasInvalidWorksharingNesting(
return false;
}
-void OmpStructureChecker::HasInvalidDistributeNesting(
- const parser::OpenMPLoopConstruct &x) {
- bool violation{false};
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
- if (llvm::omp::topDistributeSet.test(beginDir.v)) {
- // `distribute` region has to be nested
- if (!CurrentDirectiveIsNested()) {
- violation = true;
- } else {
- // `distribute` region has to be strictly nested inside `teams`
- if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
- violation = true;
- }
- }
- }
- if (violation) {
- context_.Say(beginDir.source,
- "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
- "region."_err_en_US);
- }
-}
-void OmpStructureChecker::HasInvalidLoopBinding(
- const parser::OpenMPLoopConstruct &x) {
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
-
- auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
- const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
- for (const auto &clause : clauseList.v) {
- if (const auto *bindClause{
- std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
- if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {
- context_.Say(beginDir.source, msg);
- }
- }
- }
- };
-
- if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
- CurrentDirectiveIsNested() &&
- llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
- teamsBindingChecker(
- "`BIND(TEAMS)` must be specified since the `LOOP` region is "
- "strictly nested inside a `TEAMS` region."_err_en_US);
- }
-
- if (OmpDirectiveSet{
- llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
- .test(beginDir.v)) {
- teamsBindingChecker(
- "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
- "combined with a `TEAMS` construct."_err_en_US);
- }
-}
-
void OmpStructureChecker::HasInvalidTeamsNesting(
const llvm::omp::Directive &dir, const parser::CharBlock &source) {
if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
@@ -668,16 +436,6 @@ void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
}
}
-void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
- EnterDirectiveNest(MetadirectiveNest);
- PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
-}
-
-void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
- ExitDirectiveNest(MetadirectiveNest);
- dirContext_.pop_back();
-}
-
void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
// Simd Construct with Ordered Construct Nesting check
// We cannot use CurrentDirectiveIsNested() here because
@@ -717,91 +475,6 @@ void OmpStructureChecker::AddEndDirectiveClauses(
}
}
-void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
- loopStack_.push_back(&x);
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
-
- PushContextAndClauseSets(beginDir.source, beginDir.v);
-
- // check matching, End directive is optional
- if (const auto &endLoopDir{
- std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
- const auto &endDir{
- std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
-
- CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
-
- AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endLoopDir->t));
- }
-
- if (llvm::omp::allSimdSet.test(GetContext().directive)) {
- EnterDirectiveNest(SIMDNest);
- }
-
- // Combined target loop constructs are target device constructs. Keep track of
- // whether any such construct has been visited to later check that REQUIRES
- // directives for target-related options don't appear after them.
- if (llvm::omp::allTargetSet.test(beginDir.v)) {
- deviceConstructFound_ = true;
- }
-
- if (beginDir.v == llvm::omp::Directive::OMPD_do) {
- // 2.7.1 do-clause -> private-clause |
- // firstprivate-clause |
- // lastprivate-clause |
- // linear-clause |
- // reduction-clause |
- // schedule-clause |
- // collapse-clause |
- // ordered-clause
-
- // nesting check
- HasInvalidWorksharingNesting(
- beginDir.source, llvm::omp::nestedWorkshareErrSet);
- }
- SetLoopInfo(x);
-
- auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
- if (optLoopCons.has_value()) {
- if (const auto &doConstruct{
- std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
- const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
- CheckNoBranching(doBlock, beginDir.v, beginDir.source);
- }
- }
- CheckLoopItrVariableIsInt(x);
- CheckAssociatedLoopConstraints(x);
- HasInvalidDistributeNesting(x);
- HasInvalidLoopBinding(x);
- if (CurrentDirectiveIsNested() &&
- llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
- HasInvalidTeamsNesting(beginDir.v, beginDir.source);
- }
- if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
- (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
- CheckDistLinear(x);
- }
-}
-const parser::Name OmpStructureChecker::GetLoopIndex(
- const parser::DoConstruct *x) {
- using Bounds = parser::LoopControl::Bounds;
- return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
-}
-void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
- auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
- if (optLoopCons.has_value()) {
- if (const auto &loopConstruct{
- std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
- const parser::DoConstruct *loop{&*loopConstruct};
- if (loop && loop->IsDoNormal()) {
- const parser::Name &itrVal{GetLoopIndex(loop)};
- SetLoopIv(itrVal.symbol);
- }
- }
- }
-}
-
void OmpStructureChecker::CheckIteratorRange(
const parser::OmpIteratorSpecifier &x) {
// Check:
@@ -861,111 +534,6 @@ void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {
}
}
-void OmpStructureChecker::CheckLoopItrVariableIsInt(
- const parser::OpenMPLoopConstruct &x) {
- auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
- if (optLoopCons.has_value()) {
- if (const auto &loopConstruct{
- std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
-
- for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
- if (loop->IsDoNormal()) {
- const parser::Name &itrVal{GetLoopIndex(loop)};
- if (itrVal.symbol) {
- const auto *type{itrVal.symbol->GetType()};
- if (!type->IsNumeric(TypeCategory::Integer)) {
- context_.Say(itrVal.source,
- "The DO loop iteration"
- " variable must be of the type integer."_err_en_US,
- itrVal.ToString());
- }
- }
- }
- // Get the next DoConstruct if block is not empty.
- const auto &block{std::get<parser::Block>(loop->t)};
- const auto it{block.begin()};
- loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
- : nullptr;
- }
- }
- }
-}
-
-void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
- // Check the following:
- // The only OpenMP constructs that can be encountered during execution of
- // a simd region are the `atomic` construct, the `loop` construct, the `simd`
- // construct and the `ordered` construct with the `simd` clause.
-
- // Check if the parent context has the SIMD clause
- // Please note that we use GetContext() instead of GetContextParent()
- // because PushContextAndClauseSets() has not been called on the
- // current context yet.
- // TODO: Check for declare simd regions.
- bool eligibleSIMD{false};
- common::visit(
- common::visitors{
- // Allow `!$OMP ORDERED SIMD`
- [&](const parser::OpenMPBlockConstruct &c) {
- const auto &beginBlockDir{
- std::get<parser::OmpBeginBlockDirective>(c.t)};
- const auto &beginDir{
- std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
- if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
- const auto &clauses{
- std::get<parser::OmpClauseList>(beginBlockDir.t)};
- for (const auto &clause : clauses.v) {
- if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
- eligibleSIMD = true;
- break;
- }
- }
- }
- },
- [&](const parser::OpenMPStandaloneConstruct &c) {
- if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
- &c.u)}) {
- llvm::omp::Directive dirId{ssc->v.DirId()};
- if (dirId == llvm::omp::Directive::OMPD_ordered) {
- for (const parser::OmpClause &x : ssc->v.Clauses().v) {
- if (x.Id() == llvm::omp::Clause::OMPC_simd) {
- eligibleSIMD = true;
- break;
- }
- }
- } else if (dirId == llvm::omp::Directive::OMPD_scan) {
- eligibleSIMD = true;
- }
- }
- },
- // Allowing SIMD and loop construct
- [&](const parser::OpenMPLoopConstruct &c) {
- const auto &beginLoopDir{
- std::get<parser::OmpBeginLoopDirective>(c.t)};
- const auto &beginDir{
- std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
- if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
- (beginDir.v == llvm::omp::Directive::OMPD_do_simd) ||
- (beginDir.v == llvm::omp::Directive::OMPD_loop)) {
- eligibleSIMD = true;
- }
- },
- [&](const parser::OpenMPAtomicConstruct &c) {
- // Allow `!$OMP ATOMIC`
- eligibleSIMD = true;
- },
- [&](const auto &c) {},
- },
- c.u);
- if (!eligibleSIMD) {
- context_.Say(parser::FindSourceLocation(c),
- "The only OpenMP constructs that can be encountered during execution "
- "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
- "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
- "construct with the `SIMD` clause."_err_en_US);
- }
-}
-
void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
// 2.12.5 Target Construct Restriction
bool eligibleTarget{true};
@@ -1023,190 +591,6 @@ void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
}
}
-std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
- const parser::OpenMPLoopConstruct &x) {
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
- std::int64_t orderedCollapseLevel{1};
- std::int64_t orderedLevel{1};
- std::int64_t collapseLevel{1};
-
- for (const auto &clause : clauseList.v) {
- if (const auto *collapseClause{
- std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
- if (const auto v{GetIntValue(collapseClause->v)}) {
- collapseLevel = *v;
- }
- }
- if (const auto *orderedClause{
- std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
- if (const auto v{GetIntValue(orderedClause->v)}) {
- orderedLevel = *v;
- }
- }
- }
- if (orderedLevel >= collapseLevel) {
- orderedCollapseLevel = orderedLevel;
- } else {
- orderedCollapseLevel = collapseLevel;
- }
- return orderedCollapseLevel;
-}
-
-void OmpStructureChecker::CheckAssociatedLoopConstraints(
- const parser::OpenMPLoopConstruct &x) {
- std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
- AssociatedLoopChecker checker{context_, ordCollapseLevel};
- parser::Walk(x, checker);
-}
-
-void OmpStructureChecker::CheckDistLinear(
- const parser::OpenMPLoopConstruct &x) {
-
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
-
- SymbolSourceMap indexVars;
-
- // Collect symbols of all the variables from linear clauses
- for (auto &clause : clauses.v) {
- if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
- auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};
- GetSymbolsInObjectList(objects, indexVars);
- }
- }
-
- if (!indexVars.empty()) {
- // Get collapse level, if given, to find which loops are "associated."
- std::int64_t collapseVal{GetOrdCollapseLevel(x)};
- // Include the top loop if no collapse is specified
- if (collapseVal == 0) {
- collapseVal = 1;
- }
-
- // Match the loop index variables with the collected symbols from linear
- // clauses.
- auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
- if (optLoopCons.has_value()) {
- if (const auto &loopConstruct{
- std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
- for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
- if (loop->IsDoNormal()) {
- const parser::Name &itrVal{GetLoopIndex(loop)};
- if (itrVal.symbol) {
- // Remove the symbol from the collected set
- indexVars.erase(&itrVal.symbol->GetUltimate());
- }
- collapseVal--;
- if (collapseVal == 0) {
- break;
- }
- }
- // Get the next DoConstruct if block is not empty.
- const auto &block{std::get<parser::Block>(loop->t)};
- const auto it{block.begin()};
- loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
- : nullptr;
- }
- }
- }
-
- // Show error for the remaining variables
- for (auto &[symbol, source] : indexVars) {
- const Symbol &root{GetAssociationRoot(*symbol)};
- context_.Say(source,
- "Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,
- root.name());
- }
- }
-}
-
-void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
- const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
- const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
-
- // A few semantic checks for InScan reduction are performed below as SCAN
- // constructs inside LOOP may add the relevant information. Scan reduction is
- // supported only in loop constructs, so same checks are not applicable to
- // other directives.
- using ReductionModifier = parser::OmpReductionModifier;
- for (const auto &clause : clauseList.v) {
- if (const auto *reductionClause{
- std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
- auto &modifiers{OmpGetModifiers(reductionClause->v)};
- auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};
- if (maybeModifier &&
- maybeModifier->v == ReductionModifier::Value::Inscan) {
- const auto &objectList{
- std::get<parser::OmpObjectList>(reductionClause->v.t)};
- auto checkReductionSymbolInScan = [&](const parser::Name *name) {
- if (auto &symbol = name->symbol) {
- if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
- !symbol->test(Symbol::Flag::OmpExclusiveScan)) {
- context_.Say(name->source,
- "List item %s must appear in EXCLUSIVE or "
- "INCLUSIVE clause of an "
- "enclosed SCAN directive"_err_en_US,
- name->ToString());
- }
- }
- };
- for (const auto &ompObj : objectList.v) {
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{semantics::getDesignatorNameIfDataRef(
- designator)}) {
- checkReductionSymbolInScan(name);
- }
- },
- [&](const auto &name) { checkReductionSymbolInScan(&name); },
- },
- ompObj.u);
- }
- }
- }
- }
- if (llvm::omp::allSimdSet.test(GetContext().directive)) {
- ExitDirectiveNest(SIMDNest);
- }
- dirContext_.pop_back();
-
- assert(!loopStack_.empty() && "Expecting non-empty loop stack");
-#ifndef NDEBUG
- const LoopConstruct &top{loopStack_.back()};
- auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
- assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
-#endif
- loopStack_.pop_back();
-}
-
-void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
- const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
- ResetPartialContext(dir.source);
- switch (dir.v) {
- // 2.7.1 end-do -> END DO [nowait-clause]
- // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
- case llvm::omp::Directive::OMPD_do:
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
- break;
- case llvm::omp::Directive::OMPD_do_simd:
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_end_do_simd);
- break;
- default:
- // no clauses are allowed
- break;
- }
-}
-
-void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
- if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
- (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
- dirContext_.pop_back();
- }
-}
-
void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
@@ -2671,1488 +2055,46 @@ void OmpStructureChecker::CheckCancellationNest(
parser::ToUpperCaseLetters(typeName.str()));
break;
default:
- // This is diagnosed later.
- return;
- }
- }
-}
-
-void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
- const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
- ResetPartialContext(dir.source);
- switch (dir.v) {
- case llvm::omp::Directive::OMPD_scope:
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
- break;
- // 2.7.3 end-single-clause -> copyprivate-clause |
- // nowait-clause
- case llvm::omp::Directive::OMPD_single:
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
- break;
- // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
- case llvm::omp::Directive::OMPD_workshare:
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_end_workshare);
- break;
- default:
- // no clauses are allowed
- break;
- }
-}
-
-// TODO: Verify the popping of dirContext requirement after nowait
-// implementation, as there is an implicit barrier at the end of the worksharing
-// constructs unless a nowait clause is specified. Only OMPD_end_single and
-// end_workshareare popped as they are pushed while entering the
-// EndBlockDirective.
-void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
- if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
- (GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
- (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
- dirContext_.pop_back();
- }
-}
-
-/// parser::Block is a list of executable constructs, parser::BlockConstruct
-/// is Fortran's BLOCK/ENDBLOCK construct.
-/// Strip the outermost BlockConstructs, return the reference to the Block
-/// in the executable part of the innermost of the stripped constructs.
-/// Specifically, if the given `block` has a single entry (it's a list), and
-/// the entry is a BlockConstruct, get the Block contained within. Repeat
-/// this step as many times as possible.
-static const parser::Block &GetInnermostExecPart(const parser::Block &block) {
- const parser::Block *iter{&block};
- while (iter->size() == 1) {
- const parser::ExecutionPartConstruct &ep{iter->front()};
- if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
- using BlockConstruct = common::Indirection<parser::BlockConstruct>;
- if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
- iter = &std::get<parser::Block>(bc->value().t);
- continue;
- }
- }
- break;
- }
- return *iter;
-}
-
-// There is no consistent way to get the source of a given ActionStmt, so
-// extract the source information from Statement<ActionStmt> when we can,
-// and keep it around for error reporting in further analyses.
-struct SourcedActionStmt {
- const parser::ActionStmt *stmt{nullptr};
- parser::CharBlock source;
-
- operator bool() const { return stmt != nullptr; }
-};
-
-struct AnalyzedCondStmt {
- SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted
- parser::CharBlock source;
- SourcedActionStmt ift, iff;
-};
-
-static SourcedActionStmt GetActionStmt(
- const parser::ExecutionPartConstruct *x) {
- if (x == nullptr) {
- return SourcedActionStmt{};
- }
- if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
- using ActionStmt = parser::Statement<parser::ActionStmt>;
- if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
- return SourcedActionStmt{&stmt->statement, stmt->source};
- }
- }
- return SourcedActionStmt{};
-}
-
-static SourcedActionStmt GetActionStmt(const parser::Block &block) {
- if (block.size() == 1) {
- return GetActionStmt(&block.front());
- }
- return SourcedActionStmt{};
-}
-
-// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption
-// is that the ActionStmt will be either an assignment or a pointer-assignment,
-// otherwise return std::nullopt.
-// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where
-// the "typedAssignment" is unset. This can happen if there are semantic errors
-// in the purported assignment.
-static std::optional<evaluate::Assignment> GetEvaluateAssignment(
- const parser::ActionStmt *x) {
- if (x == nullptr) {
- return std::nullopt;
- }
-
- using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
- using PointerAssignmentStmt =
- common::Indirection<parser::PointerAssignmentStmt>;
- using TypedAssignment = parser::AssignmentStmt::TypedAssignment;
-
- return common::visit(
- [](auto &&s) -> std::optional<evaluate::Assignment> {
- using BareS = llvm::remove_cvref_t<decltype(s)>;
- if constexpr (std::is_same_v<BareS, AssignmentStmt> ||
- std::is_same_v<BareS, PointerAssignmentStmt>) {
- const TypedAssignment &typed{s.value().typedAssignment};
- // ForwardOwningPointer typedAssignment
- // `- GenericAssignmentWrapper ^.get()
- // `- std::optional<Assignment> ^->v
- return typed.get()->v;
- } else {
- return std::nullopt;
- }
- },
- x->u);
-}
-
-// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
-// to separate cases where the source has something that looks like an
-// assignment, but is semantically wrong (diagnosed by general semantic
-// checks), and where the source has some other statement (which we want
-// to report as "should be an assignment").
-static bool IsAssignment(const parser::ActionStmt *x) {
- if (x == nullptr) {
- return false;
- }
-
- using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
- using PointerAssignmentStmt =
- common::Indirection<parser::PointerAssignmentStmt>;
-
- return common::visit(
- [](auto &&s) -> bool {
- using BareS = llvm::remove_cvref_t<decltype(s)>;
- return std::is_same_v<BareS, AssignmentStmt> ||
- std::is_same_v<BareS, PointerAssignmentStmt>;
- },
- x->u);
-}
-
-static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(
- const parser::ExecutionPartConstruct *x) {
- if (x == nullptr) {
- return std::nullopt;
- }
-
- // Extract the evaluate::Expr from ScalarLogicalExpr.
- auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {
- // ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>
- const parser::Expr &expr{logical.thing.thing.value()};
- return GetEvaluateExpr(expr);
- }};
-
- // Recognize either
- // ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or
- // ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.
-
- if (auto &&action{GetActionStmt(x)}) {
- if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(
- &action.stmt->u)}) {
- const parser::IfStmt &s{ifs->value()};
- auto &&maybeCond{
- getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};
- auto &thenStmt{
- std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};
- if (maybeCond) {
- return AnalyzedCondStmt{std::move(*maybeCond), action.source,
- SourcedActionStmt{&thenStmt.statement, thenStmt.source},
- SourcedActionStmt{}};
- }
- }
- return std::nullopt;
- }
-
- if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
- if (auto *ifc{
- std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {
- using ElseBlock = parser::IfConstruct::ElseBlock;
- using ElseIfBlock = parser::IfConstruct::ElseIfBlock;
- const parser::IfConstruct &s{ifc->value()};
-
- if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {
- // Not expecting any else-if statements.
- return std::nullopt;
- }
- auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};
- auto &&maybeCond{getFromLogical(
- std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};
- if (!maybeCond) {
- return std::nullopt;
- }
-
- if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {
- AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
- GetActionStmt(std::get<parser::Block>(s.t)),
- GetActionStmt(std::get<parser::Block>(maybeElse->t))};
- if (result.ift.stmt && result.iff.stmt) {
- return result;
- }
- } else {
- AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
- GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};
- if (result.ift.stmt) {
- return result;
- }
- }
- }
- return std::nullopt;
- }
-
- return std::nullopt;
-}
-
-static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
- parser::CharBlock source) {
- // Find => in the range, if not found, find = that is not a part of
- // <=, >=, ==, or /=.
- auto trim{[](std::string_view v) {
- const char *begin{v.data()};
- const char *end{begin + v.size()};
- while (*begin == ' ' && begin != end) {
- ++begin;
- }
- while (begin != end && end[-1] == ' ') {
- --end;
- }
- assert(begin != end && "Source should not be empty");
- return parser::CharBlock(begin, end - begin);
- }};
-
- std::string_view sv(source.begin(), source.size());
-
- if (auto where{sv.find("=>")}; where != sv.npos) {
- std::string_view lhs(sv.data(), where);
- std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);
- return std::make_pair(trim(lhs), trim(rhs));
- }
-
- // Go backwards, since all the exclusions above end with a '='.
- for (size_t next{source.size()}; next > 1; --next) {
- if (sv[next - 1] == '=' && !llvm::is_contained("<>=/", sv[next - 2])) {
- std::string_view lhs(sv.data(), next - 1);
- std::string_view rhs(sv.data() + next, sv.size() - next);
- return std::make_pair(trim(lhs), trim(rhs));
- }
- }
- llvm_unreachable("Could not find assignment operator");
-}
-
-namespace atomic {
-
-struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
- std::vector<SomeExpr>, false> {
- using Result = std::vector<SomeExpr>;
- using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
- DesignatorCollector() : Base(*this) {}
-
- Result Default() const { return {}; }
-
- using Base::operator();
-
- template <typename T> //
- Result operator()(const evaluate::Designator<T> &x) const {
- // Once in a designator, don't traverse it any further (i.e. only
- // collect top-level designators).
- auto copy{x};
- return Result{AsGenericExpr(std::move(copy))};
- }
-
- template <typename... Rs> //
- Result Combine(Result &&result, Rs &&...results) const {
- Result v(std::move(result));
- auto moveAppend{[](auto &accum, auto &&other) {
- for (auto &&s : other) {
- accum.push_back(std::move(s));
- }
- }};
- (moveAppend(v, std::move(results)), ...);
- return v;
- }
-};
-
-struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
- using Base = evaluate::AnyTraverse<VariableFinder>;
- VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
-
- using Base::operator();
-
- template <typename T>
- bool operator()(const evaluate::Designator<T> &x) const {
- auto copy{x};
- return evaluate::AsGenericExpr(std::move(copy)) == var;
- }
-
- template <typename T>
- bool operator()(const evaluate::FunctionRef<T> &x) const {
- auto copy{x};
- return evaluate::AsGenericExpr(std::move(copy)) == var;
- }
-
-private:
- const SomeExpr &var;
-};
-} // namespace atomic
-
-static bool IsPointerAssignment(const evaluate::Assignment &x) {
- return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
- std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
-}
-
-namespace operation = Fortran::evaluate::operation;
-
-static bool IsCheckForAssociated(const SomeExpr &cond) {
- return GetTopLevelOperation(cond).first == operation::Operator::Associated;
-}
-
-static bool HasCommonDesignatorSymbols(
- const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
- // Compare the designators used in "other" with the designators whose
- // symbols are given in baseSyms.
- // This is a part of the check if these two expressions can access the same
- // storage: if the designators used in them are
diff erent enough, then they
- // will be assumed not to access the same memory.
- //
- // Consider an (array element) expression x%y(w%z), the corresponding symbol
- // vector will be {x, y, w, z} (i.e. the symbols for these names).
- // Check whether this exact sequence appears anywhere in any the symbol
- // vector for "other". This will be true for x(y) and x(y+1), so this is
- // not a sufficient condition, but can be used to eliminate candidates
- // before doing more exhaustive checks.
- //
- // If any of the symbols in this sequence are function names, assume that
- // there is no storage overlap, mostly because it would be impossible in
- // general to determine what storage the function will access.
- // Note: if f is pure, then two calls to f will access the same storage
- // when called with the same arguments. This check is not done yet.
-
- if (llvm::any_of(
- baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
- // If there is a function symbol in the chain then we can't infer much
- // about the accessed storage.
- return false;
- }
-
- auto isSubsequence{// Is u a subsequence of v.
- [](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
- size_t us{u.size()}, vs{v.size()};
- if (us > vs) {
- return false;
- }
- for (size_t off{0}; off != vs - us + 1; ++off) {
- bool same{true};
- for (size_t i{0}; i != us; ++i) {
- if (u[i] != v[off + i]) {
- same = false;
- break;
- }
- }
- if (same) {
- return true;
- }
- }
- return false;
- }};
-
- evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
- return isSubsequence(baseSyms, otherSyms);
-}
-
-static bool HasCommonTopLevelDesignators(
- const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
- // Compare designators directly as expressions. This will ensure
- // that x(y) and x(y+1) are not flagged as overlapping, whereas
- // the symbol vectors for both of these would be identical.
- std::vector<SomeExpr> otherDsgs{atomic::DesignatorCollector{}(other)};
-
- for (auto &s : baseDsgs) {
- if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
- return true;
- }
- }
- return false;
-}
-
-static const SomeExpr *HasStorageOverlap(
- const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
- evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
- std::vector<SomeExpr> baseDsgs{atomic::DesignatorCollector{}(base)};
-
- for (const SomeExpr &expr : exprs) {
- if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
- continue;
- }
- if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
- return &expr;
- }
- }
- return nullptr;
-}
-
-static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
- // This ignores function calls, so it will accept "f(x) = f(x) + 1"
- // for example.
- return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;
-}
-
-static bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
- return atomic::VariableFinder{sub}(super);
-}
-
-static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {
- if (value) {
- expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),
- evaluate::GenericExprWrapper::Deleter);
- }
-}
-
-static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,
- std::optional<evaluate::Assignment> value) {
- if (value) {
- assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),
- evaluate::GenericAssignmentWrapper::Deleter);
- }
-}
-
-static parser::OpenMPAtomicConstruct::Analysis::Op MakeAtomicAnalysisOp(
- int what,
- const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {
- parser::OpenMPAtomicConstruct::Analysis::Op operation;
- operation.what = what;
- SetAssignment(operation.assign, maybeAssign);
- return operation;
-}
-
-static parser::OpenMPAtomicConstruct::Analysis MakeAtomicAnalysis(
- const SomeExpr &atom, const MaybeExpr &cond,
- parser::OpenMPAtomicConstruct::Analysis::Op &&op0,
- parser::OpenMPAtomicConstruct::Analysis::Op &&op1) {
- // Defined in flang/include/flang/Parser/parse-tree.h
- //
- // struct Analysis {
- // struct Kind {
- // static constexpr int None = 0;
- // static constexpr int Read = 1;
- // static constexpr int Write = 2;
- // static constexpr int Update = Read | Write;
- // static constexpr int Action = 3; // Bits containing N, R, W, U
- // static constexpr int IfTrue = 4;
- // static constexpr int IfFalse = 8;
- // static constexpr int Condition = 12; // Bits containing IfTrue, IfFalse
- // };
- // struct Op {
- // int what;
- // TypedAssignment assign;
- // };
- // TypedExpr atom, cond;
- // Op op0, op1;
- // };
-
- parser::OpenMPAtomicConstruct::Analysis an;
- SetExpr(an.atom, atom);
- SetExpr(an.cond, cond);
- an.op0 = std::move(op0);
- an.op1 = std::move(op1);
- return an;
-}
-
-void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
- llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
- parser::CharBlock source) {
- if (auto *expr{HasStorageOverlap(base, exprs)}) {
- context_.Say(source,
- "Within atomic operation %s and %s access the same storage"_warn_en_US,
- base.AsFortran(), expr->AsFortran());
- }
-}
-
-void OmpStructureChecker::ErrorShouldBeVariable(
- const MaybeExpr &expr, parser::CharBlock source) {
- if (expr) {
- context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,
- expr->AsFortran());
- } else {
- context_.Say(source, "Atomic expression should be a variable"_err_en_US);
- }
-}
-
-/// Check if `expr` satisfies the following conditions for x and v:
-///
-/// [6.0:189:10-12]
-/// - x and v (as applicable) are either scalar variables or
-/// function references with scalar data pointer result of non-character
-/// intrinsic type or variables that are non-polymorphic scalar pointers
-/// and any length type parameter must be constant.
-void OmpStructureChecker::CheckAtomicType(
- SymbolRef sym, parser::CharBlock source, std::string_view name) {
- const DeclTypeSpec *typeSpec{sym->GetType()};
- if (!typeSpec) {
- return;
- }
-
- if (!IsPointer(sym)) {
- using Category = DeclTypeSpec::Category;
- Category cat{typeSpec->category()};
- if (cat == Category::Character) {
- context_.Say(source,
- "Atomic variable %s cannot have CHARACTER type"_err_en_US, name);
- } else if (cat != Category::Numeric && cat != Category::Logical) {
- context_.Say(source,
- "Atomic variable %s should have an intrinsic type"_err_en_US, name);
- }
- return;
- }
-
- // Variable is a pointer.
- if (typeSpec->IsPolymorphic()) {
- context_.Say(source,
- "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
- name);
- return;
- }
-
- // Go over all length parameters, if any, and check if they are
- // explicit.
- if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
- if (llvm::any_of(derived->parameters(), [](auto &&entry) {
- // "entry" is a map entry
- return entry.second.isLen() && !entry.second.isExplicit();
- })) {
- context_.Say(source,
- "Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,
- name);
- }
- }
-}
-
-void OmpStructureChecker::CheckAtomicVariable(
- const SomeExpr &atom, parser::CharBlock source) {
- if (atom.Rank() != 0) {
- context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
- atom.AsFortran());
- }
-
- std::vector<SomeExpr> dsgs{atomic::DesignatorCollector{}(atom)};
- assert(dsgs.size() == 1 && "Should have a single top-level designator");
- evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
-
- CheckAtomicType(syms.back(), source, atom.AsFortran());
-
- if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
- context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
- atom.AsFortran());
- }
-}
-
-std::pair<const parser::ExecutionPartConstruct *,
- const parser::ExecutionPartConstruct *>
-OmpStructureChecker::CheckUpdateCapture(
- const parser::ExecutionPartConstruct *ec1,
- const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {
- // Decide which statement is the atomic update and which is the capture.
- //
- // The two allowed cases are:
- // x = ... atomic-var = ...
- // ... = x capture-var = atomic-var (with optional converts)
- // or
- // ... = x capture-var = atomic-var (with optional converts)
- // x = ... atomic-var = ...
- //
- // The case of 'a = b; b = a' is ambiguous, so pick the first one as capture
- // (which makes more sense, as it captures the original value of the atomic
- // variable).
- //
- // If the two statements don't fit these criteria, return a pair of default-
- // constructed values.
- using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,
- const parser::ExecutionPartConstruct *>;
-
- SourcedActionStmt act1{GetActionStmt(ec1)};
- SourcedActionStmt act2{GetActionStmt(ec2)};
- auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};
- auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};
- if (!maybeAssign1 || !maybeAssign2) {
- if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {
- context_.Say(source,
- "ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);
- }
- return std::make_pair(nullptr, nullptr);
- }
-
- auto as1{*maybeAssign1}, as2{*maybeAssign2};
-
- auto isUpdateCapture{
- [](const evaluate::Assignment &u, const evaluate::Assignment &c) {
- return IsSameOrConvertOf(c.rhs, u.lhs);
- }};
-
- // Do some checks that narrow down the possible choices for the update
- // and the capture statements. This will help to emit better diagnostics.
- // 1. An assignment could be an update (cbu) if the left-hand side is a
- // subexpression of the right-hand side.
- // 2. An assignment could be a capture (cbc) if the right-hand side is
- // a variable (or a function ref), with potential type conversions.
- bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
- bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
- bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
- bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
-
- // We want to diagnose cases where both assignments cannot be an update,
- // or both cannot be a capture, as well as cases where either assignment
- // cannot be any of these two.
- //
- // If we organize these boolean values into a matrix
- // |cbu1 cbu2|
- // |cbc1 cbc2|
- // then we want to diagnose cases where the matrix has a zero (i.e. "false")
- // row or column, including the case where everything is zero. All these
- // cases correspond to the determinant of the matrix being 0, which suggests
- // that checking the det may be a convenient diagnostic check. There is only
- // one additional case where the det is 0, which is when the matrix is all 1
- // ("true"). The "all true" case represents the situation where both
- // assignments could be an update as well as a capture. On the other hand,
- // whenever det != 0, the roles of the update and the capture can be
- // unambiguously assigned to as1 and as2 [1].
- //
- // [1] This can be easily verified by hand: there are 10 2x2 matrices with
- // det = 0, leaving 6 cases where det != 0:
- // 0 1 0 1 1 0 1 0 1 1 1 1
- // 1 0 1 1 0 1 1 1 0 1 1 0
- // In each case the classification is unambiguous.
-
- // |cbu1 cbu2|
- // det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1
- int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};
-
- auto errorCaptureShouldRead{[&](const parser::CharBlock &source,
- const std::string &expr) {
- context_.Say(source,
- "In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,
- expr);
- }};
-
- auto errorNeitherWorks{[&]() {
- context_.Say(source,
- "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);
- }};
-
- auto makeSelectionFromDet{[&](int det) -> ReturnTy {
- // If det != 0, then the checks unambiguously suggest a specific
- // categorization.
- // If det == 0, then this function should be called only if the
- // checks haven't ruled out any possibility, i.e. when both assigments
- // could still be either updates or captures.
- if (det > 0) {
- // as1 is update, as2 is capture
- if (isUpdateCapture(as1, as2)) {
- return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);
- } else {
- errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());
- return std::make_pair(nullptr, nullptr);
- }
- } else if (det < 0) {
- // as2 is update, as1 is capture
- if (isUpdateCapture(as2, as1)) {
- return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
- } else {
- errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());
- return std::make_pair(nullptr, nullptr);
- }
- } else {
- bool updateFirst{isUpdateCapture(as1, as2)};
- bool captureFirst{isUpdateCapture(as2, as1)};
- if (updateFirst && captureFirst) {
- // If both assignment could be the update and both could be the
- // capture, emit a warning about the ambiguity.
- context_.Say(act1.source,
- "In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);
- return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
- }
- if (updateFirst != captureFirst) {
- const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};
- const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};
- return std::make_pair(upd, cap);
- }
- assert(!updateFirst && !captureFirst);
- errorNeitherWorks();
- return std::make_pair(nullptr, nullptr);
- }
- }};
-
- if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {
- return makeSelectionFromDet(det);
- }
- assert(det == 0 && "Prior checks should have covered det != 0");
-
- // If neither of the statements is an RMW update, it could still be a
- // "write" update. Pretty much any assignment can be a write update, so
- // recompute det with cbu1 = cbu2 = true.
- if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {
- return makeSelectionFromDet(writeDet);
- }
-
- // It's only errors from here on.
-
- if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {
- errorNeitherWorks();
- return std::make_pair(nullptr, nullptr);
- }
-
- // The remaining cases are that
- // - no candidate for update, or for capture,
- // - one of the assigments cannot be anything.
-
- if (!cbu1 && !cbu2) {
- context_.Say(source,
- "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);
- return std::make_pair(nullptr, nullptr);
- } else if (!cbc1 && !cbc2) {
- context_.Say(source,
- "In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);
- return std::make_pair(nullptr, nullptr);
- }
-
- if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {
- auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;
- context_.Say(src,
- "In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);
- return std::make_pair(nullptr, nullptr);
- }
-
- // All cases should have been covered.
- llvm_unreachable("Unchecked condition");
-}
-
-void OmpStructureChecker::CheckAtomicCaptureAssignment(
- const evaluate::Assignment &capture, const SomeExpr &atom,
- parser::CharBlock source) {
- auto [lsrc, rsrc]{SplitAssignmentSource(source)};
- const SomeExpr &cap{capture.lhs};
-
- if (!IsVarOrFunctionRef(atom)) {
- ErrorShouldBeVariable(atom, rsrc);
- } else {
- CheckAtomicVariable(atom, rsrc);
- // This part should have been checked prior to calling this function.
- assert(*GetConvertInput(capture.rhs) == atom &&
- "This cannot be a capture assignment");
- CheckStorageOverlap(atom, {cap}, source);
- }
-}
-
-void OmpStructureChecker::CheckAtomicReadAssignment(
- const evaluate::Assignment &read, parser::CharBlock source) {
- auto [lsrc, rsrc]{SplitAssignmentSource(source)};
-
- if (auto maybe{GetConvertInput(read.rhs)}) {
- const SomeExpr &atom{*maybe};
-
- if (!IsVarOrFunctionRef(atom)) {
- ErrorShouldBeVariable(atom, rsrc);
- } else {
- CheckAtomicVariable(atom, rsrc);
- CheckStorageOverlap(atom, {read.lhs}, source);
- }
- } else {
- ErrorShouldBeVariable(read.rhs, rsrc);
- }
-}
-
-void OmpStructureChecker::CheckAtomicWriteAssignment(
- const evaluate::Assignment &write, parser::CharBlock source) {
- // [6.0:190:13-15]
- // A write structured block is write-statement, a write statement that has
- // one of the following forms:
- // x = expr
- // x => expr
- auto [lsrc, rsrc]{SplitAssignmentSource(source)};
- const SomeExpr &atom{write.lhs};
-
- if (!IsVarOrFunctionRef(atom)) {
- ErrorShouldBeVariable(atom, rsrc);
- } else {
- CheckAtomicVariable(atom, lsrc);
- CheckStorageOverlap(atom, {write.rhs}, source);
- }
-}
-
-void OmpStructureChecker::CheckAtomicUpdateAssignment(
- const evaluate::Assignment &update, parser::CharBlock source) {
- // [6.0:191:1-7]
- // An update structured block is update-statement, an update statement
- // that has one of the following forms:
- // x = x operator expr
- // x = expr operator x
- // x = intrinsic-procedure-name (x)
- // x = intrinsic-procedure-name (x, expr-list)
- // x = intrinsic-procedure-name (expr-list, x)
- auto [lsrc, rsrc]{SplitAssignmentSource(source)};
- const SomeExpr &atom{update.lhs};
-
- if (!IsVarOrFunctionRef(atom)) {
- ErrorShouldBeVariable(atom, rsrc);
- // Skip other checks.
- return;
- }
-
- CheckAtomicVariable(atom, lsrc);
-
- std::pair<operation::Operator, std::vector<SomeExpr>> top{
- operation::Operator::Unknown, {}};
- if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
- top = GetTopLevelOperation(*maybeInput);
- }
- switch (top.first) {
- case operation::Operator::Add:
- case operation::Operator::Sub:
- case operation::Operator::Mul:
- case operation::Operator::Div:
- case operation::Operator::And:
- case operation::Operator::Or:
- case operation::Operator::Eqv:
- case operation::Operator::Neqv:
- case operation::Operator::Min:
- case operation::Operator::Max:
- case operation::Operator::Identity:
- break;
- case operation::Operator::Call:
- context_.Say(source,
- "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);
- return;
- case operation::Operator::Convert:
- context_.Say(source,
- "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);
- return;
- case operation::Operator::Intrinsic:
- context_.Say(source,
- "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);
- return;
- case operation::Operator::Constant:
- case operation::Operator::Unknown:
- context_.Say(
- source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);
- return;
- default:
- assert(
- top.first != operation::Operator::Identity && "Handle this separately");
- context_.Say(source,
- "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,
- operation::ToString(top.first));
- return;
- }
- // Check how many times `atom` occurs as an argument, if it's a subexpression
- // of an argument, and collect the non-atom arguments.
- std::vector<SomeExpr> nonAtom;
- MaybeExpr subExpr;
- auto atomCount{[&]() {
- int count{0};
- for (const SomeExpr &arg : top.second) {
- if (IsSameOrConvertOf(arg, atom)) {
- ++count;
- } else {
- if (!subExpr && IsSubexpressionOf(atom, arg)) {
- subExpr = arg;
- }
- nonAtom.push_back(arg);
- }
- }
- return count;
- }()};
-
- bool hasError{false};
- if (subExpr) {
- context_.Say(rsrc,
- "The atomic variable %s cannot be a proper subexpression of an argument (here: %s) in the update operation"_err_en_US,
- atom.AsFortran(), subExpr->AsFortran());
- hasError = true;
- }
- if (top.first == operation::Operator::Identity) {
- // This is "x = y".
- assert((atomCount == 0 || atomCount == 1) && "Unexpected count");
- if (atomCount == 0) {
- context_.Say(rsrc,
- "The atomic variable %s should appear as an argument in the update operation"_err_en_US,
- atom.AsFortran());
- hasError = true;
- }
- } else {
- if (atomCount == 0) {
- context_.Say(rsrc,
- "The atomic variable %s should appear as an argument of the top-level %s operator"_err_en_US,
- atom.AsFortran(), operation::ToString(top.first));
- hasError = true;
- } else if (atomCount > 1) {
- context_.Say(rsrc,
- "The atomic variable %s should be exactly one of the arguments of the top-level %s operator"_err_en_US,
- atom.AsFortran(), operation::ToString(top.first));
- hasError = true;
- }
- }
-
- if (!hasError) {
- CheckStorageOverlap(atom, nonAtom, source);
- }
-}
-
-void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
- const SomeExpr &cond, parser::CharBlock condSource,
- const evaluate::Assignment &assign, parser::CharBlock assignSource) {
- auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};
- const SomeExpr &atom{assign.lhs};
-
- if (!IsVarOrFunctionRef(atom)) {
- ErrorShouldBeVariable(atom, arsrc);
- // Skip other checks.
- return;
- }
-
- CheckAtomicVariable(atom, alsrc);
-
- auto top{GetTopLevelOperation(cond)};
- // Missing arguments to operations would have been diagnosed by now.
-
- switch (top.first) {
- case operation::Operator::Associated:
- if (atom != top.second.front()) {
- context_.Say(assignSource,
- "The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);
- }
- break;
- // x equalop e | e equalop x (allowing "e equalop x" is an extension)
- case operation::Operator::Eq:
- case operation::Operator::Eqv:
- // x ordop expr | expr ordop x
- case operation::Operator::Lt:
- case operation::Operator::Gt: {
- const SomeExpr &arg0{top.second[0]};
- const SomeExpr &arg1{top.second[1]};
- if (IsSameOrConvertOf(arg0, atom)) {
- CheckStorageOverlap(atom, {arg1}, condSource);
- } else if (IsSameOrConvertOf(arg1, atom)) {
- CheckStorageOverlap(atom, {arg0}, condSource);
- } else {
- assert(top.first != operation::Operator::Identity &&
- "Handle this separately");
- context_.Say(assignSource,
- "An argument of the %s operator should be the target of the assignment"_err_en_US,
- operation::ToString(top.first));
- }
- break;
- }
- case operation::Operator::Identity:
- case operation::Operator::True:
- case operation::Operator::False:
- break;
- default:
- assert(
- top.first != operation::Operator::Identity && "Handle this separately");
- context_.Say(condSource,
- "The %s operator is not a valid condition for ATOMIC operation"_err_en_US,
- operation::ToString(top.first));
- break;
- }
-}
-
-void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(
- const AnalyzedCondStmt &update, parser::CharBlock source) {
- // The condition/statements must be:
- // - cond: x equalop e ift: x = d iff: -
- // - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)
- // - cond: associated(x) ift: x => expr iff: -
- // - cond: associated(x, e) ift: x => expr iff: -
-
- // The if-true statement must be present, and must be an assignment.
- auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};
- if (!maybeAssign) {
- if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {
- context_.Say(update.ift.source,
- "In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);
- } else {
- context_.Say(
- source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);
- }
- return;
- }
- const evaluate::Assignment assign{*maybeAssign};
- const SomeExpr &atom{assign.lhs};
-
- CheckAtomicConditionalUpdateAssignment(
- update.cond, update.source, assign, update.ift.source);
-
- CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);
-
- if (update.iff) {
- context_.Say(update.iff.source,
- "In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);
- }
-}
-
-void OmpStructureChecker::CheckAtomicUpdateOnly(
- const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
- parser::CharBlock source) {
- if (body.size() == 1) {
- SourcedActionStmt action{GetActionStmt(&body.front())};
- if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {
- const SomeExpr &atom{maybeUpdate->lhs};
- CheckAtomicUpdateAssignment(*maybeUpdate, action.source);
-
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
- MakeAtomicAnalysisOp(Analysis::Update, maybeUpdate),
- MakeAtomicAnalysisOp(Analysis::None));
- } else if (!IsAssignment(action.stmt)) {
- context_.Say(
- source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);
- }
- } else {
- context_.Say(x.source,
- "ATOMIC UPDATE operation should have a single statement"_err_en_US);
- }
-}
-
-void OmpStructureChecker::CheckAtomicConditionalUpdate(
- const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
- parser::CharBlock source) {
- // Allowable forms are (single-statement):
- // - if ...
- // - x = (... ? ... : x)
- // and two-statement:
- // - r = cond ; if (r) ...
-
- const parser::ExecutionPartConstruct *ust{nullptr}; // update
- const parser::ExecutionPartConstruct *cst{nullptr}; // condition
-
- if (body.size() == 1) {
- ust = &body.front();
- } else if (body.size() == 2) {
- cst = &body.front();
- ust = &body.back();
- } else {
- context_.Say(source,
- "ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);
- return;
- }
-
- // Flang doesn't support conditional-expr yet, so all update statements
- // are if-statements.
-
- // IfStmt: if (...) ...
- // IfConstruct: if (...) then ... endif
- auto maybeUpdate{AnalyzeConditionalStmt(ust)};
- if (!maybeUpdate) {
- context_.Say(source,
- "In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);
- return;
- }
-
- AnalyzedCondStmt &update{*maybeUpdate};
-
- if (SourcedActionStmt action{GetActionStmt(cst)}) {
- // The "condition" statement must be `r = cond`.
- if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {
- if (maybeCond->lhs != update.cond) {
- context_.Say(update.source,
- "In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,
- maybeCond->lhs.AsFortran());
- } else {
- // If it's "r = ...; if (r) ..." then put the original condition
- // in `update`.
- update.cond = maybeCond->rhs;
- }
- } else {
- context_.Say(action.source,
- "In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);
- }
- }
-
- evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};
-
- CheckAtomicConditionalUpdateStmt(update, source);
- if (IsCheckForAssociated(update.cond)) {
- if (!IsPointerAssignment(assign)) {
- context_.Say(source,
- "The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);
- }
- } else {
- if (IsPointerAssignment(assign)) {
- context_.Say(source,
- "The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);
- }
- }
-
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- x.analysis = MakeAtomicAnalysis(assign.lhs, update.cond,
- MakeAtomicAnalysisOp(Analysis::Update | Analysis::IfTrue, assign),
- MakeAtomicAnalysisOp(Analysis::None));
-}
-
-void OmpStructureChecker::CheckAtomicUpdateCapture(
- const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
- parser::CharBlock source) {
- if (body.size() != 2) {
- context_.Say(source,
- "ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);
- return;
- }
-
- auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};
- if (!uec || !cec) {
- // Diagnostics already emitted.
- return;
- }
- SourcedActionStmt uact{GetActionStmt(uec)};
- SourcedActionStmt cact{GetActionStmt(cec)};
- // The "dereferences" of std::optional are guaranteed to be valid after
- // CheckUpdateCapture.
- evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};
- evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};
-
- const SomeExpr &atom{update.lhs};
-
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- int action;
-
- if (IsMaybeAtomicWrite(update)) {
- action = Analysis::Write;
- CheckAtomicWriteAssignment(update, uact.source);
- } else {
- action = Analysis::Update;
- CheckAtomicUpdateAssignment(update, uact.source);
- }
- CheckAtomicCaptureAssignment(capture, atom, cact.source);
-
- if (IsPointerAssignment(update) != IsPointerAssignment(capture)) {
- context_.Say(cact.source,
- "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
- return;
- }
-
- if (GetActionStmt(&body.front()).stmt == uact.stmt) {
- x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
- MakeAtomicAnalysisOp(action, update),
- MakeAtomicAnalysisOp(Analysis::Read, capture));
- } else {
- x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
- MakeAtomicAnalysisOp(Analysis::Read, capture),
- MakeAtomicAnalysisOp(action, update));
- }
-}
-
-void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(
- const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
- parser::CharBlock source) {
- // There are two
diff erent variants of this:
- // (1) conditional-update and capture separately:
- // This form only allows single-statement updates, i.e. the update
- // form "r = cond; if (r) ..." is not allowed.
- // (2) conditional-update combined with capture in a single statement:
- // This form does allow the condition to be calculated separately,
- // i.e. "r = cond; if (r) ...".
- // Regardless of what form it is, the actual update assignment is a
- // proper write, i.e. "x = d", where d does not depend on x.
-
- AnalyzedCondStmt update;
- SourcedActionStmt capture;
- bool captureAlways{true}, captureFirst{true};
-
- auto extractCapture{[&]() {
- capture = update.iff;
- captureAlways = false;
- update.iff = SourcedActionStmt{};
- }};
-
- auto classifyNonUpdate{[&](const SourcedActionStmt &action) {
- // The non-update statement is either "r = cond" or the capture.
- if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {
- if (update.cond == maybeAssign->lhs) {
- // If this is "r = cond; if (r) ...", then update the condition.
- update.cond = maybeAssign->rhs;
- update.source = action.source;
- // In this form, the update and the capture are combined into
- // an IF-THEN-ELSE statement.
- extractCapture();
- } else {
- // Assume this is the capture-statement.
- capture = action;
- }
- }
- }};
-
- if (body.size() == 2) {
- // This could be
- // - capture; conditional-update (in any order), or
- // - r = cond; if (r) capture-update
- const parser::ExecutionPartConstruct *st1{&body.front()};
- const parser::ExecutionPartConstruct *st2{&body.back()};
- // In either case, the conditional statement can be analyzed by
- // AnalyzeConditionalStmt, whereas the other statement cannot.
- if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {
- update = *maybeUpdate1;
- classifyNonUpdate(GetActionStmt(st2));
- captureFirst = false;
- } else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {
- update = *maybeUpdate2;
- classifyNonUpdate(GetActionStmt(st1));
- } else {
- // None of the statements are conditional, this rules out the
- // "r = cond; if (r) ..." and the "capture + conditional-update"
- // variants. This could still be capture + write (which is classified
- // as conditional-update-capture in the spec).
- auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};
- if (!uec || !cec) {
- // Diagnostics already emitted.
- return;
- }
- SourcedActionStmt uact{GetActionStmt(uec)};
- SourcedActionStmt cact{GetActionStmt(cec)};
- update.ift = uact;
- capture = cact;
- if (uec == st1) {
- captureFirst = false;
- }
- }
- } else if (body.size() == 1) {
- if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {
- update = *maybeUpdate;
- // This is the form with update and capture combined into an IF-THEN-ELSE
- // statement. The capture-statement is always the ELSE branch.
- extractCapture();
- } else {
- goto invalid;
- }
- } else {
- context_.Say(source,
- "ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);
- return;
- invalid:
- context_.Say(source,
- "Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);
- return;
- }
-
- // The update must have a form `x = d` or `x => d`.
- if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {
- const SomeExpr &atom{maybeWrite->lhs};
- CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);
- if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {
- CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);
-
- if (IsPointerAssignment(*maybeWrite) !=
- IsPointerAssignment(*maybeCapture)) {
- context_.Say(capture.source,
- "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
- return;
- }
- } else {
- if (!IsAssignment(capture.stmt)) {
- context_.Say(capture.source,
- "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);
- }
- return;
- }
- } else {
- if (!IsAssignment(update.ift.stmt)) {
- context_.Say(update.ift.source,
- "In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);
- }
- return;
- }
-
- // update.iff should be empty here, the capture statement should be
- // stored in "capture".
-
- // Fill out the analysis in the AST node.
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- bool condUnused{std::visit(
- [](auto &&s) {
- using BareS = llvm::remove_cvref_t<decltype(s)>;
- if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {
- return true;
- } else {
- return false;
- }
- },
- update.cond.u)};
-
- int updateWhen{!condUnused ? Analysis::IfTrue : 0};
- int captureWhen{!captureAlways ? Analysis::IfFalse : 0};
-
- evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};
- evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};
-
- if (captureFirst) {
- x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
- MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign),
- MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign));
- } else {
- x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
- MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign),
- MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign));
- }
-}
-
-void OmpStructureChecker::CheckAtomicRead(
- const parser::OpenMPAtomicConstruct &x) {
- // [6.0:190:5-7]
- // A read structured block is read-statement, a read statement that has one
- // of the following forms:
- // v = x
- // v => x
- auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
- auto &block{std::get<parser::Block>(x.t)};
-
- // Read cannot be conditional or have a capture statement.
- if (x.IsCompare() || x.IsCapture()) {
- context_.Say(dirSpec.source,
- "ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);
- return;
- }
-
- const parser::Block &body{GetInnermostExecPart(block)};
-
- if (body.size() == 1) {
- SourcedActionStmt action{GetActionStmt(&body.front())};
- if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {
- CheckAtomicReadAssignment(*maybeRead, action.source);
-
- if (auto maybe{GetConvertInput(maybeRead->rhs)}) {
- const SomeExpr &atom{*maybe};
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
- MakeAtomicAnalysisOp(Analysis::Read, maybeRead),
- MakeAtomicAnalysisOp(Analysis::None));
- }
- } else if (!IsAssignment(action.stmt)) {
- context_.Say(
- x.source, "ATOMIC READ operation should be an assignment"_err_en_US);
+ // This is diagnosed later.
+ return;
}
- } else {
- context_.Say(x.source,
- "ATOMIC READ operation should have a single statement"_err_en_US);
}
}
-void OmpStructureChecker::CheckAtomicWrite(
- const parser::OpenMPAtomicConstruct &x) {
- auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
- auto &block{std::get<parser::Block>(x.t)};
-
- // Write cannot be conditional or have a capture statement.
- if (x.IsCompare() || x.IsCapture()) {
- context_.Say(dirSpec.source,
- "ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);
- return;
- }
-
- const parser::Block &body{GetInnermostExecPart(block)};
-
- if (body.size() == 1) {
- SourcedActionStmt action{GetActionStmt(&body.front())};
- if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {
- const SomeExpr &atom{maybeWrite->lhs};
- CheckAtomicWriteAssignment(*maybeWrite, action.source);
-
- using Analysis = parser::OpenMPAtomicConstruct::Analysis;
- x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
- MakeAtomicAnalysisOp(Analysis::Write, maybeWrite),
- MakeAtomicAnalysisOp(Analysis::None));
- } else if (!IsAssignment(action.stmt)) {
- context_.Say(
- x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);
- }
- } else {
- context_.Say(x.source,
- "ATOMIC WRITE operation should have a single statement"_err_en_US);
- }
-}
-
-void OmpStructureChecker::CheckAtomicUpdate(
- const parser::OpenMPAtomicConstruct &x) {
- auto &block{std::get<parser::Block>(x.t)};
-
- bool isConditional{x.IsCompare()};
- bool isCapture{x.IsCapture()};
- const parser::Block &body{GetInnermostExecPart(block)};
-
- if (isConditional && isCapture) {
- CheckAtomicConditionalUpdateCapture(x, body, x.source);
- } else if (isConditional) {
- CheckAtomicConditionalUpdate(x, body, x.source);
- } else if (isCapture) {
- CheckAtomicUpdateCapture(x, body, x.source);
- } else { // update-only
- CheckAtomicUpdateOnly(x, body, x.source);
- }
-}
-
-void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
- if (visitedAtomicSource_.empty())
- visitedAtomicSource_ = x.source;
-
- // All of the following groups have the "exclusive" property, i.e. at
- // most one clause from each group is allowed.
- // The exclusivity-checking code should eventually be unified for all
- // clauses, with clause groups defined in OMP.td.
- std::array atomic{llvm::omp::Clause::OMPC_read,
- llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};
- std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,
- llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,
- llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};
-
- auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,
- std::string_view name,
- const parser::OmpClauseList &clauses) {
- const parser::OmpClause *present{nullptr};
- for (const parser::OmpClause &clause : clauses.v) {
- llvm::omp::Clause id{clause.Id()};
- if (!llvm::is_contained(group, id)) {
- continue;
- }
- if (present == nullptr) {
- present = &clause;
- continue;
- } else if (id == present->Id()) {
- // Ignore repetitions of the same clause, those will be diagnosed
- // separately.
- continue;
- }
- parser::MessageFormattedText txt(
- "At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,
- name.data());
- parser::Message message(clause.source, txt);
- message.Attach(present->source,
- "Previous clause from this group provided here"_en_US);
- context_.Say(std::move(message));
- return;
- }
- }};
-
- auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
- auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);
- llvm::omp::Clause kind{x.GetKind()};
-
- checkExclusive(atomic, "atomic", dirSpec.Clauses());
- checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());
-
- switch (kind) {
- case llvm::omp::Clause::OMPC_read:
- CheckAtomicRead(x);
+void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
+ const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
+ ResetPartialContext(dir.source);
+ switch (dir.v) {
+ case llvm::omp::Directive::OMPD_scope:
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
break;
- case llvm::omp::Clause::OMPC_write:
- CheckAtomicWrite(x);
+ // 2.7.3 end-single-clause -> copyprivate-clause |
+ // nowait-clause
+ case llvm::omp::Directive::OMPD_single:
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
break;
- case llvm::omp::Clause::OMPC_update:
- CheckAtomicUpdate(x);
+ // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
+ case llvm::omp::Directive::OMPD_workshare:
+ PushContextAndClauseSets(
+ dir.source, llvm::omp::Directive::OMPD_end_workshare);
break;
default:
+ // no clauses are allowed
break;
}
}
-void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
- dirContext_.pop_back();
+// TODO: Verify the popping of dirContext requirement after nowait
+// implementation, as there is an implicit barrier at the end of the worksharing
+// constructs unless a nowait clause is specified. Only OMPD_end_single and
+// end_workshareare popped as they are pushed while entering the
+// EndBlockDirective.
+void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
+ if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
+ (GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
+ (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
+ dirContext_.pop_back();
+ }
}
// Clauses
@@ -5220,102 +3162,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
}
}
-void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
- CheckAllowedClause(llvm::omp::Clause::OMPC_linear);
- unsigned version{context_.langOptions().OpenMPVersion};
- llvm::omp::Directive dir{GetContext().directive};
- parser::CharBlock clauseSource{GetContext().clauseSource};
- const parser::OmpLinearModifier *linearMod{nullptr};
-
- SymbolSourceMap symbols;
- auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
- CheckCrayPointee(objects, "LINEAR", false);
- GetSymbolsInObjectList(objects, symbols);
-
- auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {
- if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
- auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
- context_.Say(source,
- "The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,
- symbol->name(), desc.name.str());
- }
- }};
-
- if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {
- auto &modifiers{OmpGetModifiers(x.v)};
- linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);
- if (linearMod) {
- // 2.7 Loop Construct Restriction
- if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {
- context_.Say(clauseSource,
- "A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,
- ContextDirectiveAsFortran());
- return;
- }
-
- auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
- for (auto &[symbol, source] : symbols) {
- if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {
- CheckIntegerNoRef(symbol, source);
- } else {
- if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&
- !IsPolymorphic(*symbol)) {
- context_.Say(source,
- "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,
- symbol->name(), desc.name.str());
- }
- }
- if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||
- linearMod->v == parser::OmpLinearModifier::Value::Uval) {
- if (!IsDummy(*symbol) || IsValue(*symbol)) {
- context_.Say(source,
- "If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,
- desc.name.str(), symbol->name());
- }
- }
- } // for (symbol, source)
-
- if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {
- context_.Say(OmpGetModifierSource(modifiers, linearMod),
- "The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,
- ThisVersion(version));
- }
- }
- }
-
- // OpenMP 5.2: Ordered clause restriction
- if (const auto *clause{
- FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {
- const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};
- if (orderedClause.v) {
- return;
- }
- }
-
- // OpenMP 5.2: Linear clause Restrictions
- for (auto &[symbol, source] : symbols) {
- if (!linearMod) {
- // Already checked this with the modifier present.
- CheckIntegerNoRef(symbol, source);
- }
- if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {
- context_.Say(source,
- "The list item `%s` must be a dummy argument"_err_en_US,
- symbol->name());
- }
- if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {
- context_.Say(source,
- "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,
- symbol->name());
- }
- if (FindCommonBlockContaining(*symbol)) {
- context_.Say(source,
- "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,
- symbol->name());
- }
- }
-}
-
void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {
unsigned version{context_.langOptions().OpenMPVersion};
if (version >= 52) {
@@ -6024,503 +3870,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
}
}
-void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
- CheckAllowedClause(llvm::omp::Clause::OMPC_when);
- OmpVerifyModifiers(
- x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
-}
-
-void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
- EnterDirectiveNest(ContextSelectorNest);
-
- using SetName = parser::OmpTraitSetSelectorName;
- std::map<SetName::Value, const SetName *> visited;
-
- for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
- auto &name{std::get<SetName>(traitSet.t)};
- auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
- if (!unique) {
- std::string showName{parser::ToUpperCaseLetters(name.ToString())};
- parser::MessageFormattedText txt(
- "Repeated trait set name %s in a context specifier"_err_en_US,
- showName);
- parser::Message message(name.source, txt);
- message.Attach(prev->second->source,
- "Previous trait set %s provided here"_en_US, showName);
- context_.Say(std::move(message));
- }
- CheckTraitSetSelector(traitSet);
- }
-}
-
-void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
- ExitDirectiveNest(ContextSelectorNest);
-}
-
-const std::list<parser::OmpTraitProperty> &
-OmpStructureChecker::GetTraitPropertyList(
- const parser::OmpTraitSelector &trait) {
- static const std::list<parser::OmpTraitProperty> empty{};
- auto &[_, maybeProps]{trait.t};
- if (maybeProps) {
- using PropertyList = std::list<parser::OmpTraitProperty>;
- return std::get<PropertyList>(maybeProps->t);
- } else {
- return empty;
- }
-}
-
-std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
- const parser::OmpTraitProperty &property) {
- using MaybeClause = std::optional<llvm::omp::Clause>;
-
- // The parser for OmpClause will only succeed if the clause was
- // given with all required arguments.
- // If this is a string or complex extension with a clause name,
- // treat it as a clause and let the trait checker deal with it.
-
- auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
- auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
- if (id != llvm::omp::Clause::OMPC_unknown) {
- return id;
- } else {
- return std::nullopt;
- }
- }};
-
- return common::visit( //
- common::visitors{
- [&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
- return getClauseFromString(x.v);
- },
- [&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
- return x.value().Id();
- },
- [&](const parser::ScalarExpr &x) -> MaybeClause {
- return std::nullopt;
- },
- [&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
- using ExtProperty = parser::OmpTraitPropertyExtension;
- if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
- return getClauseFromString(name->v);
- } else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
- return getClauseFromString(
- std::get<parser::OmpTraitPropertyName>(cpx->t).v);
- }
- return std::nullopt;
- },
- },
- property.u);
-}
-
-void OmpStructureChecker::CheckTraitSelectorList(
- const std::list<parser::OmpTraitSelector> &traits) {
- // [6.0:322:20]
- // Each trait-selector-name may only be specified once in a trait selector
- // set.
-
- // Cannot store OmpTraitSelectorName directly, because it's not copyable.
- using TraitName = parser::OmpTraitSelectorName;
- using BareName = decltype(TraitName::u);
- std::map<BareName, const TraitName *> visited;
-
- for (const parser::OmpTraitSelector &trait : traits) {
- auto &name{std::get<TraitName>(trait.t)};
-
- auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
- if (!unique) {
- std::string showName{parser::ToUpperCaseLetters(name.ToString())};
- parser::MessageFormattedText txt(
- "Repeated trait name %s in a trait set"_err_en_US, showName);
- parser::Message message(name.source, txt);
- message.Attach(prev->second->source,
- "Previous trait %s provided here"_en_US, showName);
- context_.Say(std::move(message));
- }
- }
-}
-
-void OmpStructureChecker::CheckTraitSetSelector(
- const parser::OmpTraitSetSelector &traitSet) {
-
- // Trait Set | Allowed traits | D-traits | X-traits | Score |
- //
- // Construct | Simd, directive-name | Yes | No | No |
- // Device | Arch, Isa, Kind | No | Yes | No |
- // Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
- // | Extension, Requires | | | |
- // | Vendor | | | |
- // Target_Device | Arch, Device_Num, Isa | No | Yes | No |
- // | Kind, Uid | | | |
- // User | Condition | No | No | Yes |
-
- struct TraitSetConfig {
- std::set<parser::OmpTraitSelectorName::Value> allowed;
- bool allowsDirectiveTraits;
- bool allowsExtensionTraits;
- bool allowsScore;
- };
-
- using SName = parser::OmpTraitSetSelectorName::Value;
- using TName = parser::OmpTraitSelectorName::Value;
-
- static const std::map<SName, TraitSetConfig> configs{
- {SName::Construct, //
- {{TName::Simd}, true, false, false}},
- {SName::Device, //
- {{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
- {SName::Implementation, //
- {{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
- TName::Vendor},
- false, true, true}},
- {SName::Target_Device, //
- {{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
- TName::Uid},
- false, true, false}},
- {SName::User, //
- {{TName::Condition}, false, false, true}},
- };
-
- auto checkTraitSet{[&](const TraitSetConfig &config) {
- auto &[setName, traits]{traitSet.t};
- auto usn{parser::ToUpperCaseLetters(setName.ToString())};
-
- // Check if there are any duplicate traits.
- CheckTraitSelectorList(traits);
-
- for (const parser::OmpTraitSelector &trait : traits) {
- // Don't use structured bindings here, because they cannot be captured
- // before C++20.
- auto &traitName = std::get<parser::OmpTraitSelectorName>(trait.t);
- auto &maybeProps =
- std::get<std::optional<parser::OmpTraitSelector::Properties>>(
- trait.t);
-
- // Check allowed traits
- common::visit( //
- common::visitors{
- [&](parser::OmpTraitSelectorName::Value v) {
- if (!config.allowed.count(v)) {
- context_.Say(traitName.source,
- "%s is not a valid trait for %s trait set"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()), usn);
- }
- },
- [&](llvm::omp::Directive) {
- if (!config.allowsDirectiveTraits) {
- context_.Say(traitName.source,
- "Directive name is not a valid trait for %s trait set"_err_en_US,
- usn);
- }
- },
- [&](const std::string &) {
- if (!config.allowsExtensionTraits) {
- context_.Say(traitName.source,
- "Extension traits are not valid for %s trait set"_err_en_US,
- usn);
- }
- },
- },
- traitName.u);
-
- // Check score
- if (maybeProps) {
- auto &[maybeScore, _]{maybeProps->t};
- if (maybeScore) {
- CheckTraitScore(*maybeScore);
- }
- }
-
- // Check the properties of the individual traits
- CheckTraitSelector(traitSet, trait);
- }
- }};
-
- checkTraitSet(
- configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
-}
-
-void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
- // [6.0:322:23]
- // A score-expression must be a non-negative constant integer expression.
- if (auto value{GetIntValue(score)}; !value || value < 0) {
- context_.Say(score.source,
- "SCORE expression must be a non-negative constant integer expression"_err_en_US);
- }
-}
-
-bool OmpStructureChecker::VerifyTraitPropertyLists(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- using TraitName = parser::OmpTraitSelectorName;
- using PropertyList = std::list<parser::OmpTraitProperty>;
- auto &[traitName, maybeProps]{trait.t};
-
- auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
- const std::string &message) {
- bool foundInvalid{false};
- for (const parser::OmpTraitProperty &prop : properties) {
- if (!isValid(prop)) {
- if (foundInvalid) {
- context_.Say(
- prop.source, "More invalid properties are present"_err_en_US);
- break;
- }
- context_.Say(prop.source, "%s"_err_en_US, message);
- foundInvalid = true;
- }
- }
- return !foundInvalid;
- }};
-
- bool invalid{false};
-
- if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
- // Directive-name traits don't have properties.
- if (maybeProps) {
- context_.Say(trait.source,
- "Directive-name traits cannot have properties"_err_en_US);
- invalid = true;
- }
- }
- // Ignore properties on extension traits.
-
- // See `TraitSelectorParser` in openmp-parser.cpp
- if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
- switch (*v) {
- // name-list properties
- case parser::OmpTraitSelectorName::Value::Arch:
- case parser::OmpTraitSelectorName::Value::Extension:
- case parser::OmpTraitSelectorName::Value::Isa:
- case parser::OmpTraitSelectorName::Value::Kind:
- case parser::OmpTraitSelectorName::Value::Uid:
- case parser::OmpTraitSelectorName::Value::Vendor:
- if (maybeProps) {
- auto isName{[](const parser::OmpTraitProperty &prop) {
- return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
- }};
- invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
- isName, "Trait property should be a name");
- }
- break;
- // clause-list
- case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
- case parser::OmpTraitSelectorName::Value::Requires:
- case parser::OmpTraitSelectorName::Value::Simd:
- if (maybeProps) {
- auto isClause{[&](const parser::OmpTraitProperty &prop) {
- return GetClauseFromProperty(prop).has_value();
- }};
- invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
- isClause, "Trait property should be a clause");
- }
- break;
- // expr-list
- case parser::OmpTraitSelectorName::Value::Condition:
- case parser::OmpTraitSelectorName::Value::Device_Num:
- if (maybeProps) {
- auto isExpr{[](const parser::OmpTraitProperty &prop) {
- return std::holds_alternative<parser::ScalarExpr>(prop.u);
- }};
- invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
- isExpr, "Trait property should be a scalar expression");
- }
- break;
- } // switch
- }
-
- return !invalid;
-}
-
-void OmpStructureChecker::CheckTraitSelector(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- using TraitName = parser::OmpTraitSelectorName;
- auto &[traitName, maybeProps]{trait.t};
-
- // Only do the detailed checks if the property lists are valid.
- if (VerifyTraitPropertyLists(traitSet, trait)) {
- if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
- std::holds_alternative<std::string>(traitName.u)) {
- // No properties here: directives don't have properties, and
- // we don't implement any extension traits now.
- return;
- }
-
- // Specific traits we want to check.
- // Limitations:
- // (1) The properties for these traits are defined in "Additional
- // Definitions for the OpenMP API Specification". It's not clear how
- // to define them in a portable way, and how to verify their validity,
- // especially if they get replaced by their integer values (in case
- // they are defined as enums).
- // (2) These are entirely implementation-defined, and at the moment
- // there is no known schema to validate these values.
- auto v{std::get<TraitName::Value>(traitName.u)};
- switch (v) {
- case TraitName::Value::Arch:
- // Unchecked, TBD(1)
- break;
- case TraitName::Value::Atomic_Default_Mem_Order:
- CheckTraitADMO(traitSet, trait);
- break;
- case TraitName::Value::Condition:
- CheckTraitCondition(traitSet, trait);
- break;
- case TraitName::Value::Device_Num:
- CheckTraitDeviceNum(traitSet, trait);
- break;
- case TraitName::Value::Extension:
- // Ignore
- break;
- case TraitName::Value::Isa:
- // Unchecked, TBD(1)
- break;
- case TraitName::Value::Kind:
- // Unchecked, TBD(1)
- break;
- case TraitName::Value::Requires:
- CheckTraitRequires(traitSet, trait);
- break;
- case TraitName::Value::Simd:
- CheckTraitSimd(traitSet, trait);
- break;
- case TraitName::Value::Uid:
- // Unchecked, TBD(2)
- break;
- case TraitName::Value::Vendor:
- // Unchecked, TBD(1)
- break;
- }
- }
-}
-
-void OmpStructureChecker::CheckTraitADMO(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
- auto &properties{GetTraitPropertyList(trait)};
-
- if (properties.size() != 1) {
- context_.Say(trait.source,
- "%s trait requires a single clause property"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- } else {
- const parser::OmpTraitProperty &property{properties.front()};
- auto clauseId{*GetClauseFromProperty(property)};
- // Check that the clause belongs to the memory-order clause-set.
- // Clause sets will hopefully be autogenerated at some point.
- switch (clauseId) {
- case llvm::omp::Clause::OMPC_acq_rel:
- case llvm::omp::Clause::OMPC_acquire:
- case llvm::omp::Clause::OMPC_relaxed:
- case llvm::omp::Clause::OMPC_release:
- case llvm::omp::Clause::OMPC_seq_cst:
- break;
- default:
- context_.Say(property.source,
- "%s trait requires a clause from the memory-order clause set"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- }
-
- using ClauseProperty = common::Indirection<parser::OmpClause>;
- if (!std::holds_alternative<ClauseProperty>(property.u)) {
- context_.Say(property.source,
- "Invalid clause specification for %s"_err_en_US,
- parser::ToUpperCaseLetters(getClauseName(clauseId)));
- }
- }
-}
-
-void OmpStructureChecker::CheckTraitCondition(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
- auto &properties{GetTraitPropertyList(trait)};
-
- if (properties.size() != 1) {
- context_.Say(trait.source,
- "%s trait requires a single expression property"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- } else {
- const parser::OmpTraitProperty &property{properties.front()};
- auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
-
- auto maybeType{GetDynamicType(scalarExpr.thing.value())};
- if (!maybeType || maybeType->category() != TypeCategory::Logical) {
- context_.Say(property.source,
- "%s trait requires a single LOGICAL expression"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- }
- }
-}
-
-void OmpStructureChecker::CheckTraitDeviceNum(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
- auto &properties{GetTraitPropertyList(trait)};
-
- if (properties.size() != 1) {
- context_.Say(trait.source,
- "%s trait requires a single expression property"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- }
- // No other checks at the moment.
-}
-
-void OmpStructureChecker::CheckTraitRequires(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- unsigned version{context_.langOptions().OpenMPVersion};
- auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
- auto &properties{GetTraitPropertyList(trait)};
-
- for (const parser::OmpTraitProperty &property : properties) {
- auto clauseId{*GetClauseFromProperty(property)};
- if (!llvm::omp::isAllowedClauseForDirective(
- llvm::omp::OMPD_requires, clauseId, version)) {
- context_.Say(property.source,
- "%s trait requires a clause from the requirement clause set"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()));
- }
-
- using ClauseProperty = common::Indirection<parser::OmpClause>;
- if (!std::holds_alternative<ClauseProperty>(property.u)) {
- context_.Say(property.source,
- "Invalid clause specification for %s"_err_en_US,
- parser::ToUpperCaseLetters(getClauseName(clauseId)));
- }
- }
-}
-
-void OmpStructureChecker::CheckTraitSimd(
- const parser::OmpTraitSetSelector &traitSet,
- const parser::OmpTraitSelector &trait) {
- unsigned version{context_.langOptions().OpenMPVersion};
- auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
- auto &properties{GetTraitPropertyList(trait)};
-
- for (const parser::OmpTraitProperty &property : properties) {
- auto clauseId{*GetClauseFromProperty(property)};
- if (!llvm::omp::isAllowedClauseForDirective(
- llvm::omp::OMPD_declare_simd, clauseId, version)) {
- context_.Say(property.source,
- "%s trait requires a clause that is allowed on the %s directive"_err_en_US,
- parser::ToUpperCaseLetters(traitName.ToString()),
- parser::ToUpperCaseLetters(
- getDirectiveName(llvm::omp::OMPD_declare_simd)));
- }
-
- using ClauseProperty = common::Indirection<parser::OmpClause>;
- if (!std::holds_alternative<ClauseProperty>(property.u)) {
- context_.Say(property.source,
- "Invalid clause specification for %s"_err_en_US,
- parser::ToUpperCaseLetters(getClauseName(clauseId)));
- }
- }
-}
-
llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
return llvm::omp::getOpenMPClauseName(clause);
}
@@ -6531,39 +3880,6 @@ llvm::StringRef OmpStructureChecker::getDirectiveName(
return llvm::omp::getOpenMPDirectiveName(directive, version);
}
-const Symbol *OmpStructureChecker::GetObjectSymbol(
- const parser::OmpObject &object) {
- // Some symbols may be missing if the resolution failed, e.g. when an
- // undeclared name is used with implicit none.
- if (auto *name{std::get_if<parser::Name>(&object.u)}) {
- return name->symbol ? &name->symbol->GetUltimate() : nullptr;
- } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
- auto &last{GetLastName(*desg)};
- return last.symbol ? &GetLastName(*desg).symbol->GetUltimate() : nullptr;
- }
- return nullptr;
-}
-
-const Symbol *OmpStructureChecker::GetArgumentSymbol(
- const parser::OmpArgument &argument) {
- if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
- if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
- return GetObjectSymbol(*object);
- }
- }
- return nullptr;
-}
-
-std::optional<parser::CharBlock> OmpStructureChecker::GetObjectSource(
- const parser::OmpObject &object) {
- if (auto *name{std::get_if<parser::Name>(&object.u)}) {
- return name->source;
- } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
- return GetLastName(*desg).source;
- }
- return std::nullopt;
-}
-
void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
common::visit(
common::visitors{
@@ -6873,7 +4189,7 @@ void OmpStructureChecker::CheckWorkshareBlockStmts(
}
void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
- if (auto contig{IsContiguous(object)}; contig && !*contig) {
+ if (auto contig{IsContiguous(context_, object)}; contig && !*contig) {
const parser::Name *name{GetObjectName(object)};
assert(name && "Expecting name component");
context_.Say(name->source,
@@ -6976,22 +4292,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::SelfMaps &x) {
CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_self_maps);
}
-void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
- Base::Enter(x);
- loopStack_.push_back(&x);
-}
-
-void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
- assert(!loopStack_.empty() && "Expecting non-empty loop stack");
-#ifndef NDEBUG
- const LoopConstruct &top = loopStack_.back();
- auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
- assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
-#endif
- loopStack_.pop_back();
- Base::Leave(x);
-}
-
void OmpStructureChecker::Enter(const parser::OpenMPInteropConstruct &x) {
bool isDependClauseOccured{false};
int targetCount{0}, targetSyncCount{0};
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index beb6e0528e814..2a3853335fd1c 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -162,10 +162,6 @@ class OmpStructureChecker
private:
bool CheckAllowedClause(llvmOmpClause clause);
- bool IsVariableListItem(const Symbol &sym);
- bool IsExtendedListItem(const Symbol &sym);
- bool IsCommonBlock(const Symbol &sym);
- std::optional<bool> IsContiguous(const parser::OmpObject &object);
void CheckVariableListItem(const SymbolSourceMap &symbols);
void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars,
const std::list<parser::Name> &nameList, const parser::CharBlock &item,
@@ -215,10 +211,6 @@ class OmpStructureChecker
typename IterTy = decltype(std::declval<RangeTy>().begin())>
std::optional<IterTy> FindDuplicate(RangeTy &&);
- const Symbol *GetObjectSymbol(const parser::OmpObject &object);
- const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument);
- std::optional<parser::CharBlock> GetObjectSource(
- const parser::OmpObject &object);
void CheckDependList(const parser::DataRef &);
void CheckDependArraySection(
const common::Indirection<parser::ArrayElement> &, const parser::Name &);
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
new file mode 100644
index 0000000000000..fd9596a09cd52
--- /dev/null
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -0,0 +1,393 @@
+//===-- lib/Semantics/openmp-utils.cpp ------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Common utilities used in OpenMP semantic checks.
+//
+//===----------------------------------------------------------------------===//
+
+#include "openmp-utils.h"
+
+#include "flang/Common/indirection.h"
+#include "flang/Common/reference.h"
+#include "flang/Common/visit.h"
+#include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
+#include "flang/Evaluate/type.h"
+#include "flang/Evaluate/variable.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/expression.h"
+#include "flang/Semantics/semantics.h"
+
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/STLExtras.h"
+
+#include <optional>
+#include <string>
+#include <tuple>
+#include <type_traits>
+#include <utility>
+#include <variant>
+#include <vector>
+
+namespace Fortran::semantics::omp {
+
+std::string ThisVersion(unsigned version) {
+ std::string tv{
+ std::to_string(version / 10) + "." + std::to_string(version % 10)};
+ return "OpenMP v" + tv;
+}
+
+std::string TryVersion(unsigned version) {
+ return "try -fopenmp-version=" + std::to_string(version);
+}
+
+const parser::Designator *GetDesignatorFromObj(
+ const parser::OmpObject &object) {
+ return std::get_if<parser::Designator>(&object.u);
+}
+
+const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object) {
+ if (auto *desg{GetDesignatorFromObj(object)}) {
+ return std::get_if<parser::DataRef>(&desg->u);
+ }
+ return nullptr;
+}
+
+const parser::ArrayElement *GetArrayElementFromObj(
+ const parser::OmpObject &object) {
+ if (auto *dataRef{GetDataRefFromObj(object)}) {
+ using ElementIndirection = common::Indirection<parser::ArrayElement>;
+ if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {
+ return &ind->value();
+ }
+ }
+ return nullptr;
+}
+
+const Symbol *GetObjectSymbol(const parser::OmpObject &object) {
+ // Some symbols may be missing if the resolution failed, e.g. when an
+ // undeclared name is used with implicit none.
+ if (auto *name{std::get_if<parser::Name>(&object.u)}) {
+ return name->symbol ? &name->symbol->GetUltimate() : nullptr;
+ } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
+ auto &last{GetLastName(*desg)};
+ return last.symbol ? &GetLastName(*desg).symbol->GetUltimate() : nullptr;
+ }
+ return nullptr;
+}
+
+const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) {
+ if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
+ if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
+ return GetObjectSymbol(*object);
+ }
+ }
+ return nullptr;
+}
+
+std::optional<parser::CharBlock> GetObjectSource(
+ const parser::OmpObject &object) {
+ if (auto *name{std::get_if<parser::Name>(&object.u)}) {
+ return name->source;
+ } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
+ return GetLastName(*desg).source;
+ }
+ return std::nullopt;
+}
+
+bool IsCommonBlock(const Symbol &sym) {
+ return sym.detailsIf<CommonBlockDetails>() != nullptr;
+}
+
+bool IsVariableListItem(const Symbol &sym) {
+ return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
+}
+
+bool IsExtendedListItem(const Symbol &sym) {
+ return IsVariableListItem(sym) || sym.IsSubprogram();
+}
+
+bool IsVarOrFunctionRef(const MaybeExpr &expr) {
+ if (expr) {
+ return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
+ evaluate::IsVariable(*expr);
+ } else {
+ return false;
+ }
+}
+
+std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
+ const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
+ // ForwardOwningPointer typedExpr
+ // `- GenericExprWrapper ^.get()
+ // `- std::optional<Expr> ^->v
+ return typedExpr.get()->v;
+}
+
+std::optional<evaluate::DynamicType> GetDynamicType(
+ const parser::Expr &parserExpr) {
+ if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
+ return maybeExpr->GetType();
+ } else {
+ return std::nullopt;
+ }
+}
+
+namespace {
+struct ContiguousHelper {
+ ContiguousHelper(SemanticsContext &context)
+ : fctx_(context.foldingContext()) {}
+
+ template <typename Contained>
+ std::optional<bool> Visit(const common::Indirection<Contained> &x) {
+ return Visit(x.value());
+ }
+ template <typename Contained>
+ std::optional<bool> Visit(const common::Reference<Contained> &x) {
+ return Visit(x.get());
+ }
+ template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
+ return common::visit([&](auto &&s) { return Visit(s); }, x.u);
+ }
+ template <typename T>
+ std::optional<bool> Visit(const evaluate::Designator<T> &x) {
+ return common::visit(
+ [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
+ }
+ template <typename T> std::optional<bool> Visit(const T &) {
+ // Everything else.
+ return std::nullopt;
+ }
+
+private:
+ evaluate::FoldingContext &fctx_;
+};
+} // namespace
+
+// Return values:
+// - std::optional<bool>{true} if the object is known to be contiguous
+// - std::optional<bool>{false} if the object is known not to be contiguous
+// - std::nullopt if the object contiguity cannot be determined
+std::optional<bool> IsContiguous(
+ SemanticsContext &semaCtx, const parser::OmpObject &object) {
+ return common::visit( //
+ common::visitors{
+ [&](const parser::Name &x) {
+ // Any member of a common block must be contiguous.
+ return std::optional<bool>{true};
+ },
+ [&](const parser::Designator &x) {
+ evaluate::ExpressionAnalyzer ea{semaCtx};
+ if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
+ return ContiguousHelper{semaCtx}.Visit(*maybeExpr);
+ }
+ return std::optional<bool>{};
+ },
+ },
+ object.u);
+}
+
+struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
+ std::vector<SomeExpr>, false> {
+ using Result = std::vector<SomeExpr>;
+ using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
+ DesignatorCollector() : Base(*this) {}
+
+ Result Default() const { return {}; }
+
+ using Base::operator();
+
+ template <typename T> //
+ Result operator()(const evaluate::Designator<T> &x) const {
+ // Once in a designator, don't traverse it any further (i.e. only
+ // collect top-level designators).
+ auto copy{x};
+ return Result{AsGenericExpr(std::move(copy))};
+ }
+
+ template <typename... Rs> //
+ Result Combine(Result &&result, Rs &&...results) const {
+ Result v(std::move(result));
+ auto moveAppend{[](auto &accum, auto &&other) {
+ for (auto &&s : other) {
+ accum.push_back(std::move(s));
+ }
+ }};
+ (moveAppend(v, std::move(results)), ...);
+ return v;
+ }
+};
+
+struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
+ using Base = evaluate::AnyTraverse<VariableFinder>;
+ VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
+
+ using Base::operator();
+
+ template <typename T>
+ bool operator()(const evaluate::Designator<T> &x) const {
+ auto copy{x};
+ return evaluate::AsGenericExpr(std::move(copy)) == var;
+ }
+
+ template <typename T>
+ bool operator()(const evaluate::FunctionRef<T> &x) const {
+ auto copy{x};
+ return evaluate::AsGenericExpr(std::move(copy)) == var;
+ }
+
+private:
+ const SomeExpr &var;
+};
+
+std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr) {
+ return DesignatorCollector{}(expr);
+}
+
+static bool HasCommonDesignatorSymbols(
+ const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
+ // Compare the designators used in "other" with the designators whose
+ // symbols are given in baseSyms.
+ // This is a part of the check if these two expressions can access the same
+ // storage: if the designators used in them are
diff erent enough, then they
+ // will be assumed not to access the same memory.
+ //
+ // Consider an (array element) expression x%y(w%z), the corresponding symbol
+ // vector will be {x, y, w, z} (i.e. the symbols for these names).
+ // Check whether this exact sequence appears anywhere in any the symbol
+ // vector for "other". This will be true for x(y) and x(y+1), so this is
+ // not a sufficient condition, but can be used to eliminate candidates
+ // before doing more exhaustive checks.
+ //
+ // If any of the symbols in this sequence are function names, assume that
+ // there is no storage overlap, mostly because it would be impossible in
+ // general to determine what storage the function will access.
+ // Note: if f is pure, then two calls to f will access the same storage
+ // when called with the same arguments. This check is not done yet.
+
+ if (llvm::any_of(
+ baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
+ // If there is a function symbol in the chain then we can't infer much
+ // about the accessed storage.
+ return false;
+ }
+
+ auto isSubsequence{// Is u a subsequence of v.
+ [](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
+ size_t us{u.size()}, vs{v.size()};
+ if (us > vs) {
+ return false;
+ }
+ for (size_t off{0}; off != vs - us + 1; ++off) {
+ bool same{true};
+ for (size_t i{0}; i != us; ++i) {
+ if (u[i] != v[off + i]) {
+ same = false;
+ break;
+ }
+ }
+ if (same) {
+ return true;
+ }
+ }
+ return false;
+ }};
+
+ evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
+ return isSubsequence(baseSyms, otherSyms);
+}
+
+static bool HasCommonTopLevelDesignators(
+ const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
+ // Compare designators directly as expressions. This will ensure
+ // that x(y) and x(y+1) are not flagged as overlapping, whereas
+ // the symbol vectors for both of these would be identical.
+ std::vector<SomeExpr> otherDsgs{GetAllDesignators(other)};
+
+ for (auto &s : baseDsgs) {
+ if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
+ return true;
+ }
+ }
+ return false;
+}
+
+const SomeExpr *HasStorageOverlap(
+ const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
+ evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
+ std::vector<SomeExpr> baseDsgs{GetAllDesignators(base)};
+
+ for (const SomeExpr &expr : exprs) {
+ if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
+ continue;
+ }
+ if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
+ return &expr;
+ }
+ }
+ return nullptr;
+}
+
+bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
+ return VariableFinder{sub}(super);
+}
+
+// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
+// to separate cases where the source has something that looks like an
+// assignment, but is semantically wrong (diagnosed by general semantic
+// checks), and where the source has some other statement (which we want
+// to report as "should be an assignment").
+bool IsAssignment(const parser::ActionStmt *x) {
+ if (x == nullptr) {
+ return false;
+ }
+
+ using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
+ using PointerAssignmentStmt =
+ common::Indirection<parser::PointerAssignmentStmt>;
+
+ return common::visit(
+ [](auto &&s) -> bool {
+ using BareS = llvm::remove_cvref_t<decltype(s)>;
+ return std::is_same_v<BareS, AssignmentStmt> ||
+ std::is_same_v<BareS, PointerAssignmentStmt>;
+ },
+ x->u);
+}
+
+bool IsPointerAssignment(const evaluate::Assignment &x) {
+ return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
+ std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
+}
+
+/// parser::Block is a list of executable constructs, parser::BlockConstruct
+/// is Fortran's BLOCK/ENDBLOCK construct.
+/// Strip the outermost BlockConstructs, return the reference to the Block
+/// in the executable part of the innermost of the stripped constructs.
+/// Specifically, if the given `block` has a single entry (it's a list), and
+/// the entry is a BlockConstruct, get the Block contained within. Repeat
+/// this step as many times as possible.
+const parser::Block &GetInnermostExecPart(const parser::Block &block) {
+ const parser::Block *iter{&block};
+ while (iter->size() == 1) {
+ const parser::ExecutionPartConstruct &ep{iter->front()};
+ if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
+ using BlockConstruct = common::Indirection<parser::BlockConstruct>;
+ if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
+ iter = &std::get<parser::Block>(bc->value().t);
+ continue;
+ }
+ }
+ break;
+ }
+ return *iter;
+}
+
+} // namespace Fortran::semantics::omp
diff --git a/flang/lib/Semantics/openmp-utils.h b/flang/lib/Semantics/openmp-utils.h
new file mode 100644
index 0000000000000..dbb0565215357
--- /dev/null
+++ b/flang/lib/Semantics/openmp-utils.h
@@ -0,0 +1,66 @@
+//===-- lib/Semantics/openmp-utils.h --------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Common utilities used in OpenMP semantic checks.
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_OPENMP_UTILS_H
+#define FORTRAN_SEMANTICS_OPENMP_UTILS_H
+
+#include "flang/Evaluate/type.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/tools.h"
+
+#include "llvm/ADT/ArrayRef.h"
+
+#include <optional>
+#include <string>
+
+namespace Fortran::semantics {
+class SemanticsContext;
+class Symbol;
+
+// Add this namespace to avoid potential conflicts
+namespace omp {
+std::string ThisVersion(unsigned version);
+std::string TryVersion(unsigned version);
+
+const parser::Designator *GetDesignatorFromObj(const parser::OmpObject &object);
+const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object);
+const parser::ArrayElement *GetArrayElementFromObj(
+ const parser::OmpObject &object);
+const Symbol *GetObjectSymbol(const parser::OmpObject &object);
+const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument);
+std::optional<parser::CharBlock> GetObjectSource(
+ const parser::OmpObject &object);
+
+bool IsCommonBlock(const Symbol &sym);
+bool IsExtendedListItem(const Symbol &sym);
+bool IsVariableListItem(const Symbol &sym);
+bool IsVarOrFunctionRef(const MaybeExpr &expr);
+
+std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr);
+std::optional<evaluate::DynamicType> GetDynamicType(
+ const parser::Expr &parserExpr);
+
+std::optional<bool> IsContiguous(
+ SemanticsContext &semaCtx, const parser::OmpObject &object);
+
+std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr);
+const SomeExpr *HasStorageOverlap(
+ const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs);
+bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super);
+bool IsAssignment(const parser::ActionStmt *x);
+bool IsPointerAssignment(const evaluate::Assignment &x);
+const parser::Block &GetInnermostExecPart(const parser::Block &block);
+} // namespace omp
+} // namespace Fortran::semantics
+
+#endif // FORTRAN_SEMANTICS_OPENMP_UTILS_H
More information about the flang-commits
mailing list