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 +#include +#include +#include +#include +#include +#include +#include + +namespace Fortran::semantics { + +using namespace Fortran::semantics::omp; + +namespace operation = Fortran::evaluate::operation; + +template +static bool operator!=(const evaluate::Expr &e, const evaluate::Expr &f) { + return !(e == f); +} + +// There is no consistent way to get the source of a given ActionStmt, so +// extract the source information from Statement 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(&x->u)}) { + using ActionStmt = parser::Statement; + if (auto *stmt{std::get_if(&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 GetEvaluateAssignment( + const parser::ActionStmt *x) { + if (x == nullptr) { + return std::nullopt; + } + + using AssignmentStmt = common::Indirection; + using PointerAssignmentStmt = + common::Indirection; + using TypedAssignment = parser::AssignmentStmt::TypedAssignment; + + return common::visit( + [](auto &&s) -> std::optional { + using BareS = llvm::remove_cvref_t; + if constexpr (std::is_same_v || + std::is_same_v) { + const TypedAssignment &typed{s.value().typedAssignment}; + // ForwardOwningPointer typedAssignment + // `- GenericAssignmentWrapper ^.get() + // `- std::optional ^->v + return typed.get()->v; + } else { + return std::nullopt; + } + }, + x->u); +} + +static std::optional 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>> + 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>( + &action.stmt->u)}) { + const parser::IfStmt &s{ifs->value()}; + auto &&maybeCond{ + getFromLogical(std::get(s.t))}; + auto &thenStmt{ + std::get>(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(&x->u)}) { + if (auto *ifc{ + std::get_if>(&exec->u)}) { + using ElseBlock = parser::IfConstruct::ElseBlock; + using ElseIfBlock = parser::IfConstruct::ElseIfBlock; + const parser::IfConstruct &s{ifc->value()}; + + if (!std::get>(s.t).empty()) { + // Not expecting any else-if statements. + return std::nullopt; + } + auto &stmt{std::get>(s.t)}; + auto &&maybeCond{getFromLogical( + std::get(stmt.statement.t))}; + if (!maybeCond) { + return std::nullopt; + } + + if (auto &maybeElse{std::get>(s.t)}) { + AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, + GetActionStmt(std::get(s.t)), + GetActionStmt(std::get(maybeElse->t))}; + if (result.ift.stmt && result.iff.stmt) { + return result; + } + } else { + AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, + GetActionStmt(std::get(s.t)), SourcedActionStmt{}}; + if (result.ift.stmt) { + return result; + } + } + } + return std::nullopt; + } + + return std::nullopt; +} + +static std::pair 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 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 &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 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> 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 +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; + + 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> 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 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 different 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; + if constexpr (std::is_same_v) { + 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(x.t)}; + auto &block{std::get(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(x.t)}; + auto &block{std::get(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(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 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(x.t)}; + auto &dir{std::get(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 +#include +#include +#include +#include +#include + +namespace { +using namespace Fortran; + +class AssociatedLoopChecker { +public: + AssociatedLoopChecker( + semantics::SemanticsContext &context, std::int64_t level) + : context_{context}, level_{level} {} + + template bool Pre(const T &) { return true; } + template void Post(const T &) {} + + bool Pre(const parser::DoConstruct &dc) { + level_--; + const auto &doStmt{ + std::get>(dc.t)}; + const auto &constructName{ + std::get>(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::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::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 &actionstmt) { + source_ = &actionstmt.source; + return true; + } + +private: + semantics::SemanticsContext &context_; + const parser::CharBlock *source_; + std::int64_t level_; + std::map 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(x.t)}; + const auto &beginDir{std::get(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(x.t)}; + const auto &beginDir{std::get(beginLoopDir.t)}; + + auto teamsBindingChecker = [&](parser::MessageFixedText msg) { + const auto &clauseList{std::get(beginLoopDir.t)}; + for (const auto &clause : clauseList.v) { + if (const auto *bindClause{ + std::get_if(&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(c.t)}; + const auto &beginDir{ + std::get(beginBlockDir.t)}; + if (beginDir.v == llvm::omp::Directive::OMPD_ordered) { + const auto &clauses{ + std::get(beginBlockDir.t)}; + for (const auto &clause : clauses.v) { + if (std::get_if(&clause.u)) { + eligibleSIMD = true; + break; + } + } + } + }, + [&](const parser::OpenMPStandaloneConstruct &c) { + if (auto *ssc{std::get_if( + &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(c.t)}; + const auto &beginDir{ + std::get(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(x.t)}; + const auto &beginDir{std::get(beginLoopDir.t)}; + + PushContextAndClauseSets(beginDir.source, beginDir.v); + + // check matching, End directive is optional + if (const auto &endLoopDir{ + std::get>(x.t)}) { + const auto &endDir{ + std::get(endLoopDir.value().t)}; + + CheckMatching(beginDir, endDir); + + AddEndDirectiveClauses(std::get(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>(x.t); + if (optLoopCons.has_value()) { + if (const auto &doConstruct{ + std::get_if(&*optLoopCons)}) { + const auto &doBlock{std::get(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(x->GetLoopControl()->u).name.thing; +} + +void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { + auto &optLoopCons = std::get>(x.t); + if (optLoopCons.has_value()) { + if (const auto &loopConstruct{ + std::get_if(&*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>(x.t); + if (optLoopCons.has_value()) { + if (const auto &loopConstruct{ + std::get_if(&*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(loop->t)}; + const auto it{block.begin()}; + loop = it != block.end() ? parser::Unwrap(*it) + : nullptr; + } + } + } +} + +std::int64_t OmpStructureChecker::GetOrdCollapseLevel( + const parser::OpenMPLoopConstruct &x) { + const auto &beginLoopDir{std::get(x.t)}; + const auto &clauseList{std::get(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(&clause.u)}) { + if (const auto v{GetIntValue(collapseClause->v)}) { + collapseLevel = *v; + } + } + if (const auto *orderedClause{ + std::get_if(&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(x.t)}; + const auto &clauses{std::get(beginLoopDir.t)}; + + SymbolSourceMap indexVars; + + // Collect symbols of all the variables from linear clauses + for (auto &clause : clauses.v) { + if (auto *linearClause{std::get_if(&clause.u)}) { + auto &objects{std::get(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>(x.t); + if (optLoopCons.has_value()) { + if (const auto &loopConstruct{ + std::get_if(&*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(loop->t)}; + const auto it{block.begin()}; + loop = it != block.end() ? parser::Unwrap(*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(x.t)}; + const auto &clauseList{std::get(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(&clause.u)}) { + auto &modifiers{OmpGetModifiers(reductionClause->v)}; + auto *maybeModifier{OmpGetUniqueModifier(modifiers)}; + if (maybeModifier && + maybeModifier->v == ReductionModifier::Value::Inscan) { + const auto &objectList{ + std::get(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(&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(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(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()}; + 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(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()}; + 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(x.v.t)) { + context_.Say(OmpGetModifierSource(modifiers, linearMod), + "The 'modifier()' syntax is deprecated in %s, use ' : 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(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(&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 +#include +#include +#include +#include +#include +#include +#include + +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 visited; + + for (const parser::OmpTraitSetSelector &traitSet : ctx.v) { + auto &name{std::get(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 & +OmpStructureChecker::GetTraitPropertyList( + const parser::OmpTraitSelector &trait) { + static const std::list empty{}; + auto &[_, maybeProps]{trait.t}; + if (maybeProps) { + using PropertyList = std::list; + return std::get(maybeProps->t); + } else { + return empty; + } +} + +std::optional OmpStructureChecker::GetClauseFromProperty( + const parser::OmpTraitProperty &property) { + using MaybeClause = std::optional; + + // 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 &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(&x.u)}) { + return getClauseFromString(name->v); + } else if (auto *cpx{std::get_if(&x.u)}) { + return getClauseFromString( + std::get(cpx->t).v); + } + return std::nullopt; + }, + }, + property.u); +} + +void OmpStructureChecker::CheckTraitSelectorList( + const std::list &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 visited; + + for (const parser::OmpTraitSelector &trait : traits) { + auto &name{std::get(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 allowed; + bool allowsDirectiveTraits; + bool allowsExtensionTraits; + bool allowsScore; + }; + + using SName = parser::OmpTraitSetSelectorName::Value; + using TName = parser::OmpTraitSelectorName::Value; + + static const std::map 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(trait.t); + auto &maybeProps = + std::get>( + 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(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; + 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(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.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(prop.u); + }}; + invalid = !checkPropertyList(std::get(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(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(prop.u); + }}; + invalid = !checkPropertyList(std::get(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(traitName.u) || + std::holds_alternative(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.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(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; + if (!std::holds_alternative(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(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(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(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(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; + if (!std::holds_alternative(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(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; + if (!std::holds_alternative(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 +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include #include namespace Fortran::semantics { -template -static bool operator!=(const evaluate::Expr &e, const evaluate::Expr &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 &e, const evaluate::Expr &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(&object.u); -} - -static const parser::DataRef *GetDataRefFromObj( - const parser::OmpObject &object) { - if (auto *desg{GetDesignatorFromObj(object)}) { - return std::get_if(&desg->u); - } - return nullptr; -} - -static const parser::ArrayElement *GetArrayElementFromObj( - const parser::OmpObject &object) { - if (auto *dataRef{GetDataRefFromObj(object)}) { - using ElementIndirection = common::Indirection; - if (auto *ind{std::get_if(&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 GetEvaluateExpr(const parser::Expr &parserExpr) { - const parser::TypedExpr &typedExpr{parserExpr.typedExpr}; - // ForwardOwningPointer typedExpr - // `- GenericExprWrapper ^.get() - // `- std::optional ^->v - return typedExpr.get()->v; -} - -static std::optional 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 bool Pre(const T &) { return true; } - template void Post(const T &) {} - - bool Pre(const parser::DoConstruct &dc) { - level_--; - const auto &doStmt{ - std::get>(dc.t)}; - const auto &constructName{ - std::get>(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::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::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 &actionstmt) { - source_ = &actionstmt.source; - return true; - } - -private: - SemanticsContext &context_; - const parser::CharBlock *source_; - std::int64_t level_; - std::map 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() != 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 - std::optional Visit(const common::Indirection &x) { - return Visit(x.value()); - } - template - std::optional Visit(const common::Reference &x) { - return Visit(x.get()); - } - template std::optional Visit(const evaluate::Expr &x) { - return common::visit([&](auto &&s) { return Visit(s); }, x.u); - } - template - std::optional Visit(const evaluate::Designator &x) { - return common::visit( - [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u); - } - template std::optional Visit(const T &) { - // Everything else. - return std::nullopt; - } - -private: - evaluate::FoldingContext &fctx_; -}; -} // namespace - -// Return values: -// - std::optional{true} if the object is known to be contiguous -// - std::optional{false} if the object is known not to be contiguous -// - std::nullopt if the object contiguity cannot be determined -std::optional 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{true}; - }, - [&](const parser::Designator &x) { - evaluate::ExpressionAnalyzer ea{context_}; - if (MaybeExpr maybeExpr{ea.Analyze(x)}) { - return ContiguousHelper{context_}.Visit(*maybeExpr); - } - return std::optional{}; - }, - }, - 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(x.t)}; - const auto &beginDir{std::get(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(x.t)}; - const auto &beginDir{std::get(beginLoopDir.t)}; - - auto teamsBindingChecker = [&](parser::MessageFixedText msg) { - const auto &clauseList{std::get(beginLoopDir.t)}; - for (const auto &clause : clauseList.v) { - if (const auto *bindClause{ - std::get_if(&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(x.t)}; - const auto &beginDir{std::get(beginLoopDir.t)}; - - PushContextAndClauseSets(beginDir.source, beginDir.v); - - // check matching, End directive is optional - if (const auto &endLoopDir{ - std::get>(x.t)}) { - const auto &endDir{ - std::get(endLoopDir.value().t)}; - - CheckMatching(beginDir, endDir); - - AddEndDirectiveClauses(std::get(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>(x.t); - if (optLoopCons.has_value()) { - if (const auto &doConstruct{ - std::get_if(&*optLoopCons)}) { - const auto &doBlock{std::get(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(x->GetLoopControl()->u).name.thing; -} -void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { - auto &optLoopCons = std::get>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if(&*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>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if(&*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(loop->t)}; - const auto it{block.begin()}; - loop = it != block.end() ? parser::Unwrap(*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(c.t)}; - const auto &beginDir{ - std::get(beginBlockDir.t)}; - if (beginDir.v == llvm::omp::Directive::OMPD_ordered) { - const auto &clauses{ - std::get(beginBlockDir.t)}; - for (const auto &clause : clauses.v) { - if (std::get_if(&clause.u)) { - eligibleSIMD = true; - break; - } - } - } - }, - [&](const parser::OpenMPStandaloneConstruct &c) { - if (auto *ssc{std::get_if( - &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(c.t)}; - const auto &beginDir{ - std::get(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(x.t)}; - const auto &clauseList{std::get(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(&clause.u)}) { - if (const auto v{GetIntValue(collapseClause->v)}) { - collapseLevel = *v; - } - } - if (const auto *orderedClause{ - std::get_if(&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(x.t)}; - const auto &clauses{std::get(beginLoopDir.t)}; - - SymbolSourceMap indexVars; - - // Collect symbols of all the variables from linear clauses - for (auto &clause : clauses.v) { - if (auto *linearClause{std::get_if(&clause.u)}) { - auto &objects{std::get(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>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if(&*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(loop->t)}; - const auto it{block.begin()}; - loop = it != block.end() ? parser::Unwrap(*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(x.t)}; - const auto &clauseList{std::get(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(&clause.u)}) { - auto &modifiers{OmpGetModifiers(reductionClause->v)}; - auto *maybeModifier{OmpGetUniqueModifier(modifiers)}; - if (maybeModifier && - maybeModifier->v == ReductionModifier::Value::Inscan) { - const auto &objectList{ - std::get(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(&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(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(x.t)}; const auto &endBlockDir{std::get(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(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(&ep.u)}) { - using BlockConstruct = common::Indirection; - if (auto *bc{std::get_if(&exec->u)}) { - iter = &std::get(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 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(&x->u)}) { - using ActionStmt = parser::Statement; - if (auto *stmt{std::get_if(&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 GetEvaluateAssignment( - const parser::ActionStmt *x) { - if (x == nullptr) { - return std::nullopt; - } - - using AssignmentStmt = common::Indirection; - using PointerAssignmentStmt = - common::Indirection; - using TypedAssignment = parser::AssignmentStmt::TypedAssignment; - - return common::visit( - [](auto &&s) -> std::optional { - using BareS = llvm::remove_cvref_t; - if constexpr (std::is_same_v || - std::is_same_v) { - const TypedAssignment &typed{s.value().typedAssignment}; - // ForwardOwningPointer typedAssignment - // `- GenericAssignmentWrapper ^.get() - // `- std::optional ^->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; - using PointerAssignmentStmt = - common::Indirection; - - return common::visit( - [](auto &&s) -> bool { - using BareS = llvm::remove_cvref_t; - return std::is_same_v || - std::is_same_v; - }, - x->u); -} - -static std::optional 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>> - 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>( - &action.stmt->u)}) { - const parser::IfStmt &s{ifs->value()}; - auto &&maybeCond{ - getFromLogical(std::get(s.t))}; - auto &thenStmt{ - std::get>(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(&x->u)}) { - if (auto *ifc{ - std::get_if>(&exec->u)}) { - using ElseBlock = parser::IfConstruct::ElseBlock; - using ElseIfBlock = parser::IfConstruct::ElseIfBlock; - const parser::IfConstruct &s{ifc->value()}; - - if (!std::get>(s.t).empty()) { - // Not expecting any else-if statements. - return std::nullopt; - } - auto &stmt{std::get>(s.t)}; - auto &&maybeCond{getFromLogical( - std::get(stmt.statement.t))}; - if (!maybeCond) { - return std::nullopt; - } - - if (auto &maybeElse{std::get>(s.t)}) { - AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, - GetActionStmt(std::get(s.t)), - GetActionStmt(std::get(maybeElse->t))}; - if (result.ift.stmt && result.iff.stmt) { - return result; - } - } else { - AnalyzedCondStmt result{std::move(*maybeCond), stmt.source, - GetActionStmt(std::get(s.t)), SourcedActionStmt{}}; - if (result.ift.stmt) { - return result; - } - } - } - return std::nullopt; - } - - return std::nullopt; -} - -static std::pair 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, false> { - using Result = std::vector; - using Base = evaluate::Traverse; - DesignatorCollector() : Base(*this) {} - - Result Default() const { return {}; } - - using Base::operator(); - - template // - Result operator()(const evaluate::Designator &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 // - 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 { - using Base = evaluate::AnyTraverse; - VariableFinder(const SomeExpr &v) : Base(*this), var(v) {} - - using Base::operator(); - - template - bool operator()(const evaluate::Designator &x) const { - auto copy{x}; - return evaluate::AsGenericExpr(std::move(copy)) == var; - } - - template - bool operator()(const evaluate::FunctionRef &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(x.u) || - std::holds_alternative(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 different 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 &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 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 exprs) { - evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)}; - std::vector 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 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 &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> 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 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 -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; - - 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> 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 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 different 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; - if constexpr (std::is_same_v) { - 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(x.t)}; - auto &block{std::get(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(x.t)}; - auto &block{std::get(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(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 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(x.t)}; - auto &dir{std::get(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(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(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()}; - 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(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()}; - 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(x.v.t)) { - context_.Say(OmpGetModifierSource(modifiers, linearMod), - "The 'modifier()' syntax is deprecated in %s, use ' : 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(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 visited; - - for (const parser::OmpTraitSetSelector &traitSet : ctx.v) { - auto &name{std::get(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 & -OmpStructureChecker::GetTraitPropertyList( - const parser::OmpTraitSelector &trait) { - static const std::list empty{}; - auto &[_, maybeProps]{trait.t}; - if (maybeProps) { - using PropertyList = std::list; - return std::get(maybeProps->t); - } else { - return empty; - } -} - -std::optional OmpStructureChecker::GetClauseFromProperty( - const parser::OmpTraitProperty &property) { - using MaybeClause = std::optional; - - // 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 &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(&x.u)}) { - return getClauseFromString(name->v); - } else if (auto *cpx{std::get_if(&x.u)}) { - return getClauseFromString( - std::get(cpx->t).v); - } - return std::nullopt; - }, - }, - property.u); -} - -void OmpStructureChecker::CheckTraitSelectorList( - const std::list &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 visited; - - for (const parser::OmpTraitSelector &trait : traits) { - auto &name{std::get(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 allowed; - bool allowsDirectiveTraits; - bool allowsExtensionTraits; - bool allowsScore; - }; - - using SName = parser::OmpTraitSetSelectorName::Value; - using TName = parser::OmpTraitSelectorName::Value; - - static const std::map 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(trait.t); - auto &maybeProps = - std::get>( - 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(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; - 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(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.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(prop.u); - }}; - invalid = !checkPropertyList(std::get(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(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(prop.u); - }}; - invalid = !checkPropertyList(std::get(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(traitName.u) || - std::holds_alternative(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.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(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; - if (!std::holds_alternative(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(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(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(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(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; - if (!std::holds_alternative(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(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; - if (!std::holds_alternative(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(&object.u)}) { - return name->symbol ? &name->symbol->GetUltimate() : nullptr; - } else if (auto *desg{std::get_if(&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(&argument.u)}) { - if (auto *object{std::get_if(&locator->u)}) { - return GetObjectSymbol(*object); - } - } - return nullptr; -} - -std::optional OmpStructureChecker::GetObjectSource( - const parser::OmpObject &object) { - if (auto *name{std::get_if(&object.u)}) { - return name->source; - } else if (auto *desg{std::get_if(&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(&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 IsContiguous(const parser::OmpObject &object); void CheckVariableListItem(const SymbolSourceMap &symbols); void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars, const std::list &nameList, const parser::CharBlock &item, @@ -215,10 +211,6 @@ class OmpStructureChecker typename IterTy = decltype(std::declval().begin())> std::optional FindDuplicate(RangeTy &&); - const Symbol *GetObjectSymbol(const parser::OmpObject &object); - const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument); - std::optional GetObjectSource( - const parser::OmpObject &object); void CheckDependList(const parser::DataRef &); void CheckDependArraySection( const common::Indirection &, 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 +#include +#include +#include +#include +#include +#include + +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(&object.u); +} + +const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object) { + if (auto *desg{GetDesignatorFromObj(object)}) { + return std::get_if(&desg->u); + } + return nullptr; +} + +const parser::ArrayElement *GetArrayElementFromObj( + const parser::OmpObject &object) { + if (auto *dataRef{GetDataRefFromObj(object)}) { + using ElementIndirection = common::Indirection; + if (auto *ind{std::get_if(&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(&object.u)}) { + return name->symbol ? &name->symbol->GetUltimate() : nullptr; + } else if (auto *desg{std::get_if(&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(&argument.u)}) { + if (auto *object{std::get_if(&locator->u)}) { + return GetObjectSymbol(*object); + } + } + return nullptr; +} + +std::optional GetObjectSource( + const parser::OmpObject &object) { + if (auto *name{std::get_if(&object.u)}) { + return name->source; + } else if (auto *desg{std::get_if(&object.u)}) { + return GetLastName(*desg).source; + } + return std::nullopt; +} + +bool IsCommonBlock(const Symbol &sym) { + return sym.detailsIf() != 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 GetEvaluateExpr(const parser::Expr &parserExpr) { + const parser::TypedExpr &typedExpr{parserExpr.typedExpr}; + // ForwardOwningPointer typedExpr + // `- GenericExprWrapper ^.get() + // `- std::optional ^->v + return typedExpr.get()->v; +} + +std::optional 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 + std::optional Visit(const common::Indirection &x) { + return Visit(x.value()); + } + template + std::optional Visit(const common::Reference &x) { + return Visit(x.get()); + } + template std::optional Visit(const evaluate::Expr &x) { + return common::visit([&](auto &&s) { return Visit(s); }, x.u); + } + template + std::optional Visit(const evaluate::Designator &x) { + return common::visit( + [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u); + } + template std::optional Visit(const T &) { + // Everything else. + return std::nullopt; + } + +private: + evaluate::FoldingContext &fctx_; +}; +} // namespace + +// Return values: +// - std::optional{true} if the object is known to be contiguous +// - std::optional{false} if the object is known not to be contiguous +// - std::nullopt if the object contiguity cannot be determined +std::optional 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{true}; + }, + [&](const parser::Designator &x) { + evaluate::ExpressionAnalyzer ea{semaCtx}; + if (MaybeExpr maybeExpr{ea.Analyze(x)}) { + return ContiguousHelper{semaCtx}.Visit(*maybeExpr); + } + return std::optional{}; + }, + }, + object.u); +} + +struct DesignatorCollector : public evaluate::Traverse, false> { + using Result = std::vector; + using Base = evaluate::Traverse; + DesignatorCollector() : Base(*this) {} + + Result Default() const { return {}; } + + using Base::operator(); + + template // + Result operator()(const evaluate::Designator &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 // + 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 { + using Base = evaluate::AnyTraverse; + VariableFinder(const SomeExpr &v) : Base(*this), var(v) {} + + using Base::operator(); + + template + bool operator()(const evaluate::Designator &x) const { + auto copy{x}; + return evaluate::AsGenericExpr(std::move(copy)) == var; + } + + template + bool operator()(const evaluate::FunctionRef &x) const { + auto copy{x}; + return evaluate::AsGenericExpr(std::move(copy)) == var; + } + +private: + const SomeExpr &var; +}; + +std::vector 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 different 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 &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 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 exprs) { + evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)}; + std::vector 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; + using PointerAssignmentStmt = + common::Indirection; + + return common::visit( + [](auto &&s) -> bool { + using BareS = llvm::remove_cvref_t; + return std::is_same_v || + std::is_same_v; + }, + x->u); +} + +bool IsPointerAssignment(const evaluate::Assignment &x) { + return std::holds_alternative(x.u) || + std::holds_alternative(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(&ep.u)}) { + using BlockConstruct = common::Indirection; + if (auto *bc{std::get_if(&exec->u)}) { + iter = &std::get(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 +#include + +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 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 GetEvaluateExpr(const parser::Expr &parserExpr); +std::optional GetDynamicType( + const parser::Expr &parserExpr); + +std::optional IsContiguous( + SemanticsContext &semaCtx, const parser::OmpObject &object); + +std::vector GetAllDesignators(const SomeExpr &expr); +const SomeExpr *HasStorageOverlap( + const SomeExpr &base, llvm::ArrayRef 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