5607 lines · cpp
1//===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "check-omp-structure.h"10 11#include "check-directive-structure.h"12#include "definable.h"13#include "resolve-names-utils.h"14 15#include "flang/Common/idioms.h"16#include "flang/Common/indirection.h"17#include "flang/Common/visit.h"18#include "flang/Evaluate/fold.h"19#include "flang/Evaluate/tools.h"20#include "flang/Evaluate/type.h"21#include "flang/Parser/char-block.h"22#include "flang/Parser/characters.h"23#include "flang/Parser/message.h"24#include "flang/Parser/openmp-utils.h"25#include "flang/Parser/parse-tree-visitor.h"26#include "flang/Parser/parse-tree.h"27#include "flang/Parser/tools.h"28#include "flang/Semantics/expression.h"29#include "flang/Semantics/openmp-directive-sets.h"30#include "flang/Semantics/openmp-modifiers.h"31#include "flang/Semantics/openmp-utils.h"32#include "flang/Semantics/scope.h"33#include "flang/Semantics/semantics.h"34#include "flang/Semantics/symbol.h"35#include "flang/Semantics/tools.h"36#include "flang/Semantics/type.h"37#include "flang/Support/Fortran-features.h"38 39#include "llvm/ADT/ArrayRef.h"40#include "llvm/ADT/STLExtras.h"41#include "llvm/ADT/StringExtras.h"42#include "llvm/ADT/StringRef.h"43#include "llvm/Frontend/OpenMP/OMP.h"44 45#include <algorithm>46#include <cassert>47#include <cstdint>48#include <iterator>49#include <list>50#include <map>51#include <optional>52#include <set>53#include <string>54#include <tuple>55#include <type_traits>56#include <utility>57#include <variant>58 59namespace Fortran::semantics {60 61using namespace Fortran::semantics::omp;62using namespace Fortran::parser::omp;63 64OmpStructureChecker::OmpStructureChecker(SemanticsContext &context)65 : DirectiveStructureChecker(context,66#define GEN_FLANG_DIRECTIVE_CLAUSE_MAP67#include "llvm/Frontend/OpenMP/OMP.inc"68 ) {69 scopeStack_.push_back(&context.globalScope());70}71 72bool OmpStructureChecker::Enter(const parser::MainProgram &x) {73 using StatementProgramStmt = parser::Statement<parser::ProgramStmt>;74 if (auto &stmt{std::get<std::optional<StatementProgramStmt>>(x.t)}) {75 scopeStack_.push_back(stmt->statement.v.symbol->scope());76 } else {77 for (const Scope &scope : context_.globalScope().children()) {78 // There can only be one main program.79 if (scope.kind() == Scope::Kind::MainProgram) {80 scopeStack_.push_back(&scope);81 break;82 }83 }84 }85 return true;86}87 88void OmpStructureChecker::Leave(const parser::MainProgram &x) {89 scopeStack_.pop_back();90}91 92bool OmpStructureChecker::Enter(const parser::BlockData &x) {93 // The BLOCK DATA name is optional, so we need to look for the94 // corresponding scope in the global scope.95 auto &stmt{std::get<parser::Statement<parser::BlockDataStmt>>(x.t)};96 if (auto &name{stmt.statement.v}) {97 scopeStack_.push_back(name->symbol->scope());98 } else {99 for (const Scope &scope : context_.globalScope().children()) {100 if (scope.kind() == Scope::Kind::BlockData) {101 if (auto *s{scope.symbol()}; !s || s->name().empty()) {102 scopeStack_.push_back(&scope);103 break;104 }105 }106 }107 }108 return true;109}110 111void OmpStructureChecker::Leave(const parser::BlockData &x) {112 scopeStack_.pop_back();113}114 115bool OmpStructureChecker::Enter(const parser::Module &x) {116 auto &stmt{std::get<parser::Statement<parser::ModuleStmt>>(x.t)};117 const Symbol *sym{stmt.statement.v.symbol};118 scopeStack_.push_back(sym->scope());119 return true;120}121 122void OmpStructureChecker::Leave(const parser::Module &x) {123 scopeStack_.pop_back();124}125 126bool OmpStructureChecker::Enter(const parser::Submodule &x) {127 auto &stmt{std::get<parser::Statement<parser::SubmoduleStmt>>(x.t)};128 const Symbol *sym{std::get<parser::Name>(stmt.statement.t).symbol};129 scopeStack_.push_back(sym->scope());130 return true;131}132 133void OmpStructureChecker::Leave(const parser::Submodule &x) {134 scopeStack_.pop_back();135}136 137// Function/subroutine subprogram nodes don't appear in INTERFACEs, but138// the subprogram/end statements do.139bool OmpStructureChecker::Enter(const parser::SubroutineStmt &x) {140 const Symbol *sym{std::get<parser::Name>(x.t).symbol};141 scopeStack_.push_back(sym->scope());142 return true;143}144 145bool OmpStructureChecker::Enter(const parser::EndSubroutineStmt &x) {146 scopeStack_.pop_back();147 return true;148}149 150bool OmpStructureChecker::Enter(const parser::FunctionStmt &x) {151 const Symbol *sym{std::get<parser::Name>(x.t).symbol};152 scopeStack_.push_back(sym->scope());153 return true;154}155 156bool OmpStructureChecker::Enter(const parser::EndFunctionStmt &x) {157 scopeStack_.pop_back();158 return true;159}160 161bool OmpStructureChecker::Enter(const parser::BlockConstruct &x) {162 auto &specPart{std::get<parser::BlockSpecificationPart>(x.t)};163 auto &execPart{std::get<parser::Block>(x.t)};164 if (auto &&source{parser::GetSource(specPart)}) {165 scopeStack_.push_back(&context_.FindScope(*source));166 } else if (auto &&source{parser::GetSource(execPart)}) {167 scopeStack_.push_back(&context_.FindScope(*source));168 }169 return true;170}171 172void OmpStructureChecker::Leave(const parser::BlockConstruct &x) {173 auto &specPart{std::get<parser::BlockSpecificationPart>(x.t)};174 auto &execPart{std::get<parser::Block>(x.t)};175 if (auto &&source{parser::GetSource(specPart)}) {176 scopeStack_.push_back(&context_.FindScope(*source));177 } else if (auto &&source{parser::GetSource(execPart)}) {178 scopeStack_.push_back(&context_.FindScope(*source));179 }180}181 182void OmpStructureChecker::Enter(const parser::SpecificationPart &) {183 partStack_.push_back(PartKind::SpecificationPart);184}185 186void OmpStructureChecker::Leave(const parser::SpecificationPart &) {187 partStack_.pop_back();188}189 190void OmpStructureChecker::Enter(const parser::ExecutionPart &) {191 partStack_.push_back(PartKind::ExecutionPart);192}193 194void OmpStructureChecker::Leave(const parser::ExecutionPart &) {195 partStack_.pop_back();196}197 198// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment199// statements and the expressions enclosed in an OpenMP Workshare construct200class OmpWorkshareBlockChecker {201public:202 OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)203 : context_{context}, source_{source} {}204 205 template <typename T> bool Pre(const T &) { return true; }206 template <typename T> void Post(const T &) {}207 208 bool Pre(const parser::AssignmentStmt &assignment) {209 const auto &var{std::get<parser::Variable>(assignment.t)};210 const auto &expr{std::get<parser::Expr>(assignment.t)};211 const auto *lhs{GetExpr(context_, var)};212 const auto *rhs{GetExpr(context_, expr)};213 if (lhs && rhs) {214 Tristate isDefined{semantics::IsDefinedAssignment(215 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};216 if (isDefined == Tristate::Yes) {217 context_.Say(expr.source,218 "Defined assignment statement is not "219 "allowed in a WORKSHARE construct"_err_en_US);220 }221 }222 return true;223 }224 225 bool Pre(const parser::Expr &expr) {226 if (const auto *e{GetExpr(context_, expr)}) {227 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {228 const Symbol &root{GetAssociationRoot(symbol)};229 if (IsFunction(root)) {230 std::string attrs{""};231 if (!IsElementalProcedure(root)) {232 attrs = " non-ELEMENTAL";233 }234 if (root.attrs().test(Attr::IMPURE)) {235 if (attrs != "") {236 attrs = "," + attrs;237 }238 attrs = " IMPURE" + attrs;239 }240 if (attrs != "") {241 context_.Say(expr.source,242 "User defined%s function '%s' is not allowed in a "243 "WORKSHARE construct"_err_en_US,244 attrs, root.name());245 }246 }247 }248 }249 return false;250 }251 252private:253 SemanticsContext &context_;254 parser::CharBlock source_;255};256 257// 'OmpWorkdistributeBlockChecker' is used to check the validity of the258// assignment statements and the expressions enclosed in an OpenMP259// WORKDISTRIBUTE construct260class OmpWorkdistributeBlockChecker {261public:262 OmpWorkdistributeBlockChecker(263 SemanticsContext &context, parser::CharBlock source)264 : context_{context}, source_{source} {}265 266 template <typename T> bool Pre(const T &) { return true; }267 template <typename T> void Post(const T &) {}268 269 bool Pre(const parser::AssignmentStmt &assignment) {270 const auto &var{std::get<parser::Variable>(assignment.t)};271 const auto &expr{std::get<parser::Expr>(assignment.t)};272 const auto *lhs{GetExpr(context_, var)};273 const auto *rhs{GetExpr(context_, expr)};274 if (lhs && rhs) {275 Tristate isDefined{semantics::IsDefinedAssignment(276 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};277 if (isDefined == Tristate::Yes) {278 context_.Say(expr.source,279 "Defined assignment statement is not allowed in a WORKDISTRIBUTE construct"_err_en_US);280 }281 }282 return true;283 }284 285 bool Pre(const parser::Expr &expr) {286 if (const auto *e{GetExpr(context_, expr)}) {287 if (!e)288 return false;289 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {290 const Symbol &root{GetAssociationRoot(symbol)};291 if (IsFunction(root)) {292 std::vector<std::string> attrs;293 if (!IsElementalProcedure(root)) {294 attrs.push_back("non-ELEMENTAL");295 }296 if (root.attrs().test(Attr::IMPURE)) {297 attrs.push_back("IMPURE");298 }299 std::string attrsStr =300 attrs.empty() ? "" : " " + llvm::join(attrs, ", ");301 context_.Say(expr.source,302 "User defined%s function '%s' is not allowed in a WORKDISTRIBUTE construct"_err_en_US,303 attrsStr, root.name());304 }305 }306 }307 return false;308 }309 310private:311 SemanticsContext &context_;312 parser::CharBlock source_;313};314 315// `OmpUnitedTaskDesignatorChecker` is used to check if the designator316// can appear within the TASK construct317class OmpUnitedTaskDesignatorChecker {318public:319 OmpUnitedTaskDesignatorChecker(SemanticsContext &context)320 : context_{context} {}321 322 template <typename T> bool Pre(const T &) { return true; }323 template <typename T> void Post(const T &) {}324 325 bool Pre(const parser::Name &name) {326 if (name.symbol->test(Symbol::Flag::OmpThreadprivate)) {327 // OpenMP 5.2: 5.2 threadprivate directive restriction328 context_.Say(name.source,329 "A THREADPRIVATE variable `%s` cannot appear in an UNTIED TASK region"_err_en_US,330 name.source);331 }332 return true;333 }334 335private:336 SemanticsContext &context_;337};338 339bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {340 // Do not do clause checks while processing METADIRECTIVE.341 // Context selectors can contain clauses that are not given as a part342 // of a construct, but as trait properties. Testing whether they are343 // valid or not is deferred to the checks of the context selectors.344 // As it stands now, these clauses would appear as if they were present345 // on METADIRECTIVE, leading to incorrect diagnostics.346 if (GetDirectiveNest(ContextSelectorNest) > 0) {347 return true;348 }349 350 unsigned version{context_.langOptions().OpenMPVersion};351 DirectiveContext &dirCtx = GetContext();352 llvm::omp::Directive dir{dirCtx.directive};353 354 if (!llvm::omp::isAllowedClauseForDirective(dir, clause, version)) {355 unsigned allowedInVersion{[&] {356 for (unsigned v : llvm::omp::getOpenMPVersions()) {357 if (v <= version) {358 continue;359 }360 if (llvm::omp::isAllowedClauseForDirective(dir, clause, v)) {361 return v;362 }363 }364 return 0u;365 }()};366 367 // Only report it if there is a later version that allows it.368 // If it's not allowed at all, it will be reported by CheckAllowed.369 if (allowedInVersion != 0) {370 auto clauseName{parser::ToUpperCaseLetters(getClauseName(clause).str())};371 auto dirName{parser::ToUpperCaseLetters(getDirectiveName(dir).str())};372 373 context_.Say(dirCtx.clauseSource,374 "%s clause is not allowed on directive %s in %s, %s"_err_en_US,375 clauseName, dirName, ThisVersion(version),376 TryVersion(allowedInVersion));377 }378 }379 return CheckAllowed(clause);380}381 382void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {383 if (std::holds_alternative<parser::Name>(object.u) ||384 std::holds_alternative<parser::OmpObject::Invalid>(object.u)) {385 // Do not analyze common block names. The analyzer will flag an error386 // on those.387 return;388 }389 if (auto *symbol{GetObjectSymbol(object)}) {390 // Eliminate certain kinds of symbols before running the analyzer to391 // avoid confusing error messages. The analyzer assumes that the context392 // of the object use is an expression, and some diagnostics are tailored393 // to that.394 if (symbol->has<DerivedTypeDetails>() || symbol->has<MiscDetails>()) {395 // Type names, construct names, etc.396 return;397 }398 if (auto *typeSpec{symbol->GetType()}) {399 if (typeSpec->category() == DeclTypeSpec::Category::Character) {400 // Don't pass character objects to the analyzer, it can emit somewhat401 // cryptic errors (e.g. "'obj' is not an array"). Substrings are402 // checked elsewhere in OmpStructureChecker.403 return;404 }405 }406 }407 evaluate::ExpressionAnalyzer ea{context_};408 auto restore{ea.AllowWholeAssumedSizeArray(true)};409 common::visit( //410 common::visitors{411 [&](auto &&s) { ea.Analyze(s); },412 [&](const parser::OmpObject::Invalid &invalid) {},413 },414 object.u);415}416 417void OmpStructureChecker::AnalyzeObjects(const parser::OmpObjectList &objects) {418 for (const parser::OmpObject &object : objects.v) {419 AnalyzeObject(object);420 }421}422 423bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {424 // Definition of close nesting:425 //426 // `A region nested inside another region with no parallel region nested427 // between them`428 //429 // Examples:430 // non-parallel construct 1431 // non-parallel construct 2432 // parallel construct433 // construct 3434 // In the above example, construct 3 is NOT closely nested inside construct 1435 // or 2436 //437 // non-parallel construct 1438 // non-parallel construct 2439 // construct 3440 // In the above example, construct 3 is closely nested inside BOTH construct 1441 // and 2442 //443 // Algorithm:444 // Starting from the parent context, Check in a bottom-up fashion, each level445 // of the context stack. If we have a match for one of the (supplied)446 // violating directives, `close nesting` is satisfied. If no match is there in447 // the entire stack, `close nesting` is not satisfied. If at any level, a448 // `parallel` region is found, `close nesting` is not satisfied.449 450 if (CurrentDirectiveIsNested()) {451 int index = dirContext_.size() - 2;452 while (index != -1) {453 if (set.test(dirContext_[index].directive)) {454 return true;455 } else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {456 return false;457 }458 index--;459 }460 }461 return false;462}463 464bool OmpStructureChecker::IsNestedInDirective(llvm::omp::Directive directive) {465 if (dirContext_.size() >= 1) {466 for (size_t i = dirContext_.size() - 1; i > 0; --i) {467 if (dirContext_[i - 1].directive == directive) {468 return true;469 }470 }471 }472 return false;473}474 475bool OmpStructureChecker::InTargetRegion() {476 if (IsNestedInDirective(llvm::omp::Directive::OMPD_target)) {477 // Return true even for device_type(host).478 return true;479 }480 for (const Scope *scope : llvm::reverse(scopeStack_)) {481 if (const auto *symbol{scope->symbol()}) {482 if (symbol->test(Symbol::Flag::OmpDeclareTarget)) {483 return true;484 }485 }486 }487 return false;488}489 490bool OmpStructureChecker::HasRequires(llvm::omp::Clause req) {491 const Scope &unit{GetProgramUnit(*scopeStack_.back())};492 return common::visit(493 [&](const auto &details) {494 if constexpr (std::is_convertible_v<decltype(details),495 const WithOmpDeclarative &>) {496 if (auto *reqs{details.ompRequires()}) {497 return reqs->test(req);498 }499 }500 return false;501 },502 DEREF(unit.symbol()).details());503}504 505void OmpStructureChecker::CheckVariableListItem(506 const SymbolSourceMap &symbols) {507 for (auto &[symbol, source] : symbols) {508 if (!IsVariableListItem(*symbol)) {509 context_.SayWithDecl(510 *symbol, source, "'%s' must be a variable"_err_en_US, symbol->name());511 }512 }513}514 515void OmpStructureChecker::CheckDirectiveSpelling(516 parser::CharBlock spelling, llvm::omp::Directive id) {517 // Directive names that contain spaces can be spelled in the source without518 // any of the spaces. Because of that getOpenMPKind* is not guaranteed to519 // work with the source spelling as the argument.520 //521 // To verify the source spellings, we have to get the spelling for a given522 // version, remove spaces and compare it with the source spelling (also523 // with spaces removed).524 auto removeSpaces = [](llvm::StringRef s) {525 std::string n{s.str()};526 for (size_t idx{n.size()}; idx > 0; --idx) {527 if (isspace(n[idx - 1])) {528 n.erase(idx - 1, 1);529 }530 }531 return n;532 };533 534 std::string lowerNoWS{removeSpaces(535 parser::ToLowerCaseLetters({spelling.begin(), spelling.size()}))};536 llvm::StringRef ref(lowerNoWS);537 if (ref.starts_with("end")) {538 ref = ref.drop_front(3);539 }540 541 unsigned version{context_.langOptions().OpenMPVersion};542 543 // For every "future" version v, check if the check if the corresponding544 // spelling of id was introduced later than the current version. If so,545 // and if that spelling matches the source spelling, issue a warning.546 for (unsigned v : llvm::omp::getOpenMPVersions()) {547 if (v <= version) {548 continue;549 }550 llvm::StringRef name{llvm::omp::getOpenMPDirectiveName(id, v)};551 auto [kind, versions]{llvm::omp::getOpenMPDirectiveKindAndVersions(name)};552 assert(kind == id && "Directive kind mismatch");553 554 if (static_cast<int>(version) >= versions.Min) {555 continue;556 }557 if (ref == removeSpaces(name)) {558 context_.Say(spelling,559 "Directive spelling '%s' is introduced in a later OpenMP version, %s"_warn_en_US,560 parser::ToUpperCaseLetters(ref), TryVersion(versions.Min));561 break;562 }563 }564}565 566void OmpStructureChecker::CheckMultipleOccurrence(567 semantics::UnorderedSymbolSet &listVars,568 const std::list<parser::Name> &nameList, const parser::CharBlock &item,569 const std::string &clauseName) {570 for (auto const &var : nameList) {571 if (llvm::is_contained(listVars, *(var.symbol))) {572 context_.Say(item,573 "List item '%s' present at multiple %s clauses"_err_en_US,574 var.ToString(), clauseName);575 }576 listVars.insert(*(var.symbol));577 }578}579 580void OmpStructureChecker::CheckMultListItems() {581 semantics::UnorderedSymbolSet listVars;582 583 // Aligned clause584 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_aligned)) {585 const auto &alignedClause{std::get<parser::OmpClause::Aligned>(clause->u)};586 const auto &alignedList{std::get<0>(alignedClause.v.t)};587 std::list<parser::Name> alignedNameList;588 for (const auto &ompObject : alignedList.v) {589 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {590 if (name->symbol) {591 if (FindCommonBlockContaining(*(name->symbol))) {592 context_.Say(clause->source,593 "'%s' is a common block name and can not appear in an "594 "ALIGNED clause"_err_en_US,595 name->ToString());596 } else if (!(IsBuiltinCPtr(*(name->symbol)) ||597 IsAllocatableOrObjectPointer(598 &name->symbol->GetUltimate()))) {599 context_.Say(clause->source,600 "'%s' in ALIGNED clause must be of type C_PTR, POINTER or "601 "ALLOCATABLE"_err_en_US,602 name->ToString());603 } else {604 alignedNameList.push_back(*name);605 }606 } else {607 // The symbol is null, return early608 return;609 }610 }611 }612 CheckMultipleOccurrence(613 listVars, alignedNameList, clause->source, "ALIGNED");614 }615 616 // Nontemporal clause617 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_nontemporal)) {618 const auto &nontempClause{619 std::get<parser::OmpClause::Nontemporal>(clause->u)};620 const auto &nontempNameList{nontempClause.v};621 CheckMultipleOccurrence(622 listVars, nontempNameList, clause->source, "NONTEMPORAL");623 }624 625 // Linear clause626 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) {627 auto &linearClause{std::get<parser::OmpClause::Linear>(clause->u)};628 std::list<parser::Name> nameList;629 SymbolSourceMap symbols;630 GetSymbolsInObjectList(631 std::get<parser::OmpObjectList>(linearClause.v.t), symbols);632 llvm::transform(symbols, std::back_inserter(nameList), [&](auto &&pair) {633 return parser::Name{pair.second, const_cast<Symbol *>(pair.first)};634 });635 CheckMultipleOccurrence(listVars, nameList, clause->source, "LINEAR");636 }637}638 639bool OmpStructureChecker::HasInvalidWorksharingNesting(640 const parser::CharBlock &source, const OmpDirectiveSet &set) {641 // set contains all the invalid closely nested directives642 // for the given directive (`source` here)643 if (IsCloselyNestedRegion(set)) {644 context_.Say(source,645 "A worksharing region may not be closely nested inside a "646 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "647 "master region"_err_en_US);648 return true;649 }650 return false;651}652 653void OmpStructureChecker::HasInvalidTeamsNesting(654 const llvm::omp::Directive &dir, const parser::CharBlock &source) {655 if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {656 context_.Say(source,657 "Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "658 "strictly nested inside `TEAMS` region."_err_en_US);659 }660}661 662void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {663 CheckAllowedClause(llvm::omp::Clause::OMPC_hint);664 auto &dirCtx{GetContext()};665 666 if (std::optional<int64_t> maybeVal{GetIntValue(x.v.v)}) {667 int64_t val{*maybeVal};668 if (val >= 0) {669 // Check contradictory values.670 if ((val & 0xC) == 0xC || // omp_sync_hint_speculative and nonspeculative671 (val & 0x3) == 0x3) { // omp_sync_hint_contended and uncontended672 context_.Say(dirCtx.clauseSource,673 "The synchronization hint is not valid"_err_en_US);674 }675 } else {676 context_.Say(dirCtx.clauseSource,677 "Synchronization hint must be non-negative"_err_en_US);678 }679 } else {680 context_.Say(dirCtx.clauseSource,681 "Synchronization hint must be a constant integer value"_err_en_US);682 }683}684 685void OmpStructureChecker::Enter(const parser::OmpClause::DynGroupprivate &x) {686 CheckAllowedClause(llvm::omp::Clause::OMPC_dyn_groupprivate);687 parser::CharBlock source{GetContext().clauseSource};688 689 OmpVerifyModifiers(x.v, llvm::omp::OMPC_dyn_groupprivate, source, context_);690}691 692void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {693 // OmpDirectiveSpecification exists on its own only in METADIRECTIVE.694 // In other cases it's a part of other constructs that handle directive695 // context stack by themselves.696 if (GetDirectiveNest(MetadirectiveNest)) {697 PushContextAndClauseSets(698 std::get<parser::OmpDirectiveName>(x.t).source, x.DirId());699 }700}701 702void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {703 if (GetDirectiveNest(MetadirectiveNest)) {704 dirContext_.pop_back();705 }706}707 708template <typename Checker> struct DirectiveSpellingVisitor {709 using Directive = llvm::omp::Directive;710 711 DirectiveSpellingVisitor(Checker &&checker) : checker_(std::move(checker)) {}712 713 template <typename T> bool Pre(const T &) { return true; }714 template <typename T> void Post(const T &) {}715 716 template <typename... Ts>717 static const parser::OmpDirectiveName &GetDirName(718 const std::tuple<Ts...> &t) {719 return std::get<parser::OmpBeginDirective>(t).DirName();720 }721 722 bool Pre(const parser::OpenMPDispatchConstruct &x) {723 checker_(GetDirName(x.t).source, Directive::OMPD_dispatch);724 return false;725 }726 bool Pre(const parser::OpenMPAllocatorsConstruct &x) {727 checker_(GetDirName(x.t).source, Directive::OMPD_allocators);728 return false;729 }730 bool Pre(const parser::OpenMPGroupprivate &x) {731 checker_(x.v.DirName().source, Directive::OMPD_groupprivate);732 return false;733 }734 bool Pre(const parser::OmpBeginDirective &x) {735 checker_(x.DirName().source, x.DirId());736 return false;737 }738 bool Pre(const parser::OmpEndDirective &x) {739 checker_(x.DirName().source, x.DirId());740 return false;741 }742 743 bool Pre(const parser::OmpDirectiveSpecification &x) {744 auto &name = std::get<parser::OmpDirectiveName>(x.t);745 checker_(name.source, name.v);746 return false;747 }748 749private:750 Checker checker_;751};752 753template <typename T>754DirectiveSpellingVisitor(T &&) -> DirectiveSpellingVisitor<T>;755 756void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {757 DirectiveSpellingVisitor visitor(758 [this](parser::CharBlock source, llvm::omp::Directive id) {759 return CheckDirectiveSpelling(source, id);760 });761 parser::Walk(x, visitor);762 763 // Simd Construct with Ordered Construct Nesting check764 // We cannot use CurrentDirectiveIsNested() here because765 // PushContextAndClauseSets() has not been called yet, it is766 // called individually for each construct. Therefore a767 // dirContext_ size `1` means the current construct is nested768 if (dirContext_.size() >= 1) {769 if (GetDirectiveNest(SIMDNest) > 0) {770 CheckSIMDNest(x);771 }772 if (GetDirectiveNest(TargetNest) > 0) {773 CheckTargetNest(x);774 }775 }776}777 778void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {779 for (const auto &[sym, source] : deferredNonVariables_) {780 context_.SayWithDecl(781 *sym, source, "'%s' must be a variable"_err_en_US, sym->name());782 }783 deferredNonVariables_.clear();784}785 786void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {787 DirectiveSpellingVisitor visitor(788 [this](parser::CharBlock source, llvm::omp::Directive id) {789 return CheckDirectiveSpelling(source, id);790 });791 parser::Walk(x, visitor);792 793 EnterDirectiveNest(DeclarativeNest);794}795 796void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeConstruct &x) {797 ExitDirectiveNest(DeclarativeNest);798}799 800void OmpStructureChecker::AddEndDirectiveClauses(801 const parser::OmpClauseList &clauses) {802 for (const parser::OmpClause &clause : clauses.v) {803 GetContext().endDirectiveClauses.push_back(clause.Id());804 }805}806 807void OmpStructureChecker::CheckIteratorRange(808 const parser::OmpIteratorSpecifier &x) {809 // Check:810 // 1. Whether begin/end are present.811 // 2. Whether the step value is non-zero.812 // 3. If the step has a known sign, whether the lower/upper bounds form813 // a proper interval.814 const auto &[begin, end, step]{std::get<parser::SubscriptTriplet>(x.t).t};815 if (!begin || !end) {816 context_.Say(x.source,817 "The begin and end expressions in iterator range-specification are "818 "mandatory"_err_en_US);819 }820 // [5.2:67:19] In a range-specification, if the step is not specified its821 // value is implicitly defined to be 1.822 if (auto stepv{step ? GetIntValue(*step) : std::optional<int64_t>{1}}) {823 if (*stepv == 0) {824 context_.Say(825 x.source, "The step value in the iterator range is 0"_warn_en_US);826 } else if (begin && end) {827 std::optional<int64_t> beginv{GetIntValue(*begin)};828 std::optional<int64_t> endv{GetIntValue(*end)};829 if (beginv && endv) {830 if (*stepv > 0 && *beginv > *endv) {831 context_.Say(x.source,832 "The begin value is greater than the end value in iterator "833 "range-specification with a positive step"_warn_en_US);834 } else if (*stepv < 0 && *beginv < *endv) {835 context_.Say(x.source,836 "The begin value is less than the end value in iterator "837 "range-specification with a negative step"_warn_en_US);838 }839 }840 }841 }842}843 844void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {845 // Check if all iterator variables have integer type.846 for (auto &&iterSpec : x.v) {847 bool isInteger{true};848 auto &typeDecl{std::get<parser::TypeDeclarationStmt>(iterSpec.t)};849 auto &typeSpec{std::get<parser::DeclarationTypeSpec>(typeDecl.t)};850 if (!std::holds_alternative<parser::IntrinsicTypeSpec>(typeSpec.u)) {851 isInteger = false;852 } else {853 auto &intrinType{std::get<parser::IntrinsicTypeSpec>(typeSpec.u)};854 if (!std::holds_alternative<parser::IntegerTypeSpec>(intrinType.u)) {855 isInteger = false;856 }857 }858 if (!isInteger) {859 context_.Say(iterSpec.source,860 "The iterator variable must be of integer type"_err_en_US);861 }862 CheckIteratorRange(iterSpec);863 }864}865 866void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {867 // 2.12.5 Target Construct Restriction868 bool eligibleTarget{true};869 llvm::omp::Directive ineligibleTargetDir;870 parser::CharBlock source;871 common::visit(872 common::visitors{873 [&](const parser::OmpBlockConstruct &c) {874 const parser::OmpDirectiveName &beginName{c.BeginDir().DirName()};875 source = beginName.source;876 if (beginName.v == llvm::omp::Directive::OMPD_target_data) {877 eligibleTarget = false;878 ineligibleTargetDir = beginName.v;879 }880 },881 [&](const parser::OpenMPStandaloneConstruct &c) {882 common::visit(883 common::visitors{884 [&](const parser::OpenMPSimpleStandaloneConstruct &c) {885 source = c.v.DirName().source;886 switch (llvm::omp::Directive dirId{c.v.DirId()}) {887 case llvm::omp::Directive::OMPD_target_update:888 case llvm::omp::Directive::OMPD_target_enter_data:889 case llvm::omp::Directive::OMPD_target_exit_data:890 eligibleTarget = false;891 ineligibleTargetDir = dirId;892 break;893 default:894 break;895 }896 },897 [&](const auto &c) {},898 },899 c.u);900 },901 [&](const parser::OpenMPLoopConstruct &c) {902 const parser::OmpDirectiveName &beginName{c.BeginDir().DirName()};903 source = beginName.source;904 if (llvm::omp::allTargetSet.test(beginName.v)) {905 eligibleTarget = false;906 ineligibleTargetDir = beginName.v;907 }908 },909 [&](const auto &c) {},910 },911 c.u);912 if (!eligibleTarget) {913 context_.Warn(common::UsageWarning::OpenMPUsage, source,914 "If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,915 parser::ToUpperCaseLetters(916 getDirectiveName(ineligibleTargetDir).str()));917 }918}919 920void OmpStructureChecker::Enter(const parser::OmpBlockConstruct &x) {921 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};922 const std::optional<parser::OmpEndDirective> &endSpec{x.EndDir()};923 const parser::Block &block{std::get<parser::Block>(x.t)};924 925 PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirId());926 927 // Missing mandatory end block: this is checked in semantics because that928 // makes it easier to control the error messages.929 // The end block is mandatory when the construct is not applied to a strictly930 // structured block (aka it is applied to a loosely structured block).931 if (!endSpec && !IsStrictlyStructuredBlock(block)) {932 llvm::omp::Directive dirId{beginSpec.DirId()};933 auto &msg{context_.Say(beginSpec.source,934 "Expected OpenMP END %s directive"_err_en_US,935 parser::ToUpperCaseLetters(getDirectiveName(dirId)))};936 // ORDERED has two variants, so be explicit about which variant we think937 // this is.938 if (dirId == llvm::omp::Directive::OMPD_ordered) {939 msg.Attach(940 beginSpec.source, "The ORDERED directive is block-associated"_en_US);941 }942 }943 944 if (llvm::omp::allTargetSet.test(GetContext().directive)) {945 EnterDirectiveNest(TargetNest);946 }947 948 if (CurrentDirectiveIsNested()) {949 if (llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {950 HasInvalidTeamsNesting(beginSpec.DirId(), beginSpec.source);951 }952 if (GetContext().directive == llvm::omp::Directive::OMPD_master) {953 CheckMasterNesting(x);954 }955 // A teams region can only be strictly nested within the implicit parallel956 // region or a target region.957 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&958 GetContextParent().directive != llvm::omp::Directive::OMPD_target) {959 context_.Say(x.BeginDir().DirName().source,960 "%s region can only be strictly nested within the implicit parallel "961 "region or TARGET region"_err_en_US,962 ContextDirectiveAsFortran());963 }964 // If a teams construct is nested within a target construct, that target965 // construct must contain no statements, declarations or directives outside966 // of the teams construct.967 if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&968 GetContextParent().directive == llvm::omp::Directive::OMPD_target &&969 !GetDirectiveNest(TargetBlockOnlyTeams)) {970 context_.Say(GetContextParent().directiveSource,971 "TARGET construct with nested TEAMS region contains statements or "972 "directives outside of the TEAMS construct"_err_en_US);973 }974 if (GetContext().directive == llvm::omp::Directive::OMPD_workdistribute &&975 GetContextParent().directive != llvm::omp::Directive::OMPD_teams) {976 context_.Say(x.BeginDir().DirName().source,977 "%s region can only be strictly nested within TEAMS region"_err_en_US,978 ContextDirectiveAsFortran());979 }980 }981 982 CheckNoBranching(block, beginSpec.DirId(), beginSpec.source);983 984 // Target block constructs are target device constructs. Keep track of985 // whether any such construct has been visited to later check that REQUIRES986 // directives for target-related options don't appear after them.987 if (llvm::omp::allTargetSet.test(beginSpec.DirId())) {988 deviceConstructFound_ = true;989 }990 991 if (GetContext().directive == llvm::omp::Directive::OMPD_single) {992 std::set<Symbol *> singleCopyprivateSyms;993 std::set<Symbol *> endSingleCopyprivateSyms;994 bool foundNowait{false};995 parser::CharBlock NowaitSource;996 997 auto catchCopyPrivateNowaitClauses = [&](const auto &dirSpec, bool isEnd) {998 for (auto &clause : dirSpec.Clauses().v) {999 if (clause.Id() == llvm::omp::Clause::OMPC_copyprivate) {1000 for (const auto &ompObject : GetOmpObjectList(clause)->v) {1001 const auto *name{parser::Unwrap<parser::Name>(ompObject)};1002 if (Symbol * symbol{name->symbol}) {1003 if (singleCopyprivateSyms.count(symbol)) {1004 if (isEnd) {1005 context_.Warn(common::UsageWarning::OpenMPUsage, name->source,1006 "The COPYPRIVATE clause with '%s' is already used on the SINGLE directive"_warn_en_US,1007 name->ToString());1008 } else {1009 context_.Say(name->source,1010 "'%s' appears in more than one COPYPRIVATE clause on the SINGLE directive"_err_en_US,1011 name->ToString());1012 }1013 } else if (endSingleCopyprivateSyms.count(symbol)) {1014 context_.Say(name->source,1015 "'%s' appears in more than one COPYPRIVATE clause on the END SINGLE directive"_err_en_US,1016 name->ToString());1017 } else {1018 if (isEnd) {1019 endSingleCopyprivateSyms.insert(symbol);1020 } else {1021 singleCopyprivateSyms.insert(symbol);1022 }1023 }1024 }1025 }1026 } else if (clause.Id() == llvm::omp::Clause::OMPC_nowait) {1027 if (foundNowait) {1028 context_.Say(clause.source,1029 "At most one NOWAIT clause can appear on the SINGLE directive"_err_en_US);1030 } else {1031 foundNowait = !isEnd;1032 }1033 if (!NowaitSource.ToString().size()) {1034 NowaitSource = clause.source;1035 }1036 }1037 }1038 };1039 catchCopyPrivateNowaitClauses(beginSpec, false);1040 if (endSpec) {1041 catchCopyPrivateNowaitClauses(*endSpec, true);1042 }1043 unsigned version{context_.langOptions().OpenMPVersion};1044 if (version <= 52 && NowaitSource.ToString().size() &&1045 (singleCopyprivateSyms.size() || endSingleCopyprivateSyms.size())) {1046 context_.Say(NowaitSource,1047 "NOWAIT clause must not be used with COPYPRIVATE clause on the SINGLE directive"_err_en_US);1048 }1049 }1050 1051 switch (beginSpec.DirId()) {1052 case llvm::omp::Directive::OMPD_target:1053 if (CheckTargetBlockOnlyTeams(block)) {1054 EnterDirectiveNest(TargetBlockOnlyTeams);1055 }1056 break;1057 case llvm::omp::OMPD_workshare:1058 case llvm::omp::OMPD_parallel_workshare:1059 CheckWorkshareBlockStmts(block, beginSpec.source);1060 HasInvalidWorksharingNesting(1061 beginSpec.source, llvm::omp::nestedWorkshareErrSet);1062 break;1063 case llvm::omp::OMPD_workdistribute:1064 if (!CurrentDirectiveIsNested()) {1065 context_.Say(beginSpec.source,1066 "A WORKDISTRIBUTE region must be nested inside TEAMS region only."_err_en_US);1067 }1068 CheckWorkdistributeBlockStmts(block, beginSpec.source);1069 break;1070 case llvm::omp::OMPD_teams_workdistribute:1071 case llvm::omp::OMPD_target_teams_workdistribute:1072 CheckWorkdistributeBlockStmts(block, beginSpec.source);1073 break;1074 case llvm::omp::Directive::OMPD_scope:1075 case llvm::omp::Directive::OMPD_single:1076 // TODO: This check needs to be extended while implementing nesting of1077 // regions checks.1078 HasInvalidWorksharingNesting(1079 beginSpec.source, llvm::omp::nestedWorkshareErrSet);1080 break;1081 case llvm::omp::Directive::OMPD_task:1082 for (const auto &clause : beginSpec.Clauses().v) {1083 if (std::get_if<parser::OmpClause::Untied>(&clause.u)) {1084 OmpUnitedTaskDesignatorChecker check{context_};1085 parser::Walk(block, check);1086 }1087 }1088 break;1089 default:1090 break;1091 }1092}1093 1094void OmpStructureChecker::CheckMasterNesting(1095 const parser::OmpBlockConstruct &x) {1096 // A MASTER region may not be `closely nested` inside a worksharing, loop,1097 // task, taskloop, or atomic region.1098 // TODO: Expand the check to include `LOOP` construct as well when it is1099 // supported.1100 if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {1101 context_.Say(x.BeginDir().source,1102 "`MASTER` region may not be closely nested inside of `WORKSHARING`, "1103 "`LOOP`, `TASK`, `TASKLOOP`,"1104 " or `ATOMIC` region."_err_en_US);1105 }1106}1107 1108void OmpStructureChecker::Enter(const parser::OpenMPAssumeConstruct &x) {1109 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assume);1110}1111 1112void OmpStructureChecker::Leave(const parser::OpenMPAssumeConstruct &) {1113 dirContext_.pop_back();1114}1115 1116void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAssumes &x) {1117 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assumes);1118}1119 1120void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAssumes &) {1121 dirContext_.pop_back();1122}1123 1124void OmpStructureChecker::Leave(const parser::OmpBlockConstruct &x) {1125 if (GetContext().directive == llvm::omp::Directive::OMPD_taskgraph) {1126 CheckTaskgraph(x);1127 }1128 if (GetDirectiveNest(TargetBlockOnlyTeams)) {1129 ExitDirectiveNest(TargetBlockOnlyTeams);1130 }1131 if (llvm::omp::allTargetSet.test(GetContext().directive)) {1132 ExitDirectiveNest(TargetNest);1133 }1134 dirContext_.pop_back();1135}1136 1137void OmpStructureChecker::ChecksOnOrderedAsBlock() {1138 if (FindClause(llvm::omp::Clause::OMPC_depend)) {1139 context_.Say(GetContext().clauseSource,1140 "DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);1141 return;1142 }1143 1144 bool isNestedInDo{false};1145 bool isNestedInDoSIMD{false};1146 bool isNestedInSIMD{false};1147 bool noOrderedClause{false};1148 bool isOrderedClauseWithPara{false};1149 bool isCloselyNestedRegion{true};1150 if (CurrentDirectiveIsNested()) {1151 for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {1152 if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {1153 context_.Say(GetContext().directiveSource,1154 "`ORDERED` region may not be closely nested inside of `CRITICAL`, "1155 "`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);1156 break;1157 } else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {1158 isNestedInDo = true;1159 isNestedInDoSIMD =1160 llvm::omp::allDoSimdSet.test(dirContext_[i].directive);1161 if (const auto *clause{1162 FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {1163 const auto &orderedClause{1164 std::get<parser::OmpClause::Ordered>(clause->u)};1165 const auto orderedValue{GetIntValue(orderedClause.v)};1166 isOrderedClauseWithPara = orderedValue > 0;1167 } else {1168 noOrderedClause = true;1169 }1170 break;1171 } else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {1172 isNestedInSIMD = true;1173 break;1174 } else if (llvm::omp::nestedOrderedParallelErrSet.test(1175 dirContext_[i].directive)) {1176 isCloselyNestedRegion = false;1177 break;1178 }1179 }1180 }1181 1182 if (!isCloselyNestedRegion) {1183 context_.Say(GetContext().directiveSource,1184 "An ORDERED directive without the DEPEND clause must be closely nested "1185 "in a SIMD, worksharing-loop, or worksharing-loop SIMD "1186 "region"_err_en_US);1187 } else {1188 if (CurrentDirectiveIsNested() &&1189 FindClause(llvm::omp::Clause::OMPC_simd) &&1190 (!isNestedInDoSIMD && !isNestedInSIMD)) {1191 context_.Say(GetContext().directiveSource,1192 "An ORDERED directive with SIMD clause must be closely nested in a "1193 "SIMD or worksharing-loop SIMD region"_err_en_US);1194 }1195 if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {1196 context_.Say(GetContext().directiveSource,1197 "An ORDERED directive without the DEPEND clause must be closely "1198 "nested in a worksharing-loop (or worksharing-loop SIMD) region with "1199 "ORDERED clause without the parameter"_err_en_US);1200 }1201 }1202}1203 1204void OmpStructureChecker::Leave(const parser::OmpBeginDirective &) {1205 switch (GetContext().directive) {1206 case llvm::omp::Directive::OMPD_ordered:1207 // [5.1] 2.19.9 Ordered Construct Restriction1208 ChecksOnOrderedAsBlock();1209 break;1210 default:1211 break;1212 }1213}1214 1215void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {1216 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};1217 const parser::OmpDirectiveName &beginName{beginSpec.DirName()};1218 const auto &endSpec{x.EndDir()};1219 PushContextAndClauseSets(beginName.source, beginName.v);1220 1221 if (!endSpec) {1222 context_.Say(1223 beginName.source, "Expected OpenMP END SECTIONS directive"_err_en_US);1224 // Following code assumes the option is present.1225 return;1226 }1227 1228 CheckMatching<parser::OmpDirectiveName>(beginName, endSpec->DirName());1229 1230 AddEndDirectiveClauses(endSpec->Clauses());1231 1232 const auto §ionBlocks{std::get<std::list<parser::OpenMPConstruct>>(x.t)};1233 for (const parser::OpenMPConstruct &construct : sectionBlocks) {1234 auto §ion{std::get<parser::OpenMPSectionConstruct>(construct.u)};1235 CheckNoBranching(1236 std::get<parser::Block>(section.t), beginName.v, beginName.source);1237 }1238 HasInvalidWorksharingNesting(1239 beginName.source, llvm::omp::nestedWorkshareErrSet);1240}1241 1242void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {1243 dirContext_.pop_back();1244}1245 1246void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {1247 const parser::OmpDirectiveName &dirName{x.DirName()};1248 ResetPartialContext(dirName.source);1249 switch (dirName.v) {1250 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]1251 case llvm::omp::Directive::OMPD_sections:1252 PushContextAndClauseSets(1253 dirName.source, llvm::omp::Directive::OMPD_end_sections);1254 break;1255 default:1256 // no clauses are allowed1257 break;1258 }1259}1260 1261// TODO: Verify the popping of dirContext requirement after nowait1262// implementation, as there is an implicit barrier at the end of the worksharing1263// constructs unless a nowait clause is specified. Only OMPD_end_sections is1264// popped becuase it is pushed while entering the EndSectionsDirective.1265void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {1266 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {1267 dirContext_.pop_back();1268 }1269}1270 1271void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(1272 const parser::Designator &designator) {1273 auto *name{parser::Unwrap<parser::Name>(designator)};1274 // If the symbol is null, return early, CheckSymbolNames1275 // should have already reported the missing symbol as a1276 // diagnostic error1277 if (!name || !name->symbol) {1278 return;1279 }1280 1281 llvm::omp::Directive directive{GetContext().directive};1282 1283 if (name->symbol->GetUltimate().IsSubprogram()) {1284 if (directive == llvm::omp::Directive::OMPD_threadprivate)1285 context_.Say(name->source,1286 "The procedure name cannot be in a %s directive"_err_en_US,1287 ContextDirectiveAsFortran());1288 // TODO: Check for procedure name in declare target directive.1289 } else if (name->symbol->attrs().test(Attr::PARAMETER)) {1290 if (directive == llvm::omp::Directive::OMPD_threadprivate)1291 context_.Say(name->source,1292 "The entity with PARAMETER attribute cannot be in a %s directive"_err_en_US,1293 ContextDirectiveAsFortran());1294 else if (directive == llvm::omp::Directive::OMPD_declare_target)1295 context_.Warn(common::UsageWarning::OpenMPUsage, name->source,1296 "The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,1297 ContextDirectiveAsFortran());1298 } else if (FindCommonBlockContaining(*name->symbol)) {1299 context_.Say(name->source,1300 "A variable in a %s directive cannot be an element of a common block"_err_en_US,1301 ContextDirectiveAsFortran());1302 } else if (FindEquivalenceSet(*name->symbol)) {1303 context_.Say(name->source,1304 "A variable in a %s directive cannot appear in an EQUIVALENCE statement"_err_en_US,1305 ContextDirectiveAsFortran());1306 } else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&1307 directive == llvm::omp::Directive::OMPD_declare_target) {1308 context_.Say(name->source,1309 "A THREADPRIVATE variable cannot appear in a %s directive"_err_en_US,1310 ContextDirectiveAsFortran());1311 } else {1312 const semantics::Scope &useScope{1313 context_.FindScope(GetContext().directiveSource)};1314 const semantics::Scope &curScope = name->symbol->GetUltimate().owner();1315 if (!curScope.IsTopLevel()) {1316 const semantics::Scope &declScope =1317 GetProgramUnitOrBlockConstructContaining(curScope);1318 const semantics::Symbol *sym{1319 declScope.parent().FindSymbol(name->symbol->name())};1320 if (sym &&1321 (sym->has<MainProgramDetails>() || sym->has<ModuleDetails>())) {1322 context_.Say(name->source,1323 "The module name cannot be in a %s directive"_err_en_US,1324 ContextDirectiveAsFortran());1325 } else if (!IsSaved(*name->symbol) &&1326 declScope.kind() != Scope::Kind::MainProgram &&1327 declScope.kind() != Scope::Kind::Module) {1328 context_.Say(name->source,1329 "A variable that appears in a %s directive must be declared in the scope of a module or have the SAVE attribute, either explicitly or implicitly"_err_en_US,1330 ContextDirectiveAsFortran());1331 } else if (useScope != declScope) {1332 context_.Say(name->source,1333 "The %s directive and the common block or variable in it must appear in the same declaration section of a scoping unit"_err_en_US,1334 ContextDirectiveAsFortran());1335 }1336 }1337 }1338}1339 1340void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(1341 const parser::Name &name) {1342 if (!name.symbol) {1343 return;1344 }1345 1346 if (auto *cb{name.symbol->detailsIf<CommonBlockDetails>()}) {1347 for (const auto &obj : cb->objects()) {1348 if (FindEquivalenceSet(*obj)) {1349 context_.Say(name.source,1350 "A variable in a %s directive cannot appear in an EQUIVALENCE statement (variable '%s' from common block '/%s/')"_err_en_US,1351 ContextDirectiveAsFortran(), obj->name(), name.symbol->name());1352 }1353 }1354 }1355}1356 1357void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(1358 const parser::OmpObject &object) {1359 common::visit( //1360 common::visitors{1361 [&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },1362 [&](const parser::OmpObject::Invalid &invalid) {},1363 },1364 object.u);1365}1366 1367void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(1368 const parser::OmpObjectList &objList) {1369 for (const auto &ompObject : objList.v) {1370 CheckThreadprivateOrDeclareTargetVar(ompObject);1371 }1372}1373 1374void OmpStructureChecker::Enter(const parser::OpenMPGroupprivate &x) {1375 PushContextAndClauseSets(1376 x.v.DirName().source, llvm::omp::Directive::OMPD_groupprivate);1377 1378 for (const parser::OmpArgument &arg : x.v.Arguments().v) {1379 auto *locator{std::get_if<parser::OmpLocator>(&arg.u)};1380 const Symbol *sym{GetArgumentSymbol(arg)};1381 1382 if (!locator || !sym ||1383 (!IsVariableListItem(*sym) && !IsCommonBlock(*sym))) {1384 context_.Say(arg.source,1385 "GROUPPRIVATE argument should be a variable or a named common block"_err_en_US);1386 continue;1387 }1388 1389 if (sym->has<AssocEntityDetails>()) {1390 context_.SayWithDecl(*sym, arg.source,1391 "GROUPPRIVATE argument cannot be an ASSOCIATE name"_err_en_US);1392 continue;1393 }1394 if (auto *obj{sym->detailsIf<ObjectEntityDetails>()}) {1395 if (obj->IsCoarray()) {1396 context_.Say(1397 arg.source, "GROUPPRIVATE argument cannot be a coarray"_err_en_US);1398 continue;1399 }1400 if (obj->init()) {1401 context_.SayWithDecl(*sym, arg.source,1402 "GROUPPRIVATE argument cannot be declared with an initializer"_err_en_US);1403 continue;1404 }1405 }1406 if (sym->test(Symbol::Flag::InCommonBlock)) {1407 context_.Say(arg.source,1408 "GROUPPRIVATE argument cannot be a member of a common block"_err_en_US);1409 continue;1410 }1411 if (!IsCommonBlock(*sym)) {1412 const Scope &thisScope{context_.FindScope(x.v.source)};1413 if (thisScope != sym->owner()) {1414 context_.SayWithDecl(*sym, arg.source,1415 "GROUPPRIVATE argument variable must be declared in the same scope as the construct on which it appears"_err_en_US);1416 continue;1417 } else if (!thisScope.IsModule() && !sym->attrs().test(Attr::SAVE)) {1418 context_.SayWithDecl(*sym, arg.source,1419 "GROUPPRIVATE argument variable must be declared in the module scope or have SAVE attribute"_err_en_US);1420 continue;1421 }1422 }1423 }1424}1425 1426void OmpStructureChecker::Leave(const parser::OpenMPGroupprivate &x) {1427 dirContext_.pop_back();1428}1429 1430void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &x) {1431 const parser::OmpDirectiveName &dirName{x.v.DirName()};1432 PushContextAndClauseSets(dirName.source, dirName.v);1433}1434 1435void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &x) {1436 const parser::OmpDirectiveSpecification &dirSpec{x.v};1437 for (const parser::OmpArgument &arg : x.v.Arguments().v) {1438 if (auto *object{GetArgumentObject(arg)}) {1439 CheckSymbolName(dirSpec.source, *object);1440 CheckVarIsNotPartOfAnotherVar(dirSpec.source, *object);1441 CheckThreadprivateOrDeclareTargetVar(*object);1442 }1443 }1444 dirContext_.pop_back();1445}1446 1447void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {1448 const parser::OmpDirectiveName &dirName{x.v.DirName()};1449 PushContextAndClauseSets(dirName.source, dirName.v);1450 1451 const parser::OmpArgumentList &args{x.v.Arguments()};1452 if (args.v.empty()) {1453 return;1454 } else if (args.v.size() > 1) {1455 context_.Say(args.source,1456 "DECLARE_SIMD directive should have at most one argument"_err_en_US);1457 return;1458 }1459 1460 auto isValidSymbol{[](const Symbol *sym) {1461 if (IsProcedure(*sym) || IsFunction(*sym)) {1462 return true;1463 }1464 if (const Symbol *owner{GetScopingUnit(sym->owner()).symbol()}) {1465 return IsProcedure(*owner) || IsFunction(*owner);1466 }1467 return false;1468 }};1469 1470 const parser::OmpArgument &arg{args.v.front()};1471 if (auto *sym{GetArgumentSymbol(arg)}) {1472 if (!isValidSymbol(sym)) {1473 auto &msg{context_.Say(arg.source,1474 "The name '%s' should refer to a procedure"_err_en_US, sym->name())};1475 if (sym->test(Symbol::Flag::Implicit)) {1476 msg.Attach(arg.source,1477 "The name '%s' has been implicitly declared"_en_US, sym->name());1478 }1479 }1480 } else {1481 context_.Say(arg.source,1482 "The argument to the DECLARE_SIMD directive should be a procedure name"_err_en_US);1483 }1484}1485 1486void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {1487 dirContext_.pop_back();1488}1489 1490void OmpStructureChecker::Enter(const parser::OmpDeclareVariantDirective &x) {1491 const parser::OmpDirectiveName &dirName{x.v.DirName()};1492 PushContextAndClauseSets(dirName.source, dirName.v);1493 1494 const parser::OmpArgumentList &args{x.v.Arguments()};1495 if (args.v.size() != 1) {1496 context_.Say(args.source,1497 "DECLARE_VARIANT directive should have a single argument"_err_en_US);1498 return;1499 }1500 1501 auto InvalidArgument{[&](parser::CharBlock source) {1502 context_.Say(source,1503 "The argument to the DECLARE_VARIANT directive should be [base-name:]variant-name"_err_en_US);1504 }};1505 1506 auto CheckSymbol{[&](const Symbol *sym, parser::CharBlock source) {1507 if (sym) {1508 if (!IsProcedure(*sym) && !IsFunction(*sym)) {1509 auto &msg{context_.Say(source,1510 "The name '%s' should refer to a procedure"_err_en_US,1511 sym->name())};1512 if (sym->test(Symbol::Flag::Implicit)) {1513 msg.Attach(source, "The name '%s' has been implicitly declared"_en_US,1514 sym->name());1515 }1516 }1517 } else {1518 InvalidArgument(source);1519 }1520 }};1521 1522 const parser::OmpArgument &arg{args.v.front()};1523 common::visit( //1524 common::visitors{1525 [&](const parser::OmpBaseVariantNames &y) {1526 CheckSymbol(GetObjectSymbol(std::get<0>(y.t)), arg.source);1527 CheckSymbol(GetObjectSymbol(std::get<1>(y.t)), arg.source);1528 },1529 [&](const parser::OmpLocator &y) {1530 CheckSymbol(GetArgumentSymbol(arg), arg.source);1531 },1532 [&](auto &&y) { InvalidArgument(arg.source); },1533 },1534 arg.u);1535}1536 1537void OmpStructureChecker::Leave(const parser::OmpDeclareVariantDirective &) {1538 dirContext_.pop_back();1539}1540 1541void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {1542 const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};1543 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_depobj);1544 unsigned version{context_.langOptions().OpenMPVersion};1545 1546 const parser::OmpArgumentList &arguments{x.v.Arguments()};1547 const parser::OmpClauseList &clauses{x.v.Clauses()};1548 1549 // Ref: [6.0:505-506]1550 1551 if (version < 60) {1552 if (arguments.v.size() != 1) {1553 parser::CharBlock source(1554 arguments.v.empty() ? dirName.source : arguments.source);1555 context_.Say(1556 source, "The DEPOBJ directive requires a single argument"_err_en_US);1557 }1558 }1559 if (clauses.v.size() != 1) {1560 context_.Say(1561 x.source, "The DEPOBJ construct requires a single clause"_err_en_US);1562 return;1563 }1564 1565 auto &clause{clauses.v.front()};1566 1567 if (version >= 60 && arguments.v.empty()) {1568 context_.Say(x.source,1569 "DEPOBJ syntax with no argument is not handled yet"_err_en_US);1570 return;1571 }1572 1573 // [5.2:73:27-28]1574 // If the destroy clause appears on a depobj construct, destroy-var must1575 // refer to the same depend object as the depobj argument of the construct.1576 if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {1577 auto getObjSymbol{[&](const parser::OmpObject &obj) {1578 return common::visit( //1579 common::visitors{1580 [&](auto &&s) { return GetLastName(s).symbol; },1581 [&](const parser::OmpObject::Invalid &invalid) {1582 return static_cast<Symbol *>(nullptr);1583 },1584 },1585 obj.u);1586 }};1587 auto getArgSymbol{[&](const parser::OmpArgument &arg) {1588 if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {1589 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {1590 return getObjSymbol(*object);1591 }1592 }1593 return static_cast<Symbol *>(nullptr);1594 }};1595 1596 auto &wrapper{std::get<parser::OmpClause::Destroy>(clause.u)};1597 if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {1598 const Symbol *constrSym{getArgSymbol(arguments.v.front())};1599 const Symbol *clauseSym{getObjSymbol(destroy->v)};1600 if (constrSym && clauseSym && constrSym != clauseSym) {1601 context_.Say(x.source,1602 "The DESTROY clause must refer to the same object as the "1603 "DEPOBJ construct"_err_en_US);1604 }1605 }1606 }1607}1608 1609void OmpStructureChecker::Leave(const parser::OpenMPDepobjConstruct &x) {1610 dirContext_.pop_back();1611}1612 1613void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {1614 const auto &dirName{x.v.DirName()};1615 PushContextAndClauseSets(dirName.source, dirName.v);1616 unsigned version{context_.langOptions().OpenMPVersion};1617 1618 for (const parser::OmpClause &clause : x.v.Clauses().v) {1619 llvm::omp::Clause id{clause.Id()};1620 if (id == llvm::omp::Clause::OMPC_atomic_default_mem_order) {1621 if (!visitedAtomicSource_.empty()) {1622 parser::MessageFormattedText txt(1623 "REQUIRES directive with '%s' clause found lexically after atomic operation without a memory order clause"_err_en_US,1624 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(id)));1625 parser::Message message(clause.source, txt);1626 message.Attach(visitedAtomicSource_, "Previous atomic construct"_en_US);1627 context_.Say(std::move(message));1628 }1629 } else {1630 bool hasArgument{common::visit(1631 [&](auto &&s) {1632 using TypeS = llvm::remove_cvref_t<decltype(s)>;1633 if constexpr ( //1634 std::is_same_v<TypeS, parser::OmpClause::DeviceSafesync> ||1635 std::is_same_v<TypeS, parser::OmpClause::DynamicAllocators> ||1636 std::is_same_v<TypeS, parser::OmpClause::ReverseOffload> ||1637 std::is_same_v<TypeS, parser::OmpClause::SelfMaps> ||1638 std::is_same_v<TypeS, parser::OmpClause::UnifiedAddress> ||1639 std::is_same_v<TypeS, parser::OmpClause::UnifiedSharedMemory>) {1640 return s.v.has_value();1641 } else {1642 return false;1643 }1644 },1645 clause.u)};1646 if (version < 60 && hasArgument) {1647 context_.Say(clause.source,1648 "An argument to %s is an %s feature, %s"_warn_en_US,1649 parser::ToUpperCaseLetters(1650 llvm::omp::getOpenMPClauseName(clause.Id())),1651 ThisVersion(60), TryVersion(60));1652 }1653 }1654 }1655}1656 1657void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {1658 dirContext_.pop_back();1659}1660 1661static std::pair<const parser::AllocateStmt *, parser::CharBlock>1662getAllocateStmtAndSource(const parser::ExecutionPartConstruct *epc) {1663 if (SourcedActionStmt as{GetActionStmt(epc)}) {1664 using IndirectionAllocateStmt = common::Indirection<parser::AllocateStmt>;1665 if (auto *indirect{std::get_if<IndirectionAllocateStmt>(&as.stmt->u)}) {1666 return {&indirect->value(), as.source};1667 }1668 }1669 return {nullptr, ""};1670}1671 1672// Collect symbols that correspond to non-component objects on the1673// ALLOCATE statement.1674static UnorderedSymbolSet GetNonComponentSymbols(1675 const parser::AllocateStmt &stmt) {1676 UnorderedSymbolSet symbols;1677 for (auto &alloc : std::get<std::list<parser::Allocation>>(stmt.t)) {1678 auto &object{std::get<parser::AllocateObject>(alloc.t)};1679 if (auto *name{std::get_if<parser::Name>(&object.u)}) {1680 if (name->symbol) {1681 symbols.insert(name->symbol->GetUltimate());1682 }1683 }1684 }1685 return symbols;1686}1687 1688void OmpStructureChecker::CheckIndividualAllocateDirective(1689 const parser::OmpAllocateDirective &x, bool isExecutable) {1690 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};1691 const parser::OmpDirectiveName &dirName{beginSpec.DirName()};1692 1693 const Scope &thisScope{context_.FindScope(dirName.source)};1694 1695 auto maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) {1696 // Return "true" if the ALLOCATOR clause was provided with an argument1697 // that is either a prefdefined allocator, or a run-time value.1698 // Otherwise return "false".1699 if (!calloc) {1700 return false;1701 }1702 auto *allocator{std::get_if<parser::OmpClause::Allocator>(&calloc->u)};1703 if (auto val{ToInt64(GetEvaluateExpr(DEREF(allocator).v))}) {1704 // Predefined allocators (defined in OpenMP 6.0 20.8.1):1705 // omp_null_allocator = 0,1706 // omp_default_mem_alloc = 1,1707 // omp_large_cap_mem_alloc = 2,1708 // omp_const_mem_alloc = 3,1709 // omp_high_bw_mem_alloc = 4,1710 // omp_low_lat_mem_alloc = 5,1711 // omp_cgroup_mem_alloc = 6,1712 // omp_pteam_mem_alloc = 7,1713 // omp_thread_mem_alloc = 81714 return *val >= 0 && *val <= 8;1715 }1716 return true;1717 }};1718 1719 const auto *allocator{[&]() {1720 // Can't use FindClause in Enter (because clauses haven't been visited1721 // yet).1722 for (const parser::OmpClause &c : beginSpec.Clauses().v) {1723 if (c.Id() == llvm::omp::Clause::OMPC_allocator) {1724 return &c;1725 }1726 }1727 return static_cast<const parser::OmpClause *>(nullptr);1728 }()};1729 1730 if (InTargetRegion()) {1731 bool hasDynAllocators{1732 HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};1733 if (!allocator && !hasDynAllocators) {1734 context_.Say(dirName.source,1735 "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);1736 }1737 }1738 1739 auto maybePredefined{maybeHasPredefinedAllocator(allocator)};1740 1741 unsigned version{context_.langOptions().OpenMPVersion};1742 std::string condStr{version == 501743 ? "a named common block, has SAVE attribute or is declared in the "1744 "scope of a module"1745 : "a named common block or has SAVE attribute"};1746 1747 auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) {1748 if (!isExecutable) {1749 // For structure members, the scope is the derived type, which is1750 // never "this" scope. Ignore this check for members, they will be1751 // flagged anyway.1752 if (symbol.owner() != thisScope && !IsStructureComponent(symbol)) {1753 context_.Say(source,1754 "A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears"_err_en_US);1755 }1756 if (IsPointer(symbol) || IsAllocatable(symbol)) {1757 context_.Say(source,1758 "A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute"_err_en_US);1759 }1760 }1761 if (symbol.GetUltimate().has<AssocEntityDetails>()) {1762 context_.Say(source,1763 "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US);1764 }1765 bool inModule{1766 version == 50 && symbol.owner().kind() == Scope::Kind::Module};1767 if (symbol.attrs().test(Attr::SAVE) || IsCommonBlock(symbol) || inModule) {1768 if (!allocator) {1769 context_.Say(source,1770 "If a list item is %s, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US,1771 condStr);1772 } else if (!maybePredefined) {1773 context_.Say(source,1774 "If a list item is %s, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US,1775 condStr);1776 }1777 }1778 if (FindCommonBlockContaining(symbol)) {1779 context_.Say(source,1780 "A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block"_err_en_US);1781 }1782 }};1783 1784 for (const parser::OmpArgument &arg : beginSpec.Arguments().v) {1785 const parser::OmpObject *object{GetArgumentObject(arg)};1786 if (!object) {1787 context_.Say(arg.source,1788 "An argument to ALLOCATE directive must be a variable list item"_err_en_US);1789 continue;1790 }1791 1792 if (const Symbol *symbol{GetObjectSymbol(*object)}) {1793 if (!IsTypeParamInquiry(*symbol)) {1794 checkSymbol(*symbol, arg.source);1795 }1796 CheckVarIsNotPartOfAnotherVar(dirName.source, *object);1797 }1798 }1799}1800 1801void OmpStructureChecker::CheckExecutableAllocateDirective(1802 const parser::OmpAllocateDirective &x) {1803 parser::omp::OmpAllocateInfo info{SplitOmpAllocate(x)};1804 1805 auto [allocStmt, allocSource]{getAllocateStmtAndSource(info.body)};1806 if (!allocStmt) {1807 // This has been diagnosed already.1808 return;1809 }1810 1811 UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)};1812 SymbolSourceMap directiveSyms;1813 bool hasEmptyList{false};1814 1815 for (const parser::OmpAllocateDirective *ompAlloc : info.dirs) {1816 const parser::OmpDirectiveSpecification &spec{DEREF(ompAlloc).BeginDir()};1817 if (spec.Arguments().v.empty()) {1818 if (hasEmptyList && info.dirs.size() > 1) {1819 context_.Say(spec.DirName().source,1820 "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US);1821 }1822 hasEmptyList = true;1823 }1824 for (const parser::OmpArgument &arg : spec.Arguments().v) {1825 if (auto *sym{GetArgumentSymbol(arg)}) {1826 // Ignore these checks for structure members. They are not allowed1827 // in the first place, so don't tell the users that they need to1828 // be specified somewhere,1829 if (IsStructureComponent(*sym)) {1830 continue;1831 }1832 if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) {1833 parser::MessageFormattedText txt(1834 "A list item on an executable ALLOCATE may only be specified once"_err_en_US);1835 parser::Message message(arg.source, txt);1836 message.Attach(f->second, "The list item was specified here"_en_US);1837 context_.Say(std::move(message));1838 } else {1839 directiveSyms.insert(std::make_pair(sym, arg.source));1840 }1841 1842 if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) {1843 context_1844 .Say(arg.source,1845 "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US)1846 .Attach(allocSource, "The ALLOCATE statement"_en_US);1847 }1848 }1849 }1850 }1851}1852 1853void OmpStructureChecker::Enter(const parser::OmpAllocateDirective &x) {1854 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};1855 const parser::OmpDirectiveName &dirName{beginSpec.DirName()};1856 PushContextAndClauseSets(dirName.source, dirName.v);1857 ++allocateDirectiveLevel;1858 1859 bool isExecutable{partStack_.back() == PartKind::ExecutionPart};1860 1861 unsigned version{context_.langOptions().OpenMPVersion};1862 if (isExecutable && allocateDirectiveLevel == 1 && version >= 52) {1863 context_.Warn(common::UsageWarning::OpenMPUsage, dirName.source,1864 "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US);1865 }1866 1867 CheckIndividualAllocateDirective(x, isExecutable);1868 1869 if (isExecutable) {1870 auto isOmpAllocate{[](const parser::ExecutionPartConstruct &epc) {1871 if (auto *omp{GetOmp(epc)}) {1872 auto odn{GetOmpDirectiveName(*omp)};1873 return odn.v == llvm::omp::Directive::OMPD_allocate;1874 }1875 return false;1876 }};1877 1878 auto &body{std::get<parser::Block>(x.t)};1879 // The parser should put at most one statement in the body.1880 assert(body.size() <= 1 && "Multiple statements in allocate");1881 if (body.empty()) {1882 context_.Say(dirName.source,1883 "An executable ALLOCATE directive must be associated with an ALLOCATE statement"_err_en_US);1884 } else {1885 const parser::ExecutionPartConstruct &first{body.front()};1886 auto [allocStmt, _]{getAllocateStmtAndSource(&body.front())};1887 if (!isOmpAllocate(first) && !allocStmt) {1888 parser::CharBlock source{[&]() {1889 if (auto &&maybeSource{parser::GetSource(first)}) {1890 return *maybeSource;1891 }1892 return dirName.source;1893 }()};1894 context_.Say(source,1895 "The statement associated with executable ALLOCATE directive must be an ALLOCATE statement"_err_en_US);1896 }1897 }1898 }1899}1900 1901void OmpStructureChecker::Leave(const parser::OmpAllocateDirective &x) {1902 bool isExecutable{partStack_.back() == PartKind::ExecutionPart};1903 if (isExecutable && allocateDirectiveLevel == 1) {1904 CheckExecutableAllocateDirective(x);1905 }1906 1907 --allocateDirectiveLevel;1908 dirContext_.pop_back();1909}1910 1911void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {1912 CheckAllowedClause(llvm::omp::Clause::OMPC_allocator);1913 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);1914}1915 1916void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {1917 CheckAllowedClause(llvm::omp::Clause::OMPC_allocate);1918 if (OmpVerifyModifiers(1919 x.v, llvm::omp::OMPC_allocate, GetContext().clauseSource, context_)) {1920 auto &modifiers{OmpGetModifiers(x.v)};1921 if (auto *align{1922 OmpGetUniqueModifier<parser::OmpAlignModifier>(modifiers)}) {1923 if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {1924 context_.Say(OmpGetModifierSource(modifiers, align),1925 "The alignment value should be a constant positive integer"_err_en_US);1926 }1927 }1928 }1929}1930 1931void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {1932 const parser::OmpDirectiveName &dirName{x.v.DirName()};1933 PushContextAndClauseSets(dirName.source, dirName.v);1934 1935 const parser::OmpArgumentList &args{x.v.Arguments()};1936 if (args.v.size() != 1) {1937 context_.Say(args.source,1938 "DECLARE_MAPPER directive should have a single argument"_err_en_US);1939 return;1940 }1941 1942 const parser::OmpArgument &arg{args.v.front()};1943 if (auto *spec{std::get_if<parser::OmpMapperSpecifier>(&arg.u)}) {1944 const auto &type = std::get<parser::TypeSpec>(spec->t);1945 if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {1946 context_.Say(arg.source, "Type is not a derived type"_err_en_US);1947 }1948 } else {1949 context_.Say(arg.source,1950 "The argument to the DECLARE_MAPPER directive should be a mapper-specifier"_err_en_US);1951 }1952}1953 1954void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {1955 dirContext_.pop_back();1956}1957 1958void OmpStructureChecker::Enter(1959 const parser::OpenMPDeclareReductionConstruct &x) {1960 const parser::OmpDirectiveName &dirName{x.v.DirName()};1961 PushContextAndClauseSets(dirName.source, dirName.v);1962 1963 const parser::OmpArgumentList &args{x.v.Arguments()};1964 if (args.v.size() != 1) {1965 context_.Say(args.source,1966 "DECLARE_REDUCTION directive should have a single argument"_err_en_US);1967 return;1968 }1969 1970 const parser::OmpArgument &arg{args.v.front()};1971 if (!std::holds_alternative<parser::OmpReductionSpecifier>(arg.u)) {1972 context_.Say(arg.source,1973 "The argument to the DECLARE_REDUCTION directive should be a reduction-specifier"_err_en_US);1974 }1975}1976 1977void OmpStructureChecker::Leave(1978 const parser::OpenMPDeclareReductionConstruct &) {1979 dirContext_.pop_back();1980}1981 1982void OmpStructureChecker::CheckSymbolName(1983 const parser::CharBlock &source, const parser::OmpObject &object) {1984 common::visit(1985 common::visitors{1986 [&](const parser::Designator &designator) {1987 if (const auto *name{parser::Unwrap<parser::Name>(object)}) {1988 if (!name->symbol) {1989 context_.Say(source,1990 "The given %s directive clause has an invalid argument"_err_en_US,1991 ContextDirectiveAsFortran());1992 }1993 }1994 },1995 [&](const parser::Name &name) {1996 if (!name.symbol) {1997 context_.Say(source,1998 "The given %s directive clause has an invalid argument"_err_en_US,1999 ContextDirectiveAsFortran());2000 }2001 },2002 [&](const parser::OmpObject::Invalid &invalid) {},2003 },2004 object.u);2005}2006 2007void OmpStructureChecker::CheckSymbolNames(2008 const parser::CharBlock &source, const parser::OmpObjectList &objList) {2009 for (const auto &ompObject : objList.v) {2010 CheckSymbolName(source, ompObject);2011 }2012}2013 2014void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {2015 const parser::OmpDirectiveName &dirName{x.v.DirName()};2016 PushContext(dirName.source, dirName.v);2017 2018 // Check if arguments are extended-list-items.2019 for (const parser::OmpArgument &arg : x.v.Arguments().v) {2020 const Symbol *symbol{GetArgumentSymbol(arg)};2021 if (!symbol) {2022 context_.Say(arg.source,2023 "An argument to the DECLARE TARGET directive should be an extended-list-item"_err_en_US);2024 continue;2025 }2026 const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();2027 if (genericDetails) {2028 context_.Say(arg.source,2029 "The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,2030 symbol->name());2031 genericDetails->specific();2032 }2033 if (IsProcedurePointer(*symbol)) {2034 context_.Say(arg.source,2035 "The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,2036 symbol->name());2037 }2038 const SubprogramDetails *entryDetails =2039 symbol->detailsIf<SubprogramDetails>();2040 if (entryDetails && entryDetails->entryScope()) {2041 context_.Say(arg.source,2042 "The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,2043 symbol->name());2044 }2045 if (IsStmtFunction(*symbol)) {2046 context_.Say(arg.source,2047 "The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,2048 symbol->name());2049 }2050 }2051 2052 // Check if there are arguments or clauses, but not both.2053 if (!x.v.Clauses().v.empty()) {2054 if (!x.v.Arguments().v.empty()) {2055 context_.Say(x.source,2056 "DECLARE TARGET directive can have argument or clauses, but not both"_err_en_US);2057 }2058 SetClauseSets(llvm::omp::Directive::OMPD_declare_target);2059 }2060}2061 2062void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {2063 const parser::OmpDirectiveName &dirName{x.v.DirName()};2064 2065 // Handle both forms of DECLARE TARGET.2066 // - Extended list: It behaves as if there was an ENTER/TO clause with the2067 // list of objects as argument. It accepts no explicit clauses.2068 // - With clauses.2069 for (const parser::OmpArgument &arg : x.v.Arguments().v) {2070 if (auto *object{GetArgumentObject(arg)}) {2071 deviceConstructFound_ = true;2072 CheckSymbolName(dirName.source, *object);2073 CheckVarIsNotPartOfAnotherVar(dirName.source, *object);2074 CheckThreadprivateOrDeclareTargetVar(*object);2075 }2076 }2077 2078 if (!x.v.Clauses().v.empty()) {2079 const parser::OmpClause *enterClause =2080 FindClause(llvm::omp::Clause::OMPC_enter);2081 const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);2082 const parser::OmpClause *linkClause =2083 FindClause(llvm::omp::Clause::OMPC_link);2084 const parser::OmpClause *indirectClause =2085 FindClause(llvm::omp::Clause::OMPC_indirect);2086 if (!enterClause && !toClause && !linkClause) {2087 context_.Say(x.source,2088 "If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);2089 }2090 if (indirectClause && !enterClause) {2091 context_.Say(x.source,2092 "The INDIRECT clause cannot be used without the ENTER clause with the DECLARE TARGET directive."_err_en_US);2093 }2094 unsigned version{context_.langOptions().OpenMPVersion};2095 if (toClause && version >= 52) {2096 context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,2097 "The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);2098 }2099 if (indirectClause) {2100 CheckAllowedClause(llvm::omp::Clause::OMPC_indirect);2101 }2102 }2103 2104 bool toClauseFound{false}, deviceTypeClauseFound{false},2105 enterClauseFound{false};2106 for (const parser::OmpClause &clause : x.v.Clauses().v) {2107 common::visit(2108 common::visitors{2109 [&](const parser::OmpClause::To &toClause) {2110 toClauseFound = true;2111 auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)};2112 CheckSymbolNames(dirName.source, objList);2113 CheckVarIsNotPartOfAnotherVar(dirName.source, objList);2114 CheckThreadprivateOrDeclareTargetVar(objList);2115 },2116 [&](const parser::OmpClause::Link &linkClause) {2117 CheckSymbolNames(dirName.source, linkClause.v);2118 CheckVarIsNotPartOfAnotherVar(dirName.source, linkClause.v);2119 CheckThreadprivateOrDeclareTargetVar(linkClause.v);2120 },2121 [&](const parser::OmpClause::Enter &enterClause) {2122 enterClauseFound = true;2123 auto &objList{std::get<parser::OmpObjectList>(enterClause.v.t)};2124 CheckSymbolNames(dirName.source, objList);2125 CheckVarIsNotPartOfAnotherVar(dirName.source, objList);2126 CheckThreadprivateOrDeclareTargetVar(objList);2127 },2128 [&](const parser::OmpClause::DeviceType &deviceTypeClause) {2129 deviceTypeClauseFound = true;2130 if (deviceTypeClause.v.v !=2131 parser::OmpDeviceTypeClause::DeviceTypeDescription::Host) {2132 // Function / subroutine explicitly marked as runnable by the2133 // target device.2134 deviceConstructFound_ = true;2135 }2136 },2137 [&](const auto &) {},2138 },2139 clause.u);2140 2141 if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {2142 deviceConstructFound_ = true;2143 }2144 }2145 2146 dirContext_.pop_back();2147}2148 2149void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {2150 const parser::OmpDirectiveName &dirName{x.v.DirName()};2151 PushContextAndClauseSets(dirName.source, dirName.v);2152}2153 2154void OmpStructureChecker::Enter(const parser::OmpNothingDirective &x) {2155 const parser::OmpDirectiveName &dirName{x.v.DirName()};2156 PushContextAndClauseSets(dirName.source, dirName.v);2157}2158 2159void OmpStructureChecker::Leave(const parser::OmpNothingDirective &x) {2160 dirContext_.pop_back();2161}2162 2163void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {2164 const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};2165 const auto &block{std::get<parser::Block>(x.t)};2166 PushContextAndClauseSets(2167 dirSpec.DirName().source, llvm::omp::Directive::OMPD_dispatch);2168 2169 if (block.empty()) {2170 context_.Say(x.source,2171 "The DISPATCH construct should contain a single function or subroutine call"_err_en_US);2172 return;2173 }2174 2175 bool passChecks{false};2176 omp::SourcedActionStmt action{omp::GetActionStmt(block)};2177 if (const auto *assignStmt{2178 parser::Unwrap<parser::AssignmentStmt>(*action.stmt)}) {2179 if (parser::Unwrap<parser::FunctionReference>(assignStmt->t)) {2180 passChecks = true;2181 }2182 } else if (parser::Unwrap<parser::CallStmt>(*action.stmt)) {2183 passChecks = true;2184 }2185 2186 if (!passChecks) {2187 context_.Say(action.source,2188 "The body of the DISPATCH construct should be a function or a subroutine call"_err_en_US);2189 }2190}2191 2192void OmpStructureChecker::Leave(const parser::OpenMPDispatchConstruct &x) {2193 dirContext_.pop_back();2194}2195 2196void OmpStructureChecker::Leave(const parser::OmpErrorDirective &x) {2197 dirContext_.pop_back();2198}2199 2200void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {2201 CheckAllowedClause(llvm::omp::Clause::OMPC_at);2202 if (GetDirectiveNest(DeclarativeNest) > 0) {2203 if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {2204 context_.Say(GetContext().clauseSource,2205 "The ERROR directive with AT(EXECUTION) cannot appear in the specification part"_err_en_US);2206 }2207 }2208}2209 2210void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {2211 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};2212 const parser::OmpDirectiveName &dirName{beginSpec.DirName()};2213 PushContextAndClauseSets(2214 dirName.source, llvm::omp::Directive::OMPD_allocators);2215 2216 for (const auto &clause : beginSpec.Clauses().v) {2217 auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)};2218 if (!alloc) {2219 continue;2220 }2221 using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier;2222 using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier;2223 2224 if (InTargetRegion()) {2225 auto &modifiers{OmpGetModifiers(alloc->v)};2226 bool hasAllocator{2227 OmpGetUniqueModifier<OmpAllocatorSimpleModifier>(modifiers) ||2228 OmpGetUniqueModifier<OmpAllocatorComplexModifier>(modifiers)};2229 bool hasDynAllocators{2230 HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};2231 if (!hasAllocator && !hasDynAllocators) {2232 context_.Say(clause.source,2233 "An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);2234 }2235 }2236 }2237 2238 auto &body{std::get<parser::Block>(x.t)};2239 // The parser should put at most one statement in the body.2240 assert(body.size() <= 1 && "Malformed body in allocators");2241 if (body.empty()) {2242 context_.Say(dirName.source,2243 "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);2244 return;2245 }2246 2247 auto [allocStmt, allocSource]{getAllocateStmtAndSource(&body.front())};2248 if (!allocStmt) {2249 parser::CharBlock source{[&]() {2250 if (auto &&maybeSource{parser::GetSource(body.front())}) {2251 return *maybeSource;2252 }2253 return dirName.source;2254 }()};2255 context_.Say(source,2256 "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);2257 return;2258 }2259 2260 UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)};2261 for (const auto &clause : beginSpec.Clauses().v) {2262 auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)};2263 if (!alloc) {2264 continue;2265 }2266 for (auto &object : DEREF(GetOmpObjectList(clause)).v) {2267 CheckVarIsNotPartOfAnotherVar(dirName.source, object);2268 if (auto *symbol{GetObjectSymbol(object)}) {2269 if (IsStructureComponent(*symbol)) {2270 continue;2271 }2272 parser::CharBlock source{[&]() {2273 if (auto &&objectSource{GetObjectSource(object)}) {2274 return *objectSource;2275 }2276 return clause.source;2277 }()};2278 if (!IsTypeParamInquiry(*symbol)) {2279 if (auto f{allocateSyms.find(*symbol)}; f == allocateSyms.end()) {2280 context_2281 .Say(source,2282 "A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement"_err_en_US)2283 .Attach(allocSource, "The ALLOCATE statement"_en_US);2284 }2285 }2286 }2287 }2288 }2289}2290 2291void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {2292 dirContext_.pop_back();2293}2294 2295void OmpStructureChecker::CheckScan(2296 const parser::OpenMPSimpleStandaloneConstruct &x) {2297 if (x.v.Clauses().v.size() != 1) {2298 context_.Say(x.source,2299 "Exactly one of EXCLUSIVE or INCLUSIVE clause is expected"_err_en_US);2300 }2301 if (!CurrentDirectiveIsNested() ||2302 !llvm::omp::scanParentAllowedSet.test(GetContextParent().directive)) {2303 context_.Say(x.source,2304 "Orphaned SCAN directives are prohibited; perhaps you forgot "2305 "to enclose the directive in to a WORKSHARING LOOP, a WORKSHARING "2306 "LOOP SIMD or a SIMD directive."_err_en_US);2307 }2308}2309 2310void OmpStructureChecker::CheckBarrierNesting(2311 const parser::OpenMPSimpleStandaloneConstruct &x) {2312 // A barrier region may not be `closely nested` inside a worksharing, loop,2313 // task, taskloop, critical, ordered, atomic, or master region.2314 // TODO: Expand the check to include `LOOP` construct as well when it is2315 // supported.2316 if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {2317 context_.Say(x.v.DirName().source,2318 "`BARRIER` region may not be closely nested inside of `WORKSHARING`, "2319 "`LOOP`, `TASK`, `TASKLOOP`,"2320 "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);2321 }2322}2323 2324void OmpStructureChecker::ChecksOnOrderedAsStandalone() {2325 if (FindClause(llvm::omp::Clause::OMPC_threads) ||2326 FindClause(llvm::omp::Clause::OMPC_simd)) {2327 context_.Say(GetContext().clauseSource,2328 "THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);2329 }2330 2331 int dependSinkCount{0}, dependSourceCount{0};2332 bool exclusiveShown{false}, duplicateSourceShown{false};2333 2334 auto visitDoacross{[&](const parser::OmpDoacross &doa,2335 const parser::CharBlock &src) {2336 common::visit(2337 common::visitors{2338 [&](const parser::OmpDoacross::Source &) { dependSourceCount++; },2339 [&](const parser::OmpDoacross::Sink &) { dependSinkCount++; }},2340 doa.u);2341 if (!exclusiveShown && dependSinkCount > 0 && dependSourceCount > 0) {2342 exclusiveShown = true;2343 context_.Say(src,2344 "The SINK and SOURCE dependence types are mutually exclusive"_err_en_US);2345 }2346 if (!duplicateSourceShown && dependSourceCount > 1) {2347 duplicateSourceShown = true;2348 context_.Say(src,2349 "At most one SOURCE dependence type can appear on the ORDERED directive"_err_en_US);2350 }2351 }};2352 2353 // Visit the DEPEND and DOACROSS clauses.2354 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {2355 const auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};2356 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {2357 visitDoacross(*doAcross, clause->source);2358 } else {2359 context_.Say(clause->source,2360 "Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);2361 }2362 }2363 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {2364 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};2365 visitDoacross(doaClause.v.v, clause->source);2366 }2367 2368 bool isNestedInDoOrderedWithPara{false};2369 if (CurrentDirectiveIsNested() &&2370 llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {2371 if (const auto *clause{2372 FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {2373 const auto &orderedClause{2374 std::get<parser::OmpClause::Ordered>(clause->u)};2375 const auto orderedValue{GetIntValue(orderedClause.v)};2376 if (orderedValue > 0) {2377 isNestedInDoOrderedWithPara = true;2378 CheckOrderedDependClause(orderedValue);2379 }2380 }2381 }2382 2383 if (FindClause(llvm::omp::Clause::OMPC_depend) &&2384 !isNestedInDoOrderedWithPara) {2385 context_.Say(GetContext().clauseSource,2386 "An ORDERED construct with the DEPEND clause must be closely nested "2387 "in a worksharing-loop (or parallel worksharing-loop) construct with "2388 "ORDERED clause with a parameter"_err_en_US);2389 }2390}2391 2392void OmpStructureChecker::CheckOrderedDependClause(2393 std::optional<int64_t> orderedValue) {2394 auto visitDoacross{[&](const parser::OmpDoacross &doa,2395 const parser::CharBlock &src) {2396 if (auto *sinkVector{std::get_if<parser::OmpDoacross::Sink>(&doa.u)}) {2397 int64_t numVar = sinkVector->v.v.size();2398 if (orderedValue != numVar) {2399 context_.Say(src,2400 "The number of variables in the SINK iteration vector does not match the parameter specified in ORDERED clause"_err_en_US);2401 }2402 }2403 }};2404 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {2405 auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};2406 if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {2407 visitDoacross(*doAcross, clause->source);2408 }2409 }2410 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {2411 auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};2412 visitDoacross(doaClause.v.v, clause->source);2413 }2414}2415 2416void OmpStructureChecker::CheckTargetUpdate() {2417 const parser::OmpClause *toWrapper{FindClause(llvm::omp::Clause::OMPC_to)};2418 const parser::OmpClause *fromWrapper{2419 FindClause(llvm::omp::Clause::OMPC_from)};2420 if (!toWrapper && !fromWrapper) {2421 context_.Say(GetContext().directiveSource,2422 "At least one motion-clause (TO/FROM) must be specified on "2423 "TARGET UPDATE construct."_err_en_US);2424 }2425 if (toWrapper && fromWrapper) {2426 SymbolSourceMap toSymbols, fromSymbols;2427 auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v};2428 auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v};2429 GetSymbolsInObjectList(2430 std::get<parser::OmpObjectList>(fromClause.t), fromSymbols);2431 GetSymbolsInObjectList(2432 std::get<parser::OmpObjectList>(toClause.t), toSymbols);2433 2434 for (auto &[symbol, source] : toSymbols) {2435 auto fromSymbol{fromSymbols.find(symbol)};2436 if (fromSymbol != fromSymbols.end()) {2437 context_.Say(source,2438 "A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,2439 symbol->name());2440 context_.Say(source, "'%s' appears in the TO clause."_because_en_US,2441 symbol->name());2442 context_.Say(fromSymbol->second,2443 "'%s' appears in the FROM clause."_because_en_US,2444 fromSymbol->first->name());2445 }2446 }2447 }2448}2449 2450namespace {2451struct TaskgraphVisitor {2452 TaskgraphVisitor(SemanticsContext &context) : context_(context) {}2453 2454 template <typename T> bool Pre(const T &) { return true; }2455 template <typename T> void Post(const T &) {}2456 2457 bool Pre(const parser::OpenMPConstruct &x) {2458 parser::OmpDirectiveName name{GetOmpDirectiveName(x)};2459 llvm::ArrayRef<llvm::omp::Directive> leafs{getLeafConstructsOrSelf(name.v)};2460 2461 if (!IsTaskGenerating(leafs)) {2462 context_.Say(name.source,2463 "Only task-generating constructs are allowed inside TASKGRAPH region"_err_en_US);2464 // Only visit top-level constructs.2465 return false;2466 }2467 2468 const parser::OmpDirectiveSpecification &dirSpec{GetDirSpec(x)};2469 2470 // Most restrictions apply to replayable constructs. All constructs are2471 // replayable unless REPLAYABLE(false) is present.2472 bool isReplayable{IsReplayable(dirSpec)};2473 const parser::OmpClause *nogroup{nullptr};2474 2475 for (const parser::OmpClause &clause : dirSpec.Clauses().v) {2476 switch (clause.Id()) {2477 case llvm::omp::Clause::OMPC_transparent:2478 if (isReplayable) {2479 CheckTransparent(clause);2480 }2481 break;2482 case llvm::omp::Clause::OMPC_detach:2483 if (isReplayable) {2484 context_.Say(clause.source,2485 "Detachable replayable tasks are not allowed in a TASKGRAPH region"_err_en_US);2486 }2487 break;2488 case llvm::omp::Clause::OMPC_if:2489 if (isReplayable) {2490 CheckIf(clause, leafs);2491 }2492 break;2493 case llvm::omp::Clause::OMPC_nogroup:2494 nogroup = &clause;2495 break;2496 default:2497 break;2498 }2499 }2500 2501 unsigned version{context_.langOptions().OpenMPVersion};2502 bool allowsNogroup{llvm::omp::isAllowedClauseForDirective(2503 leafs[0], llvm::omp::Clause::OMPC_nogroup, version)};2504 2505 if (allowsNogroup) {2506 if (!nogroup) {2507 context_.Say(dirSpec.source,2508 "The NOGROUP clause must be specified on every construct in a TASKGRAPH region that could be enclosed in an implicit TASKGROUP"_err_en_US);2509 }2510 }2511 2512 // Only visit top-level constructs.2513 return false;2514 }2515 2516private:2517 const parser::OmpDirectiveSpecification &GetDirSpec(2518 const parser::OpenMPConstruct &x) const {2519 return common::visit(2520 common::visitors{2521 [&](const parser::OmpBlockConstruct &y)2522 -> const parser::OmpDirectiveSpecification & {2523 return y.BeginDir();2524 },2525 [&](const parser::OpenMPLoopConstruct &y)2526 -> const parser::OmpDirectiveSpecification & {2527 return y.BeginDir();2528 },2529 [&](const parser::OpenMPStandaloneConstruct &y)2530 -> const parser::OmpDirectiveSpecification & {2531 return std::get<parser::OpenMPSimpleStandaloneConstruct>(y.u).v;2532 },2533 [&](const auto &) -> const parser::OmpDirectiveSpecification & {2534 llvm_unreachable("Invalid construct");2535 },2536 },2537 x.u);2538 }2539 2540 bool IsTaskGenerating(llvm::ArrayRef<llvm::omp::Directive> leafs) const {2541 const static llvm::omp::Directive taskGen[] = {2542 llvm::omp::Directive::OMPD_target,2543 llvm::omp::Directive::OMPD_target_data,2544 llvm::omp::Directive::OMPD_target_enter_data,2545 llvm::omp::Directive::OMPD_target_exit_data,2546 llvm::omp::Directive::OMPD_target_update,2547 llvm::omp::Directive::OMPD_task,2548 llvm::omp::Directive::OMPD_taskloop,2549 };2550 return llvm::all_of(leafs,2551 [](llvm::omp::Directive d) { return llvm::is_contained(taskGen, d); });2552 }2553 2554 bool IsReplayable(const parser::OmpDirectiveSpecification &dirSpec) const {2555 for (const parser::OmpClause &clause : dirSpec.Clauses().v) {2556 if (clause.Id() != llvm::omp::Clause::OMPC_replayable) {2557 continue;2558 }2559 if (auto &repl{std::get<parser::OmpClause::Replayable>(clause.u).v}) {2560 // Scalar<Logical<Constant<indirection<Expr>>>>2561 const auto &parserExpr{parser::UnwrapRef<parser::Expr>(repl)};2562 if (auto &&expr{GetEvaluateExpr(parserExpr)}) {2563 return GetLogicalValue(*expr).value_or(true);2564 }2565 }2566 break;2567 }2568 return true;2569 }2570 2571 void CheckTransparent(const parser::OmpClause &clause) const {2572 bool isTransparent{true};2573 if (auto &transp{std::get<parser::OmpClause::Transparent>(clause.u).v}) {2574 // Scalar<Integer<indirection<Expr>>>2575 const auto &parserExpr{parser::UnwrapRef<parser::Expr>(transp)};2576 if (auto &&expr{GetEvaluateExpr(parserExpr)}) {2577 // If the argument is omp_not_impex (defined as 0), then2578 // the task is not transparent, otherwise it is.2579 const int64_t omp_not_impex{0};2580 if (auto &&val{evaluate::ToInt64(*expr)}) {2581 isTransparent = *val != omp_not_impex;2582 }2583 }2584 }2585 if (isTransparent) {2586 context_.Say(clause.source,2587 "Transparent replayable tasks are not allowed in a TASKGRAPH region"_err_en_US);2588 }2589 }2590 2591 void CheckIf(const parser::OmpClause &clause,2592 llvm::ArrayRef<llvm::omp::Directive> leafs) const {2593 // The only constructs that can generate undeferred tasks (via IF clause)2594 // are TASK and TASKLOOP.2595 if (leafs[0] != llvm::omp::Directive::OMPD_task &&2596 leafs[0] != llvm::omp::Directive::OMPD_taskloop) {2597 return;2598 }2599 2600 auto &&ifc{std::get<parser::OmpClause::If>(clause.u)};2601 // Check if there is a directive-name-modifier first.2602 auto &modifiers{OmpGetModifiers(ifc.v)};2603 if (auto *dnm{OmpGetUniqueModifier<parser::OmpDirectiveNameModifier>(2604 modifiers)}) {2605 llvm::omp::Directive sub{dnm->v};2606 auto subLeafs{llvm::omp::getLeafConstructsOrSelf(sub)};2607 // Only interested in the outermost constructs. The body of the created2608 // task is not a part of the TASKGRAPH region.2609 if (subLeafs[0] != leafs[0]) {2610 return;2611 }2612 }2613 // Scalar<Logical<indirection<Expr>>>2614 const auto &parserExpr{parser::UnwrapRef<parser::Expr>(2615 std::get<parser::ScalarLogicalExpr>(ifc.v.t))};2616 if (auto &&expr{GetEvaluateExpr(parserExpr)}) {2617 // If the value is known to be false, an undeferred task will be2618 // generated.2619 if (!GetLogicalValue(*expr).value_or(true)) {2620 context_.Say(clause.source,2621 "Undeferred replayable tasks are not allowed in a TASKGRAPH region"_err_en_US);2622 }2623 }2624 }2625 2626 SemanticsContext &context_;2627};2628} // namespace2629 2630void OmpStructureChecker::CheckTaskgraph(const parser::OmpBlockConstruct &x) {2631 const parser::Block &block{std::get<parser::Block>(x.t)};2632 2633 TaskgraphVisitor visitor{context_};2634 parser::Walk(block, visitor);2635}2636 2637void OmpStructureChecker::CheckTaskDependenceType(2638 const parser::OmpTaskDependenceType::Value &x) {2639 // Common checks for task-dependence-type (DEPEND and UPDATE clauses).2640 unsigned version{context_.langOptions().OpenMPVersion};2641 unsigned since{0};2642 2643 switch (x) {2644 case parser::OmpTaskDependenceType::Value::In:2645 case parser::OmpTaskDependenceType::Value::Out:2646 case parser::OmpTaskDependenceType::Value::Inout:2647 break;2648 case parser::OmpTaskDependenceType::Value::Mutexinoutset:2649 case parser::OmpTaskDependenceType::Value::Depobj:2650 since = 50;2651 break;2652 case parser::OmpTaskDependenceType::Value::Inoutset:2653 since = 52;2654 break;2655 }2656 2657 if (version < since) {2658 context_.Say(GetContext().clauseSource,2659 "%s task dependence type is not supported in %s, %s"_warn_en_US,2660 parser::ToUpperCaseLetters(2661 parser::OmpTaskDependenceType::EnumToString(x)),2662 ThisVersion(version), TryVersion(since));2663 }2664}2665 2666void OmpStructureChecker::CheckDependenceType(2667 const parser::OmpDependenceType::Value &x) {2668 // Common checks for dependence-type (DEPEND and UPDATE clauses).2669 unsigned version{context_.langOptions().OpenMPVersion};2670 unsigned deprecatedIn{~0u};2671 2672 switch (x) {2673 case parser::OmpDependenceType::Value::Source:2674 case parser::OmpDependenceType::Value::Sink:2675 deprecatedIn = 52;2676 break;2677 }2678 2679 if (version >= deprecatedIn) {2680 context_.Say(GetContext().clauseSource,2681 "%s dependence type is deprecated in %s"_warn_en_US,2682 parser::ToUpperCaseLetters(parser::OmpDependenceType::EnumToString(x)),2683 ThisVersion(deprecatedIn));2684 }2685}2686 2687void OmpStructureChecker::Enter(2688 const parser::OpenMPSimpleStandaloneConstruct &x) {2689 const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};2690 PushContextAndClauseSets(dir.source, dir.v);2691 switch (dir.v) {2692 case llvm::omp::Directive::OMPD_barrier:2693 CheckBarrierNesting(x);2694 break;2695 case llvm::omp::Directive::OMPD_scan:2696 CheckScan(x);2697 break;2698 default:2699 break;2700 }2701}2702 2703void OmpStructureChecker::Leave(2704 const parser::OpenMPSimpleStandaloneConstruct &x) {2705 switch (GetContext().directive) {2706 case llvm::omp::Directive::OMPD_ordered:2707 // [5.1] 2.19.9 Ordered Construct Restriction2708 ChecksOnOrderedAsStandalone();2709 break;2710 case llvm::omp::Directive::OMPD_target_update:2711 CheckTargetUpdate();2712 break;2713 default:2714 break;2715 }2716 dirContext_.pop_back();2717}2718 2719void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {2720 const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};2721 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_flush);2722}2723 2724void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {2725 auto &flushList{std::get<std::optional<parser::OmpArgumentList>>(x.v.t)};2726 2727 auto isVariableListItemOrCommonBlock{[](const Symbol &sym) {2728 return IsVariableListItem(sym) ||2729 sym.detailsIf<semantics::CommonBlockDetails>();2730 }};2731 2732 if (flushList) {2733 for (const parser::OmpArgument &arg : flushList->v) {2734 if (auto *sym{GetArgumentSymbol(arg)};2735 sym && !isVariableListItemOrCommonBlock(*sym)) {2736 context_.Say(arg.source,2737 "FLUSH argument must be a variable list item"_err_en_US);2738 }2739 }2740 2741 if (FindClause(llvm::omp::Clause::OMPC_acquire) ||2742 FindClause(llvm::omp::Clause::OMPC_release) ||2743 FindClause(llvm::omp::Clause::OMPC_acq_rel)) {2744 context_.Say(flushList->source,2745 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items must not be specified on the FLUSH directive"_err_en_US);2746 }2747 }2748 2749 unsigned version{context_.langOptions().OpenMPVersion};2750 if (version >= 52) {2751 auto &flags{std::get<parser::OmpDirectiveSpecification::Flags>(x.v.t)};2752 if (flags.test(parser::OmpDirectiveSpecification::Flag::DeprecatedSyntax)) {2753 context_.Say(x.source,2754 "The syntax \"FLUSH clause (object, ...)\" has been deprecated, use \"FLUSH(object, ...) clause\" instead"_warn_en_US);2755 }2756 }2757 2758 dirContext_.pop_back();2759}2760 2761void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {2762 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};2763 auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};2764 PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_cancel);2765 2766 if (auto maybeConstruct{GetCancelType(2767 llvm::omp::Directive::OMPD_cancel, x.source, maybeClauses)}) {2768 CheckCancellationNest(dirName.source, *maybeConstruct);2769 2770 if (CurrentDirectiveIsNested()) {2771 // nowait can be put on the end directive rather than the start directive2772 // so we need to check both2773 auto getParentClauses{[&]() {2774 const DirectiveContext &parent{GetContextParent()};2775 return llvm::concat<const llvm::omp::Clause>(2776 parent.actualClauses, parent.endDirectiveClauses);2777 }};2778 2779 if (llvm::omp::nestedCancelDoAllowedSet.test(*maybeConstruct)) {2780 for (llvm::omp::Clause clause : getParentClauses()) {2781 if (clause == llvm::omp::Clause::OMPC_nowait) {2782 context_.Say(dirName.source,2783 "The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);2784 }2785 if (clause == llvm::omp::Clause::OMPC_ordered) {2786 context_.Say(dirName.source,2787 "The CANCEL construct cannot be nested inside of a worksharing construct with the ORDERED clause"_err_en_US);2788 }2789 }2790 } else if (llvm::omp::nestedCancelSectionsAllowedSet.test(2791 *maybeConstruct)) {2792 for (llvm::omp::Clause clause : getParentClauses()) {2793 if (clause == llvm::omp::Clause::OMPC_nowait) {2794 context_.Say(dirName.source,2795 "The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);2796 }2797 }2798 }2799 }2800 }2801}2802 2803void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {2804 dirContext_.pop_back();2805}2806 2807void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {2808 const parser::OmpBeginDirective &beginSpec{x.BeginDir()};2809 const std::optional<parser::OmpEndDirective> &endSpec{x.EndDir()};2810 PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirName().v);2811 2812 const auto &block{std::get<parser::Block>(x.t)};2813 CheckNoBranching(2814 block, llvm::omp::Directive::OMPD_critical, beginSpec.DirName().source);2815 2816 auto getNameFromArg{[](const parser::OmpArgument &arg) {2817 if (auto *object{parser::Unwrap<parser::OmpObject>(arg.u)}) {2818 if (auto *designator{omp::GetDesignatorFromObj(*object)}) {2819 return parser::GetDesignatorNameIfDataRef(*designator);2820 }2821 }2822 return static_cast<const parser::Name *>(nullptr);2823 }};2824 2825 auto checkArgumentList{[&](const parser::OmpArgumentList &args) {2826 if (args.v.size() > 1) {2827 context_.Say(args.source,2828 "Only a single argument is allowed in CRITICAL directive"_err_en_US);2829 } else if (!args.v.empty()) {2830 if (!getNameFromArg(args.v.front())) {2831 context_.Say(args.v.front().source,2832 "CRITICAL argument should be a name"_err_en_US);2833 }2834 }2835 }};2836 2837 const parser::Name *beginName{nullptr};2838 const parser::Name *endName{nullptr};2839 2840 auto &beginArgs{beginSpec.Arguments()};2841 checkArgumentList(beginArgs);2842 2843 if (!beginArgs.v.empty()) {2844 beginName = getNameFromArg(beginArgs.v.front());2845 }2846 2847 if (endSpec) {2848 auto &endArgs{endSpec->Arguments()};2849 checkArgumentList(endArgs);2850 2851 if (beginArgs.v.empty() != endArgs.v.empty()) {2852 parser::CharBlock source{2853 beginArgs.v.empty() ? endArgs.source : beginArgs.source};2854 context_.Say(source,2855 "Either both CRITICAL and END CRITICAL should have an argument, or none of them should"_err_en_US);2856 } else if (!beginArgs.v.empty()) {2857 endName = getNameFromArg(endArgs.v.front());2858 if (beginName && endName) {2859 if (beginName->ToString() != endName->ToString()) {2860 context_.Say(endName->source,2861 "The names on CRITICAL and END CRITICAL must match"_err_en_US);2862 }2863 }2864 }2865 }2866 2867 for (auto &clause : beginSpec.Clauses().v) {2868 auto *hint{std::get_if<parser::OmpClause::Hint>(&clause.u)};2869 if (!hint) {2870 continue;2871 }2872 const int64_t OmpSyncHintNone = 0; // omp_sync_hint_none2873 std::optional<int64_t> hintValue{GetIntValue(hint->v.v)};2874 if (hintValue && *hintValue != OmpSyncHintNone) {2875 // Emit a diagnostic if the name is missing, and point to the directive2876 // with a missing name.2877 parser::CharBlock source;2878 if (!beginName) {2879 source = beginSpec.DirName().source;2880 } else if (endSpec && !endName) {2881 source = endSpec->DirName().source;2882 }2883 2884 if (!source.empty()) {2885 context_.Say(source,2886 "When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name"_err_en_US);2887 }2888 }2889 }2890}2891 2892void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {2893 dirContext_.pop_back();2894}2895 2896void OmpStructureChecker::Enter(2897 const parser::OmpClause::CancellationConstructType &x) {2898 llvm::omp::Directive dir{GetContext().directive};2899 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};2900 2901 if (dir != llvm::omp::Directive::OMPD_cancel &&2902 dir != llvm::omp::Directive::OMPD_cancellation_point) {2903 // Do not call CheckAllowed/CheckAllowedClause, because in case of an error2904 // it will print "CANCELLATION_CONSTRUCT_TYPE" as the clause name instead2905 // of the contained construct name.2906 context_.Say(dirName.source, "%s cannot follow %s"_err_en_US,2907 parser::ToUpperCaseLetters(getDirectiveName(dirName.v)),2908 parser::ToUpperCaseLetters(getDirectiveName(dir)));2909 } else {2910 switch (dirName.v) {2911 case llvm::omp::Directive::OMPD_do:2912 case llvm::omp::Directive::OMPD_parallel:2913 case llvm::omp::Directive::OMPD_sections:2914 case llvm::omp::Directive::OMPD_taskgroup:2915 break;2916 default:2917 context_.Say(dirName.source,2918 "%s is not a cancellable construct"_err_en_US,2919 parser::ToUpperCaseLetters(getDirectiveName(dirName.v)));2920 break;2921 }2922 }2923}2924 2925void OmpStructureChecker::Enter(2926 const parser::OpenMPCancellationPointConstruct &x) {2927 auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};2928 auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};2929 PushContextAndClauseSets(2930 dirName.source, llvm::omp::Directive::OMPD_cancellation_point);2931 2932 if (auto maybeConstruct{2933 GetCancelType(llvm::omp::Directive::OMPD_cancellation_point, x.source,2934 maybeClauses)}) {2935 CheckCancellationNest(dirName.source, *maybeConstruct);2936 }2937}2938 2939void OmpStructureChecker::Leave(2940 const parser::OpenMPCancellationPointConstruct &) {2941 dirContext_.pop_back();2942}2943 2944std::optional<llvm::omp::Directive> OmpStructureChecker::GetCancelType(2945 llvm::omp::Directive cancelDir, const parser::CharBlock &cancelSource,2946 const std::optional<parser::OmpClauseList> &maybeClauses) {2947 if (!maybeClauses) {2948 return std::nullopt;2949 }2950 // Given clauses from CANCEL or CANCELLATION_POINT, identify the construct2951 // to which the cancellation applies.2952 std::optional<llvm::omp::Directive> cancelee;2953 llvm::StringRef cancelName{getDirectiveName(cancelDir)};2954 2955 for (const parser::OmpClause &clause : maybeClauses->v) {2956 using CancellationConstructType =2957 parser::OmpClause::CancellationConstructType;2958 if (auto *cctype{std::get_if<CancellationConstructType>(&clause.u)}) {2959 if (cancelee) {2960 context_.Say(cancelSource,2961 "Multiple cancel-directive-name clauses are not allowed on the %s construct"_err_en_US,2962 parser::ToUpperCaseLetters(cancelName.str()));2963 return std::nullopt;2964 }2965 cancelee = std::get<parser::OmpDirectiveName>(cctype->v.t).v;2966 }2967 }2968 2969 if (!cancelee) {2970 context_.Say(cancelSource,2971 "Missing cancel-directive-name clause on the %s construct"_err_en_US,2972 parser::ToUpperCaseLetters(cancelName.str()));2973 return std::nullopt;2974 }2975 2976 return cancelee;2977}2978 2979void OmpStructureChecker::CheckCancellationNest(2980 const parser::CharBlock &source, llvm::omp::Directive type) {2981 llvm::StringRef typeName{getDirectiveName(type)};2982 2983 if (CurrentDirectiveIsNested()) {2984 // If construct-type-clause is taskgroup, the cancellation construct must be2985 // closely nested inside a task or a taskloop construct and the cancellation2986 // region must be closely nested inside a taskgroup region. If2987 // construct-type-clause is sections, the cancellation construct must be2988 // closely nested inside a sections or section construct. Otherwise, the2989 // cancellation construct must be closely nested inside an OpenMP construct2990 // that matches the type specified in construct-type-clause of the2991 // cancellation construct.2992 bool eligibleCancellation{false};2993 2994 switch (type) {2995 case llvm::omp::Directive::OMPD_taskgroup:2996 if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(2997 GetContextParent().directive)) {2998 eligibleCancellation = true;2999 if (dirContext_.size() >= 3) {3000 // Check if the cancellation region is closely nested inside a3001 // taskgroup region when there are more than two levels of directives3002 // in the directive context stack.3003 if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||3004 FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {3005 for (int i = dirContext_.size() - 3; i >= 0; i--) {3006 if (dirContext_[i].directive ==3007 llvm::omp::Directive::OMPD_taskgroup) {3008 break;3009 }3010 if (llvm::omp::nestedCancelParallelAllowedSet.test(3011 dirContext_[i].directive)) {3012 eligibleCancellation = false;3013 break;3014 }3015 }3016 }3017 }3018 }3019 if (!eligibleCancellation) {3020 context_.Say(source,3021 "With %s clause, %s construct must be closely nested inside TASK or TASKLOOP construct and %s region must be closely nested inside TASKGROUP region"_err_en_US,3022 parser::ToUpperCaseLetters(typeName.str()),3023 ContextDirectiveAsFortran(), ContextDirectiveAsFortran());3024 }3025 return;3026 case llvm::omp::Directive::OMPD_sections:3027 if (llvm::omp::nestedCancelSectionsAllowedSet.test(3028 GetContextParent().directive)) {3029 eligibleCancellation = true;3030 }3031 break;3032 case llvm::omp::Directive::OMPD_do:3033 if (llvm::omp::nestedCancelDoAllowedSet.test(3034 GetContextParent().directive)) {3035 eligibleCancellation = true;3036 }3037 break;3038 case llvm::omp::Directive::OMPD_parallel:3039 if (llvm::omp::nestedCancelParallelAllowedSet.test(3040 GetContextParent().directive)) {3041 eligibleCancellation = true;3042 }3043 break;3044 default:3045 // This is diagnosed later.3046 return;3047 }3048 if (!eligibleCancellation) {3049 context_.Say(source,3050 "With %s clause, %s construct cannot be closely nested inside %s construct"_err_en_US,3051 parser::ToUpperCaseLetters(typeName.str()),3052 ContextDirectiveAsFortran(),3053 parser::ToUpperCaseLetters(3054 getDirectiveName(GetContextParent().directive).str()));3055 }3056 } else {3057 // The cancellation directive cannot be orphaned.3058 switch (type) {3059 case llvm::omp::Directive::OMPD_taskgroup:3060 context_.Say(source,3061 "%s %s directive is not closely nested inside TASK or TASKLOOP"_err_en_US,3062 ContextDirectiveAsFortran(),3063 parser::ToUpperCaseLetters(typeName.str()));3064 break;3065 case llvm::omp::Directive::OMPD_sections:3066 context_.Say(source,3067 "%s %s directive is not closely nested inside SECTION or SECTIONS"_err_en_US,3068 ContextDirectiveAsFortran(),3069 parser::ToUpperCaseLetters(typeName.str()));3070 break;3071 case llvm::omp::Directive::OMPD_do:3072 context_.Say(source,3073 "%s %s directive is not closely nested inside the construct that matches the DO clause type"_err_en_US,3074 ContextDirectiveAsFortran(),3075 parser::ToUpperCaseLetters(typeName.str()));3076 break;3077 case llvm::omp::Directive::OMPD_parallel:3078 context_.Say(source,3079 "%s %s directive is not closely nested inside the construct that matches the PARALLEL clause type"_err_en_US,3080 ContextDirectiveAsFortran(),3081 parser::ToUpperCaseLetters(typeName.str()));3082 break;3083 default:3084 // This is diagnosed later.3085 return;3086 }3087 }3088}3089 3090void OmpStructureChecker::Enter(const parser::OmpEndDirective &x) {3091 parser::CharBlock source{x.DirName().source};3092 ResetPartialContext(source);3093 switch (x.DirId()) {3094 case llvm::omp::Directive::OMPD_scope:3095 PushContextAndClauseSets(source, llvm::omp::Directive::OMPD_end_scope);3096 break;3097 // 2.7.3 end-single-clause -> copyprivate-clause |3098 // nowait-clause3099 case llvm::omp::Directive::OMPD_single:3100 PushContextAndClauseSets(source, llvm::omp::Directive::OMPD_end_single);3101 break;3102 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]3103 case llvm::omp::Directive::OMPD_workshare:3104 PushContextAndClauseSets(source, llvm::omp::Directive::OMPD_end_workshare);3105 break;3106 default:3107 // no clauses are allowed3108 break;3109 }3110}3111 3112// TODO: Verify the popping of dirContext requirement after nowait3113// implementation, as there is an implicit barrier at the end of the worksharing3114// constructs unless a nowait clause is specified. Only OMPD_end_single and3115// end_workshareare popped as they are pushed while entering the3116// EndBlockDirective.3117void OmpStructureChecker::Leave(const parser::OmpEndDirective &x) {3118 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||3119 (GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||3120 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {3121 dirContext_.pop_back();3122 }3123}3124 3125// Clauses3126// Mainly categorized as3127// 1. Checks on 'OmpClauseList' from 'parse-tree.h'.3128// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.3129// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.3130 3131void OmpStructureChecker::Leave(const parser::OmpClauseList &) {3132 // 2.7.1 Loop Construct Restriction3133 if (llvm::omp::allDoSet.test(GetContext().directive)) {3134 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {3135 // only one schedule clause is allowed3136 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};3137 auto &modifiers{OmpGetModifiers(schedClause.v)};3138 auto *ordering{3139 OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};3140 if (ordering &&3141 ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {3142 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {3143 context_.Say(clause->source,3144 "The NONMONOTONIC modifier cannot be specified "3145 "if an ORDERED clause is specified"_err_en_US);3146 }3147 }3148 }3149 3150 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {3151 // only one ordered clause is allowed3152 const auto &orderedClause{3153 std::get<parser::OmpClause::Ordered>(clause->u)};3154 3155 if (orderedClause.v) {3156 CheckNotAllowedIfClause(3157 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});3158 3159 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {3160 const auto &collapseClause{3161 std::get<parser::OmpClause::Collapse>(clause2->u)};3162 // ordered and collapse both have parameters3163 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {3164 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {3165 if (*orderedValue > 0 && *orderedValue < *collapseValue) {3166 context_.Say(clause->source,3167 "The parameter of the ORDERED clause must be "3168 "greater than or equal to "3169 "the parameter of the COLLAPSE clause"_err_en_US);3170 }3171 }3172 }3173 }3174 }3175 3176 // TODO: ordered region binding check (requires nesting implementation)3177 }3178 } // doSet3179 3180 // 2.8.1 Simd Construct Restriction3181 if (llvm::omp::allSimdSet.test(GetContext().directive)) {3182 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {3183 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {3184 const auto &simdlenClause{3185 std::get<parser::OmpClause::Simdlen>(clause->u)};3186 const auto &safelenClause{3187 std::get<parser::OmpClause::Safelen>(clause2->u)};3188 // simdlen and safelen both have parameters3189 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {3190 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {3191 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {3192 context_.Say(clause->source,3193 "The parameter of the SIMDLEN clause must be less than or "3194 "equal to the parameter of the SAFELEN clause"_err_en_US);3195 }3196 }3197 }3198 }3199 }3200 3201 // 2.11.5 Simd construct restriction (OpenMP 5.1)3202 if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) {3203 if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) {3204 const auto &orderClause{3205 std::get<parser::OmpClause::Order>(o_clause->u)};3206 if (std::get<parser::OmpOrderClause::Ordering>(orderClause.v.t) ==3207 parser::OmpOrderClause::Ordering::Concurrent) {3208 context_.Say(sl_clause->source,3209 "The `SAFELEN` clause cannot appear in the `SIMD` directive "3210 "with `ORDER(CONCURRENT)` clause"_err_en_US);3211 }3212 }3213 }3214 } // SIMD3215 3216 // Semantic checks related to presence of multiple list items within the same3217 // clause3218 CheckMultListItems();3219 3220 if (GetContext().directive == llvm::omp::Directive::OMPD_task) {3221 if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) {3222 unsigned version{context_.langOptions().OpenMPVersion};3223 if (version == 50 || version == 51) {3224 // OpenMP 5.0: 2.10.1 Task construct restrictions3225 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_detach,3226 {llvm::omp::Clause::OMPC_mergeable});3227 } else if (version >= 52) {3228 // OpenMP 5.2: 12.5.2 Detach construct restrictions3229 if (FindClause(llvm::omp::Clause::OMPC_final)) {3230 context_.Say(GetContext().clauseSource,3231 "If a DETACH clause appears on a directive, then the encountering task must not be a FINAL task"_err_en_US);3232 }3233 3234 const auto &detach{3235 std::get<parser::OmpClause::Detach>(detachClause->u)};3236 if (const auto *name{parser::Unwrap<parser::Name>(detach.v.v)}) {3237 Symbol *eventHandleSym{name->symbol};3238 auto checkVarAppearsInDataEnvClause = [&](const parser::OmpObjectList3239 &objs,3240 std::string clause) {3241 for (const auto &obj : objs.v) {3242 if (const parser::Name *objName{3243 parser::Unwrap<parser::Name>(obj)}) {3244 if (&objName->symbol->GetUltimate() == eventHandleSym) {3245 context_.Say(GetContext().clauseSource,3246 "A variable: `%s` that appears in a DETACH clause cannot appear on %s clause on the same construct"_err_en_US,3247 objName->source, clause);3248 }3249 }3250 }3251 };3252 if (auto *dataEnvClause{3253 FindClause(llvm::omp::Clause::OMPC_private)}) {3254 const auto &pClause{3255 std::get<parser::OmpClause::Private>(dataEnvClause->u)};3256 checkVarAppearsInDataEnvClause(pClause.v, "PRIVATE");3257 } else if (auto *dataEnvClause{3258 FindClause(llvm::omp::Clause::OMPC_shared)}) {3259 const auto &sClause{3260 std::get<parser::OmpClause::Shared>(dataEnvClause->u)};3261 checkVarAppearsInDataEnvClause(sClause.v, "SHARED");3262 } else if (auto *dataEnvClause{3263 FindClause(llvm::omp::Clause::OMPC_firstprivate)}) {3264 const auto &fpClause{3265 std::get<parser::OmpClause::Firstprivate>(dataEnvClause->u)};3266 checkVarAppearsInDataEnvClause(fpClause.v, "FIRSTPRIVATE");3267 } else if (auto *dataEnvClause{3268 FindClause(llvm::omp::Clause::OMPC_in_reduction)}) {3269 const auto &irClause{3270 std::get<parser::OmpClause::InReduction>(dataEnvClause->u)};3271 checkVarAppearsInDataEnvClause(3272 std::get<parser::OmpObjectList>(irClause.v.t), "IN_REDUCTION");3273 }3274 }3275 }3276 }3277 }3278 3279 auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,3280 llvmOmpClause clauseTy) {3281 if (sym.test(Symbol::Flag::OmpThreadprivate))3282 context_.Say(name.source,3283 "A THREADPRIVATE variable cannot be in %s clause"_err_en_US,3284 parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));3285 };3286 3287 // [5.1] 2.21.2 Threadprivate Directive Restriction3288 OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,3289 llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,3290 llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,3291 llvm::omp::Clause::OMPC_if};3292 for (auto it : GetContext().clauseInfo) {3293 llvmOmpClause type = it.first;3294 const auto *clause = it.second;3295 if (!threadprivateAllowedSet.test(type)) {3296 if (const auto *objList{GetOmpObjectList(*clause)}) {3297 for (const auto &ompObject : objList->v) {3298 common::visit(3299 common::visitors{3300 [&](const parser::Designator &) {3301 if (const auto *name{3302 parser::Unwrap<parser::Name>(ompObject)}) {3303 if (name->symbol) {3304 testThreadprivateVarErr(3305 name->symbol->GetUltimate(), *name, type);3306 }3307 }3308 },3309 [&](const parser::Name &name) {3310 if (name.symbol) {3311 for (const auto &mem :3312 name.symbol->get<CommonBlockDetails>().objects()) {3313 testThreadprivateVarErr(mem->GetUltimate(), name, type);3314 break;3315 }3316 }3317 },3318 [&](const parser::OmpObject::Invalid &invalid) {},3319 },3320 ompObject.u);3321 }3322 }3323 }3324 }3325 3326 // Default access-group for DYN_GROUPPRIVATE is "cgroup". On a given3327 // construct there can be at most one DYN_GROUPPRIVATE with a given3328 // access-group.3329 const parser::OmpClause3330 *accGrpClause[parser::OmpAccessGroup::Value_enumSize] = {nullptr};3331 for (auto [_, clause] :3332 FindClauses(llvm::omp::Clause::OMPC_dyn_groupprivate)) {3333 auto &wrapper{std::get<parser::OmpClause::DynGroupprivate>(clause->u)};3334 auto &modifiers{OmpGetModifiers(wrapper.v)};3335 auto accGrp{parser::OmpAccessGroup::Value::Cgroup};3336 if (auto *ag{OmpGetUniqueModifier<parser::OmpAccessGroup>(modifiers)}) {3337 accGrp = ag->v;3338 }3339 auto &firstClause{accGrpClause[llvm::to_underlying(accGrp)]};3340 if (firstClause) {3341 context_3342 .Say(clause->source,3343 "The access-group modifier can only occur on a single clause in a construct"_err_en_US)3344 .Attach(firstClause->source,3345 "Previous clause with access-group modifier"_en_US);3346 break;3347 } else {3348 firstClause = clause;3349 }3350 }3351 3352 CheckRequireAtLeastOneOf();3353}3354 3355void OmpStructureChecker::Enter(const parser::OmpClause &x) {3356 SetContextClause(x);3357 3358 llvm::omp::Clause id{x.Id()};3359 // The visitors for these clauses do their own checks.3360 switch (id) {3361 case llvm::omp::Clause::OMPC_copyprivate:3362 case llvm::omp::Clause::OMPC_enter:3363 case llvm::omp::Clause::OMPC_lastprivate:3364 case llvm::omp::Clause::OMPC_reduction:3365 case llvm::omp::Clause::OMPC_to:3366 return;3367 default:3368 break;3369 }3370 3371 // Named constants are OK to be used within 'shared' and 'firstprivate'3372 // clauses. The check for this happens a few lines below.3373 bool SharedOrFirstprivate = false;3374 switch (id) {3375 case llvm::omp::Clause::OMPC_shared:3376 case llvm::omp::Clause::OMPC_firstprivate:3377 SharedOrFirstprivate = true;3378 break;3379 default:3380 break;3381 }3382 3383 if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {3384 AnalyzeObjects(*objList);3385 SymbolSourceMap symbols;3386 GetSymbolsInObjectList(*objList, symbols);3387 for (const auto &[symbol, source] : symbols) {3388 if (!IsVariableListItem(*symbol) &&3389 !(IsNamedConstant(*symbol) && SharedOrFirstprivate)) {3390 deferredNonVariables_.insert({symbol, source});3391 }3392 }3393 }3394}3395 3396void OmpStructureChecker::Enter(const parser::OmpClause::Sizes &c) {3397 CheckAllowedClause(llvm::omp::Clause::OMPC_sizes);3398 for (const parser::Cosubscript &v : c.v)3399 RequiresPositiveParameter(llvm::omp::Clause::OMPC_sizes, v,3400 /*paramName=*/"parameter", /*allowZero=*/false);3401}3402 3403void OmpStructureChecker::Enter(const parser::OmpClause::Looprange &x) {3404 CheckAllowedClause(llvm::omp::Clause::OMPC_looprange);3405 auto &first = std::get<0>(x.v.t);3406 auto &count = std::get<1>(x.v.t);3407 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_looprange, count);3408 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_looprange, first);3409}3410 3411// Restrictions specific to each clause are implemented apart from the3412// generalized restrictions.3413 3414void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) {3415 CheckAllowedClause(llvm::omp::Clause::OMPC_destroy);3416 3417 llvm::omp::Directive dir{GetContext().directive};3418 unsigned version{context_.langOptions().OpenMPVersion};3419 if (dir == llvm::omp::Directive::OMPD_depobj) {3420 unsigned argSince{52}, noargDeprecatedIn{52};3421 if (x.v) {3422 if (version < argSince) {3423 context_.Say(GetContext().clauseSource,3424 "The object parameter in DESTROY clause on DEPOPJ construct is not allowed in %s, %s"_warn_en_US,3425 ThisVersion(version), TryVersion(argSince));3426 }3427 } else {3428 if (version >= noargDeprecatedIn) {3429 context_.Say(GetContext().clauseSource,3430 "The DESTROY clause without argument on DEPOBJ construct is deprecated in %s"_warn_en_US,3431 ThisVersion(noargDeprecatedIn));3432 }3433 }3434 }3435}3436 3437void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {3438 CheckAllowedClause(llvm::omp::Clause::OMPC_reduction);3439 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};3440 3441 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_reduction,3442 GetContext().clauseSource, context_)) {3443 auto &modifiers{OmpGetModifiers(x.v)};3444 const auto *ident{3445 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};3446 assert(ident && "reduction-identifier is a required modifier");3447 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),3448 llvm::omp::OMPC_reduction)) {3449 CheckReductionObjectTypes(objects, *ident);3450 }3451 using ReductionModifier = parser::OmpReductionModifier;3452 if (auto *modifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}) {3453 CheckReductionModifier(*modifier);3454 }3455 }3456 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_reduction);3457 3458 // If this is a worksharing construct then ensure the reduction variable3459 // is not private in the parallel region that it binds to.3460 if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {3461 CheckSharedBindingInOuterContext(objects);3462 }3463 3464 if (GetContext().directive == llvm::omp::Directive::OMPD_loop) {3465 for (auto clause : GetContext().clauseInfo) {3466 if (const auto *bindClause{3467 std::get_if<parser::OmpClause::Bind>(&clause.second->u)}) {3468 if (bindClause->v.v == parser::OmpBindClause::Binding::Teams) {3469 context_.Say(GetContext().clauseSource,3470 "'REDUCTION' clause not allowed with '!$OMP LOOP BIND(TEAMS)'."_err_en_US);3471 }3472 }3473 }3474 }3475}3476 3477void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) {3478 CheckAllowedClause(llvm::omp::Clause::OMPC_in_reduction);3479 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};3480 3481 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_in_reduction,3482 GetContext().clauseSource, context_)) {3483 auto &modifiers{OmpGetModifiers(x.v)};3484 const auto *ident{3485 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};3486 assert(ident && "reduction-identifier is a required modifier");3487 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),3488 llvm::omp::OMPC_in_reduction)) {3489 CheckReductionObjectTypes(objects, *ident);3490 }3491 }3492 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_in_reduction);3493}3494 3495void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) {3496 CheckAllowedClause(llvm::omp::Clause::OMPC_task_reduction);3497 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};3498 3499 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_task_reduction,3500 GetContext().clauseSource, context_)) {3501 auto &modifiers{OmpGetModifiers(x.v)};3502 const auto *ident{3503 OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};3504 assert(ident && "reduction-identifier is a required modifier");3505 if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),3506 llvm::omp::OMPC_task_reduction)) {3507 CheckReductionObjectTypes(objects, *ident);3508 }3509 }3510 CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction);3511}3512 3513bool OmpStructureChecker::CheckReductionOperator(3514 const parser::OmpReductionIdentifier &ident, parser::CharBlock source,3515 llvm::omp::Clause clauseId) {3516 auto visitOperator{[&](const parser::DefinedOperator &dOpr) {3517 if (const auto *intrinsicOp{3518 std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {3519 switch (*intrinsicOp) {3520 case parser::DefinedOperator::IntrinsicOperator::Add:3521 case parser::DefinedOperator::IntrinsicOperator::Multiply:3522 case parser::DefinedOperator::IntrinsicOperator::AND:3523 case parser::DefinedOperator::IntrinsicOperator::OR:3524 case parser::DefinedOperator::IntrinsicOperator::EQV:3525 case parser::DefinedOperator::IntrinsicOperator::NEQV:3526 return true;3527 case parser::DefinedOperator::IntrinsicOperator::Subtract:3528 context_.Say(GetContext().clauseSource,3529 "The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause."_err_en_US,3530 ContextDirectiveAsFortran());3531 return false;3532 default:3533 break;3534 }3535 }3536 // User-defined operators are OK if there has been a declared reduction3537 // for that. We mangle those names to store the user details.3538 if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {3539 std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};3540 const Scope &scope{definedOp->v.symbol->owner()};3541 if (const Symbol *symbol{scope.FindSymbol(mangled)}) {3542 if (symbol->detailsIf<UserReductionDetails>()) {3543 return true;3544 }3545 }3546 }3547 context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,3548 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));3549 return false;3550 }};3551 3552 auto visitDesignator{[&](const parser::ProcedureDesignator &procD) {3553 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};3554 bool valid{false};3555 if (name && name->symbol) {3556 const SourceName &realName{name->symbol->GetUltimate().name()};3557 valid =3558 llvm::is_contained({"max", "min", "iand", "ior", "ieor"}, realName);3559 if (!valid) {3560 valid = name->symbol->detailsIf<UserReductionDetails>();3561 }3562 }3563 if (!valid) {3564 context_.Say(source,3565 "Invalid reduction identifier in %s clause."_err_en_US,3566 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));3567 }3568 return valid;3569 }};3570 3571 return common::visit(3572 common::visitors{visitOperator, visitDesignator}, ident.u);3573}3574 3575/// Check restrictions on objects that are common to all reduction clauses.3576void OmpStructureChecker::CheckReductionObjects(3577 const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {3578 unsigned version{context_.langOptions().OpenMPVersion};3579 SymbolSourceMap symbols;3580 GetSymbolsInObjectList(objects, symbols);3581 3582 // Array sections must be a contiguous storage, have non-zero length.3583 for (const parser::OmpObject &object : objects.v) {3584 CheckIfContiguous(object);3585 }3586 CheckReductionArraySection(objects, clauseId);3587 // An object must be definable.3588 CheckDefinableObjects(symbols, clauseId);3589 // Procedure pointers are not allowed.3590 CheckProcedurePointer(symbols, clauseId);3591 // Pointers must not have INTENT(IN).3592 CheckIntentInPointer(symbols, clauseId);3593 3594 // Disallow common blocks.3595 // Iterate on objects because `GetSymbolsInObjectList` expands common block3596 // names into the lists of their members.3597 for (const parser::OmpObject &object : objects.v) {3598 auto *symbol{GetObjectSymbol(object)};3599 if (symbol && IsCommonBlock(*symbol)) {3600 auto source{GetObjectSource(object)};3601 context_.Say(source ? *source : GetContext().clauseSource,3602 "Common block names are not allowed in %s clause"_err_en_US,3603 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));3604 }3605 }3606 3607 // Denied in all current versions of the standard because structure components3608 // are not definable (i.e. they are expressions not variables).3609 // Object cannot be a part of another object (except array elements).3610 CheckStructureComponent(objects, clauseId);3611 3612 if (version >= 50) {3613 // If object is an array section or element, the base expression must be3614 // a language identifier.3615 for (const parser::OmpObject &object : objects.v) {3616 if (auto *elem{GetArrayElementFromObj(object)}) {3617 const parser::DataRef &base = elem->base;3618 if (!std::holds_alternative<parser::Name>(base.u)) {3619 auto source{GetObjectSource(object)};3620 context_.Say(source ? *source : GetContext().clauseSource,3621 "The base expression of an array element or section in %s clause must be an identifier"_err_en_US,3622 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));3623 }3624 }3625 }3626 // Type parameter inquiries are not allowed.3627 for (const parser::OmpObject &object : objects.v) {3628 if (auto *dataRef{GetDataRefFromObj(object)}) {3629 if (IsDataRefTypeParamInquiry(dataRef)) {3630 auto source{GetObjectSource(object)};3631 context_.Say(source ? *source : GetContext().clauseSource,3632 "Type parameter inquiry is not permitted in %s clause"_err_en_US,3633 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));3634 }3635 }3636 }3637 }3638}3639 3640static bool CheckSymbolSupportsType(const Scope &scope,3641 const parser::CharBlock &name, const DeclTypeSpec &type) {3642 if (const auto *symbol{scope.FindSymbol(name)}) {3643 if (const auto *reductionDetails{3644 symbol->detailsIf<UserReductionDetails>()}) {3645 return reductionDetails->SupportsType(type);3646 }3647 }3648 return false;3649}3650 3651static bool IsReductionAllowedForType(3652 const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,3653 bool cannotBeBuiltinReduction, const Scope &scope,3654 SemanticsContext &context) {3655 auto isLogical{[](const DeclTypeSpec &type) -> bool {3656 return type.category() == DeclTypeSpec::Logical;3657 }};3658 auto isCharacter{[](const DeclTypeSpec &type) -> bool {3659 return type.category() == DeclTypeSpec::Character;3660 }};3661 3662 auto checkOperator{[&](const parser::DefinedOperator &dOpr) {3663 if (const auto *intrinsicOp{3664 std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {3665 if (cannotBeBuiltinReduction) {3666 return false;3667 }3668 3669 // OMP5.2: The type [...] of a list item that appears in a3670 // reduction clause must be valid for the combiner expression3671 // See F2023: Table 10.23672 // .LT., .LE., .GT., .GE. are handled as procedure designators3673 // below.3674 switch (*intrinsicOp) {3675 case parser::DefinedOperator::IntrinsicOperator::Multiply:3676 case parser::DefinedOperator::IntrinsicOperator::Add:3677 case parser::DefinedOperator::IntrinsicOperator::Subtract:3678 if (type.IsNumeric(TypeCategory::Integer) ||3679 type.IsNumeric(TypeCategory::Real) ||3680 type.IsNumeric(TypeCategory::Complex))3681 return true;3682 break;3683 3684 case parser::DefinedOperator::IntrinsicOperator::AND:3685 case parser::DefinedOperator::IntrinsicOperator::OR:3686 case parser::DefinedOperator::IntrinsicOperator::EQV:3687 case parser::DefinedOperator::IntrinsicOperator::NEQV:3688 if (isLogical(type)) {3689 return true;3690 }3691 break;3692 3693 // Reduction identifier is not in OMP5.2 Table 5.23694 default:3695 DIE("This should have been caught in CheckIntrinsicOperator");3696 return false;3697 }3698 parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};3699 return CheckSymbolSupportsType(scope, name, type);3700 } else if (const auto *definedOp{3701 std::get_if<parser::DefinedOpName>(&dOpr.u)}) {3702 return CheckSymbolSupportsType(3703 scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);3704 }3705 llvm_unreachable(3706 "A DefinedOperator is either a DefinedOpName or an IntrinsicOperator");3707 }};3708 3709 auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {3710 const parser::Name *name{std::get_if<parser::Name>(&procD.u)};3711 CHECK(name && name->symbol);3712 if (name && name->symbol) {3713 const SourceName &realName{name->symbol->GetUltimate().name()};3714 // OMP5.2: The type [...] of a list item that appears in a3715 // reduction clause must be valid for the combiner expression3716 if (realName == "iand" || realName == "ior" || realName == "ieor") {3717 // IAND: arguments must be integers: F2023 16.9.1003718 // IEOR: arguments must be integers: F2023 16.9.1063719 // IOR: arguments must be integers: F2023 16.9.1113720 if (type.IsNumeric(TypeCategory::Integer) &&3721 !cannotBeBuiltinReduction) {3722 return true;3723 }3724 } else if (realName == "max" || realName == "min") {3725 // MAX: arguments must be integer, real, or character:3726 // F2023 16.9.1353727 // MIN: arguments must be integer, real, or character:3728 // F2023 16.9.1413729 if ((type.IsNumeric(TypeCategory::Integer) ||3730 type.IsNumeric(TypeCategory::Real) || isCharacter(type)) &&3731 !cannotBeBuiltinReduction) {3732 return true;3733 }3734 }3735 3736 // If we get here, it may be a user declared reduction, so check3737 // if the symbol has UserReductionDetails, and if so, the type is3738 // supported.3739 if (const auto *reductionDetails{3740 name->symbol->detailsIf<UserReductionDetails>()}) {3741 return reductionDetails->SupportsType(type);3742 }3743 3744 // We also need to check for mangled names (max, min, iand, ieor and ior)3745 // and then check if the type is there.3746 parser::CharBlock mangledName{MangleSpecialFunctions(name->source)};3747 return CheckSymbolSupportsType(scope, mangledName, type);3748 }3749 // Everything else is "not matching type".3750 return false;3751 }};3752 3753 return common::visit(3754 common::visitors{checkOperator, checkDesignator}, ident.u);3755}3756 3757void OmpStructureChecker::CheckReductionObjectTypes(3758 const parser::OmpObjectList &objects,3759 const parser::OmpReductionIdentifier &ident) {3760 SymbolSourceMap symbols;3761 GetSymbolsInObjectList(objects, symbols);3762 3763 for (auto &[symbol, source] : symbols) {3764 // Built in reductions require types which can be used in their initializer3765 // and combiner expressions. For example, for +:3766 // r = 0; r = r + r23767 // But it might be valid to use these with DECLARE REDUCTION.3768 // Assumed size is already caught elsewhere.3769 bool cannotBeBuiltinReduction{IsAssumedRank(*symbol)};3770 if (auto *type{symbol->GetType()}) {3771 const auto &scope{context_.FindScope(symbol->name())};3772 if (!IsReductionAllowedForType(3773 ident, *type, cannotBeBuiltinReduction, scope, context_)) {3774 context_.Say(source,3775 "The type of '%s' is incompatible with the reduction operator."_err_en_US,3776 symbol->name());3777 }3778 } else {3779 assert(IsProcedurePointer(*symbol) && "Unexpected symbol properties");3780 }3781 }3782}3783 3784void OmpStructureChecker::CheckReductionModifier(3785 const parser::OmpReductionModifier &modifier) {3786 using ReductionModifier = parser::OmpReductionModifier;3787 if (modifier.v == ReductionModifier::Value::Default) {3788 // The default one is always ok.3789 return;3790 }3791 const DirectiveContext &dirCtx{GetContext()};3792 if (dirCtx.directive == llvm::omp::Directive::OMPD_loop ||3793 dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {3794 // [5.2:257:33-34]3795 // If a reduction-modifier is specified in a reduction clause that3796 // appears on the directive, then the reduction modifier must be3797 // default.3798 // [5.2:268:16]3799 // The reduction-modifier must be default.3800 context_.Say(GetContext().clauseSource,3801 "REDUCTION modifier on %s directive must be DEFAULT"_err_en_US,3802 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));3803 return;3804 }3805 if (modifier.v == ReductionModifier::Value::Task) {3806 // "Task" is only allowed on worksharing or "parallel" directive.3807 static llvm::omp::Directive worksharing[]{3808 llvm::omp::Directive::OMPD_do, //3809 llvm::omp::Directive::OMPD_scope, //3810 llvm::omp::Directive::OMPD_sections,3811 // There are more worksharing directives, but they do not apply:3812 // "for" is C++ only,3813 // "single" and "workshare" don't allow reduction clause,3814 // "loop" has different restrictions (checked above).3815 };3816 if (dirCtx.directive != llvm::omp::Directive::OMPD_parallel &&3817 !llvm::is_contained(worksharing, dirCtx.directive)) {3818 context_.Say(GetContext().clauseSource,3819 "Modifier 'TASK' on REDUCTION clause is only allowed with "3820 "PARALLEL or worksharing directive"_err_en_US);3821 }3822 } else if (modifier.v == ReductionModifier::Value::Inscan) {3823 // "Inscan" is only allowed on worksharing-loop, worksharing-loop simd,3824 // or "simd" directive.3825 // The worksharing-loop directives are OMPD_do and OMPD_for. Only the3826 // former is allowed in Fortran.3827 if (!llvm::omp::scanParentAllowedSet.test(dirCtx.directive)) {3828 context_.Say(GetContext().clauseSource,3829 "Modifier 'INSCAN' on REDUCTION clause is only allowed with "3830 "WORKSHARING LOOP, WORKSHARING LOOP SIMD, "3831 "or SIMD directive"_err_en_US);3832 }3833 } else {3834 // Catch-all for potential future modifiers to make sure that this3835 // function is up-to-date.3836 context_.Say(GetContext().clauseSource,3837 "Unexpected modifier on REDUCTION clause"_err_en_US);3838 }3839}3840 3841void OmpStructureChecker::CheckReductionArraySection(3842 const parser::OmpObjectList &ompObjectList, llvm::omp::Clause clauseId) {3843 for (const auto &ompObject : ompObjectList.v) {3844 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {3845 if (const auto *arrayElement{3846 parser::Unwrap<parser::ArrayElement>(ompObject)}) {3847 CheckArraySection(*arrayElement, GetLastName(*dataRef), clauseId);3848 }3849 }3850 }3851}3852 3853void OmpStructureChecker::CheckSharedBindingInOuterContext(3854 const parser::OmpObjectList &redObjectList) {3855 // TODO: Verify the assumption here that the immediately enclosing region is3856 // the parallel region to which the worksharing construct having reduction3857 // binds to.3858 if (auto *enclosingContext{GetEnclosingDirContext()}) {3859 for (auto it : enclosingContext->clauseInfo) {3860 llvmOmpClause type = it.first;3861 const auto *clause = it.second;3862 if (llvm::omp::privateReductionSet.test(type)) {3863 if (const auto *objList{GetOmpObjectList(*clause)}) {3864 for (const auto &ompObject : objList->v) {3865 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {3866 if (const auto *symbol{name->symbol}) {3867 for (const auto &redOmpObject : redObjectList.v) {3868 if (const auto *rname{3869 parser::Unwrap<parser::Name>(redOmpObject)}) {3870 if (const auto *rsymbol{rname->symbol}) {3871 if (rsymbol->name() == symbol->name()) {3872 context_.Say(GetContext().clauseSource,3873 "%s variable '%s' is %s in outer context must"3874 " be shared in the parallel regions to which any"3875 " of the worksharing regions arising from the "3876 "worksharing construct bind."_err_en_US,3877 parser::ToUpperCaseLetters(3878 getClauseName(llvm::omp::Clause::OMPC_reduction)3879 .str()),3880 symbol->name(),3881 parser::ToUpperCaseLetters(3882 getClauseName(type).str()));3883 }3884 }3885 }3886 }3887 }3888 }3889 }3890 }3891 }3892 }3893 }3894}3895 3896void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {3897 CheckAllowedClause(llvm::omp::Clause::OMPC_ordered);3898 // the parameter of ordered clause is optional3899 if (const auto &expr{x.v}) {3900 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);3901 // 2.8.3 Loop SIMD Construct Restriction3902 if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {3903 context_.Say(GetContext().clauseSource,3904 "No ORDERED clause with a parameter can be specified "3905 "on the %s directive"_err_en_US,3906 ContextDirectiveAsFortran());3907 }3908 }3909}3910 3911void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {3912 CheckAllowedClause(llvm::omp::Clause::OMPC_shared);3913 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");3914 CheckCrayPointee(x.v, "SHARED");3915}3916void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {3917 SymbolSourceMap symbols;3918 GetSymbolsInObjectList(x.v, symbols);3919 CheckAllowedClause(llvm::omp::Clause::OMPC_private);3920 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");3921 CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_private);3922 CheckCrayPointee(x.v, "PRIVATE");3923}3924 3925void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {3926 CheckAllowedClause(llvm::omp::Clause::OMPC_nowait);3927}3928 3929bool OmpStructureChecker::IsDataRefTypeParamInquiry(3930 const parser::DataRef *dataRef) {3931 bool dataRefIsTypeParamInquiry{false};3932 if (const auto *structComp{3933 parser::Unwrap<parser::StructureComponent>(dataRef)}) {3934 if (const auto *compSymbol{structComp->component.symbol}) {3935 if (const auto *compSymbolMiscDetails{3936 std::get_if<MiscDetails>(&compSymbol->details())}) {3937 const auto detailsKind = compSymbolMiscDetails->kind();3938 dataRefIsTypeParamInquiry =3939 (detailsKind == MiscDetails::Kind::KindParamInquiry ||3940 detailsKind == MiscDetails::Kind::LenParamInquiry);3941 } else if (compSymbol->has<TypeParamDetails>()) {3942 dataRefIsTypeParamInquiry = true;3943 }3944 }3945 }3946 return dataRefIsTypeParamInquiry;3947}3948 3949void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(3950 const parser::CharBlock &source, const parser::OmpObjectList &objList,3951 llvm::StringRef clause) {3952 for (const auto &ompObject : objList.v) {3953 CheckVarIsNotPartOfAnotherVar(source, ompObject, clause);3954 }3955}3956 3957void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(3958 const parser::CharBlock &source, const parser::OmpObject &ompObject,3959 llvm::StringRef clause) {3960 common::visit(3961 common::visitors{3962 [&](const parser::Designator &designator) {3963 if (const auto *dataRef{3964 std::get_if<parser::DataRef>(&designator.u)}) {3965 if (IsDataRefTypeParamInquiry(dataRef)) {3966 context_.Say(source,3967 "A type parameter inquiry cannot appear on the %s directive"_err_en_US,3968 ContextDirectiveAsFortran());3969 } else if (parser::Unwrap<parser::StructureComponent>(3970 ompObject) ||3971 parser::Unwrap<parser::ArrayElement>(ompObject)) {3972 if (llvm::omp::nonPartialVarSet.test(GetContext().directive)) {3973 context_.Say(source,3974 "A variable that is part of another variable (as an array or structure element) cannot appear on the %s directive"_err_en_US,3975 ContextDirectiveAsFortran());3976 } else {3977 context_.Say(source,3978 "A variable that is part of another variable (as an array or structure element) cannot appear in a %s clause"_err_en_US,3979 clause.data());3980 }3981 }3982 }3983 },3984 [&](const parser::Name &name) {},3985 [&](const parser::OmpObject::Invalid &invalid) {},3986 },3987 ompObject.u);3988}3989 3990void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {3991 CheckAllowedClause(llvm::omp::Clause::OMPC_firstprivate);3992 3993 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");3994 CheckCrayPointee(x.v, "FIRSTPRIVATE");3995 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);3996 3997 SymbolSourceMap currSymbols;3998 GetSymbolsInObjectList(x.v, currSymbols);3999 CheckCopyingPolymorphicAllocatable(4000 currSymbols, llvm::omp::Clause::OMPC_firstprivate);4001 4002 DirectivesClauseTriple dirClauseTriple;4003 // Check firstprivate variables in worksharing constructs4004 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,4005 std::make_pair(4006 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));4007 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,4008 std::make_pair(4009 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));4010 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,4011 std::make_pair(4012 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));4013 // Check firstprivate variables in distribute construct4014 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,4015 std::make_pair(4016 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));4017 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,4018 std::make_pair(llvm::omp::Directive::OMPD_target_teams,4019 llvm::omp::privateReductionSet));4020 // Check firstprivate variables in task and taskloop constructs4021 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,4022 std::make_pair(llvm::omp::Directive::OMPD_parallel,4023 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));4024 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,4025 std::make_pair(llvm::omp::Directive::OMPD_parallel,4026 OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));4027 4028 CheckPrivateSymbolsInOuterCxt(4029 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);4030}4031 4032void OmpStructureChecker::CheckIsLoopIvPartOfClause(4033 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {4034 for (const auto &ompObject : ompObjectList.v) {4035 if (const parser::Name *name{parser::Unwrap<parser::Name>(ompObject)}) {4036 if (name->symbol == GetContext().loopIV) {4037 context_.Say(name->source,4038 "DO iteration variable %s is not allowed in %s clause."_err_en_US,4039 name->ToString(),4040 parser::ToUpperCaseLetters(getClauseName(clause).str()));4041 }4042 }4043 }4044}4045 4046void OmpStructureChecker::Enter(const parser::OmpClause::Align &x) {4047 CheckAllowedClause(llvm::omp::Clause::OMPC_align);4048 if (const auto &v{GetIntValue(x.v.v)}) {4049 if (*v <= 0) {4050 context_.Say(GetContext().clauseSource,4051 "The alignment should be positive"_err_en_US);4052 } else if (!llvm::isPowerOf2_64(*v)) {4053 context_.Say(GetContext().clauseSource,4054 "The alignment should be a power of 2"_err_en_US);4055 }4056 }4057}4058 4059// Restrictions specific to each clause are implemented apart from the4060// generalized restrictions.4061void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {4062 CheckAllowedClause(llvm::omp::Clause::OMPC_aligned);4063 if (OmpVerifyModifiers(4064 x.v, llvm::omp::OMPC_aligned, GetContext().clauseSource, context_)) {4065 auto &modifiers{OmpGetModifiers(x.v)};4066 if (auto *align{OmpGetUniqueModifier<parser::OmpAlignment>(modifiers)}) {4067 const auto &v{GetIntValue(align->v)};4068 if (!v || *v <= 0) {4069 context_.Say(OmpGetModifierSource(modifiers, align),4070 "The alignment value should be a constant positive integer"_err_en_US);4071 } else if (((*v) & (*v - 1)) != 0) {4072 context_.Warn(common::UsageWarning::OpenMPUsage,4073 OmpGetModifierSource(modifiers, align),4074 "Alignment is not a power of 2, Aligned clause will be ignored"_warn_en_US);4075 }4076 }4077 }4078 // 2.8.1 TODO: list-item attribute check4079}4080 4081void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {4082 CheckAllowedClause(llvm::omp::Clause::OMPC_defaultmap);4083 unsigned version{context_.langOptions().OpenMPVersion};4084 using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;4085 auto behavior{std::get<ImplicitBehavior>(x.v.t)};4086 if (version <= 45) {4087 if (behavior != ImplicitBehavior::Tofrom) {4088 context_.Say(GetContext().clauseSource,4089 "%s is not allowed in %s, %s"_warn_en_US,4090 parser::ToUpperCaseLetters(4091 parser::OmpDefaultmapClause::EnumToString(behavior)),4092 ThisVersion(version), TryVersion(50));4093 }4094 }4095 if (!OmpVerifyModifiers(x.v, llvm::omp::OMPC_defaultmap,4096 GetContext().clauseSource, context_)) {4097 // If modifier verification fails, return early.4098 return;4099 }4100 auto &modifiers{OmpGetModifiers(x.v)};4101 auto *maybeCategory{4102 OmpGetUniqueModifier<parser::OmpVariableCategory>(modifiers)};4103 if (maybeCategory) {4104 using VariableCategory = parser::OmpVariableCategory;4105 VariableCategory::Value category{maybeCategory->v};4106 unsigned tryVersion{0};4107 if (version <= 45 && category != VariableCategory::Value::Scalar) {4108 tryVersion = 50;4109 }4110 if (version < 52 && category == VariableCategory::Value::All) {4111 tryVersion = 52;4112 }4113 if (tryVersion) {4114 context_.Say(GetContext().clauseSource,4115 "%s is not allowed in %s, %s"_warn_en_US,4116 parser::ToUpperCaseLetters(VariableCategory::EnumToString(category)),4117 ThisVersion(version), TryVersion(tryVersion));4118 }4119 }4120}4121 4122void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {4123 CheckAllowedClause(llvm::omp::Clause::OMPC_if);4124 unsigned version{context_.langOptions().OpenMPVersion};4125 llvm::omp::Directive dir{GetContext().directive};4126 4127 auto isConstituent{[](llvm::omp::Directive dir, llvm::omp::Directive part) {4128 using namespace llvm::omp;4129 llvm::ArrayRef<Directive> dirLeafs{getLeafConstructsOrSelf(dir)};4130 llvm::ArrayRef<Directive> partLeafs{getLeafConstructsOrSelf(part)};4131 // Maybe it's sufficient to check if every leaf of `part` is also a leaf4132 // of `dir`, but to be safe check if `partLeafs` is a sub-sequence of4133 // `dirLeafs`.4134 size_t dirSize{dirLeafs.size()}, partSize{partLeafs.size()};4135 // Find the first leaf from `part` in `dir`.4136 if (auto first = llvm::find(dirLeafs, partLeafs.front());4137 first != dirLeafs.end()) {4138 // A leaf can only appear once in a compound directive, so if `part`4139 // is a subsequence of `dir`, it must start here.4140 size_t firstPos{4141 static_cast<size_t>(std::distance(dirLeafs.begin(), first))};4142 llvm::ArrayRef<Directive> subSeq{4143 first, std::min<size_t>(dirSize - firstPos, partSize)};4144 return subSeq == partLeafs;4145 }4146 return false;4147 }};4148 4149 if (OmpVerifyModifiers(4150 x.v, llvm::omp::OMPC_if, GetContext().clauseSource, context_)) {4151 auto &modifiers{OmpGetModifiers(x.v)};4152 if (auto *dnm{OmpGetUniqueModifier<parser::OmpDirectiveNameModifier>(4153 modifiers)}) {4154 llvm::omp::Directive sub{dnm->v};4155 std::string subName{4156 parser::ToUpperCaseLetters(getDirectiveName(sub).str())};4157 std::string dirName{4158 parser::ToUpperCaseLetters(getDirectiveName(dir).str())};4159 4160 parser::CharBlock modifierSource{OmpGetModifierSource(modifiers, dnm)};4161 auto desc{OmpGetDescriptor<parser::OmpDirectiveNameModifier>()};4162 std::string modName{desc.name.str()};4163 4164 if (!isConstituent(dir, sub)) {4165 context_4166 .Say(modifierSource,4167 "%s is not a constituent of the %s directive"_err_en_US,4168 subName, dirName)4169 .Attach(GetContext().directiveSource,4170 "Cannot apply to directive"_en_US);4171 } else {4172 static llvm::omp::Directive valid45[]{4173 llvm::omp::OMPD_cancel, //4174 llvm::omp::OMPD_parallel, //4175 /* OMP 5.0+ also allows OMPD_simd */4176 llvm::omp::OMPD_target, //4177 llvm::omp::OMPD_target_data, //4178 llvm::omp::OMPD_target_enter_data, //4179 llvm::omp::OMPD_target_exit_data, //4180 llvm::omp::OMPD_target_update, //4181 llvm::omp::OMPD_task, //4182 llvm::omp::OMPD_taskloop, //4183 /* OMP 5.2+ also allows OMPD_teams */4184 };4185 if (version < 50 && sub == llvm::omp::OMPD_simd) {4186 context_.Say(modifierSource,4187 "%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,4188 modName, ThisVersion(version), TryVersion(50));4189 } else if (version < 52 && sub == llvm::omp::OMPD_teams) {4190 context_.Say(modifierSource,4191 "%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,4192 modName, ThisVersion(version), TryVersion(52));4193 } else if (!llvm::is_contained(valid45, sub) &&4194 sub != llvm::omp::OMPD_simd && sub != llvm::omp::OMPD_teams) {4195 context_.Say(modifierSource,4196 "%s is not allowed as '%s' in %s"_err_en_US, subName, modName,4197 ThisVersion(version));4198 }4199 }4200 }4201 }4202}4203 4204void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {4205 unsigned version{context_.langOptions().OpenMPVersion};4206 if (version >= 52) {4207 SetContextClauseInfo(llvm::omp::Clause::OMPC_detach);4208 } else {4209 // OpenMP 5.0: 2.10.1 Task construct restrictions4210 CheckAllowedClause(llvm::omp::Clause::OMPC_detach);4211 }4212 // OpenMP 5.2: 12.5.2 Detach clause restrictions4213 if (version >= 52) {4214 CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v.v, "DETACH");4215 }4216 4217 if (const auto *name{parser::Unwrap<parser::Name>(x.v.v)}) {4218 if (version >= 52 && IsPointer(*name->symbol)) {4219 context_.Say(GetContext().clauseSource,4220 "The event-handle: `%s` must not have the POINTER attribute"_err_en_US,4221 name->ToString());4222 }4223 if (!name->symbol->GetType()->IsNumeric(TypeCategory::Integer)) {4224 context_.Say(GetContext().clauseSource,4225 "The event-handle: `%s` must be of type integer(kind=omp_event_handle_kind)"_err_en_US,4226 name->ToString());4227 }4228 }4229}4230 4231void OmpStructureChecker::CheckAllowedMapTypes(parser::OmpMapType::Value type,4232 llvm::ArrayRef<parser::OmpMapType::Value> allowed) {4233 if (llvm::is_contained(allowed, type)) {4234 return;4235 }4236 4237 llvm::SmallVector<std::string> names;4238 llvm::transform(4239 allowed, std::back_inserter(names), [](parser::OmpMapType::Value val) {4240 return parser::ToUpperCaseLetters(4241 parser::OmpMapType::EnumToString(val));4242 });4243 llvm::sort(names);4244 context_.Say(GetContext().clauseSource,4245 "Only the %s map types are permitted for MAP clauses on the %s directive"_err_en_US,4246 llvm::join(names, ", "), ContextDirectiveAsFortran());4247}4248 4249void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {4250 CheckAllowedClause(llvm::omp::Clause::OMPC_map);4251 if (!OmpVerifyModifiers(4252 x.v, llvm::omp::OMPC_map, GetContext().clauseSource, context_)) {4253 return;4254 }4255 4256 auto &modifiers{OmpGetModifiers(x.v)};4257 unsigned version{context_.langOptions().OpenMPVersion};4258 if (auto commas{std::get<bool>(x.v.t)}; !commas && version >= 52) {4259 context_.Say(GetContext().clauseSource,4260 "The specification of modifiers without comma separators for the "4261 "'MAP' clause has been deprecated in OpenMP 5.2"_port_en_US);4262 }4263 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {4264 CheckIteratorModifier(*iter);4265 }4266 4267 using Directive = llvm::omp::Directive;4268 Directive dir{GetContext().directive};4269 llvm::ArrayRef<Directive> leafs{llvm::omp::getLeafConstructsOrSelf(dir)};4270 parser::OmpMapType::Value mapType{parser::OmpMapType::Value::Storage};4271 4272 if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {4273 using Value = parser::OmpMapType::Value;4274 mapType = type->v;4275 4276 static auto isValidForVersion{4277 [](parser::OmpMapType::Value t, unsigned version) {4278 switch (t) {4279 case parser::OmpMapType::Value::Alloc:4280 case parser::OmpMapType::Value::Delete:4281 case parser::OmpMapType::Value::Release:4282 return version < 60;4283 case parser::OmpMapType::Value::Storage:4284 return version >= 60;4285 default:4286 return true;4287 }4288 }};4289 4290 llvm::SmallVector<parser::OmpMapType::Value> mapEnteringTypes{[&]() {4291 llvm::SmallVector<parser::OmpMapType::Value> result;4292 for (size_t i{0}; i != parser::OmpMapType::Value_enumSize; ++i) {4293 auto t{static_cast<parser::OmpMapType::Value>(i)};4294 if (isValidForVersion(t, version) && IsMapEnteringType(t)) {4295 result.push_back(t);4296 }4297 }4298 return result;4299 }()};4300 llvm::SmallVector<parser::OmpMapType::Value> mapExitingTypes{[&]() {4301 llvm::SmallVector<parser::OmpMapType::Value> result;4302 for (size_t i{0}; i != parser::OmpMapType::Value_enumSize; ++i) {4303 auto t{static_cast<parser::OmpMapType::Value>(i)};4304 if (isValidForVersion(t, version) && IsMapExitingType(t)) {4305 result.push_back(t);4306 }4307 }4308 return result;4309 }()};4310 4311 if (llvm::is_contained(leafs, Directive::OMPD_target) ||4312 llvm::is_contained(leafs, Directive::OMPD_target_data)) {4313 if (version >= 60) {4314 // Map types listed in the decay table. [6.0:276]4315 CheckAllowedMapTypes(4316 type->v, {Value::Storage, Value::From, Value::To, Value::Tofrom});4317 } else {4318 CheckAllowedMapTypes(4319 type->v, {Value::Alloc, Value::From, Value::To, Value::Tofrom});4320 }4321 } else if (llvm::is_contained(leafs, Directive::OMPD_target_enter_data)) {4322 CheckAllowedMapTypes(type->v, mapEnteringTypes);4323 } else if (llvm::is_contained(leafs, Directive::OMPD_target_exit_data)) {4324 CheckAllowedMapTypes(type->v, mapExitingTypes);4325 }4326 }4327 4328 if (auto *attach{4329 OmpGetUniqueModifier<parser::OmpAttachModifier>(modifiers)}) {4330 bool mapEnteringConstructOrMapper{4331 llvm::is_contained(leafs, Directive::OMPD_target) ||4332 llvm::is_contained(leafs, Directive::OMPD_target_data) ||4333 llvm::is_contained(leafs, Directive::OMPD_target_enter_data) ||4334 llvm::is_contained(leafs, Directive::OMPD_declare_mapper)};4335 4336 if (!mapEnteringConstructOrMapper || !IsMapEnteringType(mapType)) {4337 const auto &desc{OmpGetDescriptor<parser::OmpAttachModifier>()};4338 context_.Say(OmpGetModifierSource(modifiers, attach),4339 "The '%s' modifier can only appear on a map-entering construct or on a DECLARE_MAPPER directive"_err_en_US,4340 desc.name.str());4341 }4342 4343 auto hasBasePointer{[&](const SomeExpr &item) {4344 evaluate::SymbolVector symbols{evaluate::GetSymbolVector(item)};4345 return llvm::any_of(4346 symbols, [](SymbolRef s) { return IsPointer(s.get()); });4347 }};4348 4349 evaluate::ExpressionAnalyzer ea{context_};4350 const auto &objects{std::get<parser::OmpObjectList>(x.v.t)};4351 for (auto &object : objects.v) {4352 if (const parser::Designator *d{GetDesignatorFromObj(object)}) {4353 if (auto &&expr{ea.Analyze(*d)}) {4354 if (hasBasePointer(*expr)) {4355 continue;4356 }4357 }4358 }4359 auto source{GetObjectSource(object)};4360 context_.Say(source ? *source : GetContext().clauseSource,4361 "A list-item that appears in a map clause with the ATTACH modifier must have a base-pointer"_err_en_US);4362 }4363 }4364 4365 auto &&typeMods{4366 OmpGetRepeatableModifier<parser::OmpMapTypeModifier>(modifiers)};4367 struct Less {4368 using Iterator = decltype(typeMods.begin());4369 bool operator()(Iterator a, Iterator b) const {4370 const parser::OmpMapTypeModifier *pa = *a;4371 const parser::OmpMapTypeModifier *pb = *b;4372 return pa->v < pb->v;4373 }4374 };4375 if (auto maybeIter{FindDuplicate<Less>(typeMods)}) {4376 context_.Say(GetContext().clauseSource,4377 "Duplicate map-type-modifier entry '%s' will be ignored"_warn_en_US,4378 parser::ToUpperCaseLetters(4379 parser::OmpMapTypeModifier::EnumToString((**maybeIter)->v)));4380 }4381}4382 4383void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {4384 CheckAllowedClause(llvm::omp::Clause::OMPC_schedule);4385 const parser::OmpScheduleClause &scheduleClause = x.v;4386 if (!OmpVerifyModifiers(scheduleClause, llvm::omp::OMPC_schedule,4387 GetContext().clauseSource, context_)) {4388 return;4389 }4390 4391 // 2.7 Loop Construct Restriction4392 if (llvm::omp::allDoSet.test(GetContext().directive)) {4393 auto &modifiers{OmpGetModifiers(scheduleClause)};4394 auto kind{std::get<parser::OmpScheduleClause::Kind>(scheduleClause.t)};4395 auto &chunk{4396 std::get<std::optional<parser::ScalarIntExpr>>(scheduleClause.t)};4397 if (chunk) {4398 if (kind == parser::OmpScheduleClause::Kind::Runtime ||4399 kind == parser::OmpScheduleClause::Kind::Auto) {4400 context_.Say(GetContext().clauseSource,4401 "When SCHEDULE clause has %s specified, "4402 "it must not have chunk size specified"_err_en_US,4403 parser::ToUpperCaseLetters(4404 parser::OmpScheduleClause::EnumToString(kind)));4405 }4406 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(4407 scheduleClause.t)}) {4408 RequiresPositiveParameter(4409 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");4410 }4411 }4412 4413 auto *ordering{4414 OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};4415 if (ordering &&4416 ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {4417 if (kind != parser::OmpScheduleClause::Kind::Dynamic &&4418 kind != parser::OmpScheduleClause::Kind::Guided) {4419 context_.Say(GetContext().clauseSource,4420 "The NONMONOTONIC modifier can only be specified with "4421 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);4422 }4423 }4424 }4425}4426 4427void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {4428 CheckAllowedClause(llvm::omp::Clause::OMPC_device);4429 const parser::OmpDeviceClause &deviceClause{x.v};4430 const auto &device{std::get<parser::ScalarIntExpr>(deviceClause.t)};4431 RequiresPositiveParameter(4432 llvm::omp::Clause::OMPC_device, device, "device expression");4433 llvm::omp::Directive dir{GetContext().directive};4434 4435 if (OmpVerifyModifiers(deviceClause, llvm::omp::OMPC_device,4436 GetContext().clauseSource, context_)) {4437 auto &modifiers{OmpGetModifiers(deviceClause)};4438 4439 if (auto *deviceMod{4440 OmpGetUniqueModifier<parser::OmpDeviceModifier>(modifiers)}) {4441 using Value = parser::OmpDeviceModifier::Value;4442 if (dir != llvm::omp::OMPD_target && deviceMod->v == Value::Ancestor) {4443 auto name{OmpGetDescriptor<parser::OmpDeviceModifier>().name};4444 context_.Say(OmpGetModifierSource(modifiers, deviceMod),4445 "The ANCESTOR %s must not appear on the DEVICE clause on any directive other than the TARGET construct. Found on %s construct."_err_en_US,4446 name.str(), parser::ToUpperCaseLetters(getDirectiveName(dir)));4447 }4448 }4449 }4450}4451 4452void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {4453 CheckAllowedClause(llvm::omp::Clause::OMPC_depend);4454 llvm::omp::Directive dir{GetContext().directive};4455 unsigned version{context_.langOptions().OpenMPVersion};4456 4457 auto *doaDep{std::get_if<parser::OmpDoacross>(&x.v.u)};4458 auto *taskDep{std::get_if<parser::OmpDependClause::TaskDep>(&x.v.u)};4459 assert(((doaDep == nullptr) != (taskDep == nullptr)) &&4460 "Unexpected alternative in update clause");4461 4462 if (doaDep) {4463 CheckDoacross(*doaDep);4464 CheckDependenceType(doaDep->GetDepType());4465 } else {4466 using Modifier = parser::OmpDependClause::TaskDep::Modifier;4467 auto &modifiers{std::get<std::optional<std::list<Modifier>>>(taskDep->t)};4468 if (!modifiers) {4469 context_.Say(GetContext().clauseSource,4470 "A DEPEND clause on a TASK construct must have a valid task dependence type"_err_en_US);4471 return;4472 }4473 CheckTaskDependenceType(taskDep->GetTaskDepType());4474 }4475 4476 if (dir == llvm::omp::OMPD_depobj) {4477 // [5.0:255:11], [5.1:288:3]4478 // A depend clause on a depobj construct must not have source, sink [or4479 // depobj](5.0) as dependence-type.4480 if (version >= 50) {4481 bool invalidDep{false};4482 if (taskDep) {4483 if (version == 50) {4484 invalidDep = taskDep->GetTaskDepType() ==4485 parser::OmpTaskDependenceType::Value::Depobj;4486 }4487 } else {4488 invalidDep = true;4489 }4490 if (invalidDep) {4491 context_.Say(GetContext().clauseSource,4492 "A DEPEND clause on a DEPOBJ construct must not have %s as dependence type"_err_en_US,4493 version == 50 ? "SINK, SOURCE or DEPOBJ" : "SINK or SOURCE");4494 }4495 }4496 } else if (dir != llvm::omp::OMPD_ordered) {4497 if (doaDep) {4498 context_.Say(GetContext().clauseSource,4499 "The SINK and SOURCE dependence types can only be used with the ORDERED directive, used here in the %s construct"_err_en_US,4500 parser::ToUpperCaseLetters(getDirectiveName(dir)));4501 }4502 }4503 if (taskDep) {4504 auto &objList{std::get<parser::OmpObjectList>(taskDep->t)};4505 if (dir == llvm::omp::OMPD_depobj) {4506 // [5.0:255:13], [5.1:288:6], [5.2:322:26]4507 // A depend clause on a depobj construct must only specify one locator.4508 if (objList.v.size() != 1) {4509 context_.Say(GetContext().clauseSource,4510 "A DEPEND clause on a DEPOBJ construct must only specify "4511 "one locator"_err_en_US);4512 }4513 }4514 for (const auto &object : objList.v) {4515 if (const auto *name{std::get_if<parser::Name>(&object.u)}) {4516 context_.Say(GetContext().clauseSource,4517 "Common block name ('%s') cannot appear in a DEPEND "4518 "clause"_err_en_US,4519 name->ToString());4520 } else if (auto *designator{std::get_if<parser::Designator>(&object.u)}) {4521 if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {4522 CheckDependList(*dataRef);4523 if (const auto *arr{4524 std::get_if<common::Indirection<parser::ArrayElement>>(4525 &dataRef->u)}) {4526 CheckArraySection(arr->value(), GetLastName(*dataRef),4527 llvm::omp::Clause::OMPC_depend);4528 }4529 }4530 }4531 }4532 if (OmpVerifyModifiers(*taskDep, llvm::omp::OMPC_depend,4533 GetContext().clauseSource, context_)) {4534 auto &modifiers{OmpGetModifiers(*taskDep)};4535 if (OmpGetUniqueModifier<parser::OmpIterator>(modifiers)) {4536 if (dir == llvm::omp::OMPD_depobj) {4537 context_.Say(GetContext().clauseSource,4538 "An iterator-modifier may specify multiple locators, a DEPEND clause on a DEPOBJ construct must only specify one locator"_warn_en_US);4539 }4540 }4541 }4542 }4543}4544 4545void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {4546 CheckAllowedClause(llvm::omp::Clause::OMPC_doacross);4547 CheckDoacross(x.v.v);4548}4549 4550void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {4551 if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {4552 // Nothing to check here.4553 return;4554 }4555 4556 // Process SINK dependence type. SINK may only appear in an ORDER construct,4557 // which references a prior ORDERED(n) clause on a DO or SIMD construct4558 // that marks the top of the loop nest.4559 4560 auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};4561 const std::list<parser::OmpIteration> &vec{sink.v.v};4562 4563 // Check if the variables in the iteration vector are unique.4564 struct Less {4565 using Iterator = std::list<parser::OmpIteration>::const_iterator;4566 bool operator()(Iterator a, Iterator b) const {4567 auto namea{std::get<parser::Name>(a->t)};4568 auto nameb{std::get<parser::Name>(b->t)};4569 assert(namea.symbol && nameb.symbol && "Unresolved symbols");4570 // The non-determinism of the "<" doesn't matter, we only care about4571 // equality, i.e. a == b <=> !(a < b) && !(b < a)4572 return reinterpret_cast<uintptr_t>(namea.symbol) <4573 reinterpret_cast<uintptr_t>(nameb.symbol);4574 }4575 };4576 if (auto maybeIter{FindDuplicate<Less>(vec)}) {4577 auto name{std::get<parser::Name>((*maybeIter)->t)};4578 context_.Say(name.source,4579 "Duplicate variable '%s' in the iteration vector"_err_en_US,4580 name.ToString());4581 }4582 4583 // Check if the variables in the iteration vector are induction variables.4584 // Ignore any mismatch between the size of the iteration vector and the4585 // number of DO constructs on the stack. This is checked elsewhere.4586 4587 std::set<const Symbol *> inductionVars;4588 for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {4589 if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {4590 // Do-construct, collect the induction variable.4591 if (auto &control{(*doc)->GetLoopControl()}) {4592 if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {4593 inductionVars.insert(b->name.thing.symbol);4594 }4595 }4596 } else {4597 // Omp-loop-construct, check if it's do/simd with an ORDERED clause.4598 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};4599 assert(loopc && "Expecting OpenMPLoopConstruct");4600 const parser::OmpDirectiveSpecification &beginSpec{(*loopc)->BeginDir()};4601 llvm::omp::Directive loopDir{beginSpec.DirId()};4602 if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {4603 auto IsOrdered{[](const parser::OmpClause &c) {4604 return c.Id() == llvm::omp::OMPC_ordered;4605 }};4606 // If it has ORDERED clause, stop the traversal.4607 if (llvm::any_of(beginSpec.Clauses().v, IsOrdered)) {4608 break;4609 }4610 }4611 }4612 }4613 for (const parser::OmpIteration &iter : vec) {4614 auto &name{std::get<parser::Name>(iter.t)};4615 if (!inductionVars.count(name.symbol)) {4616 context_.Say(name.source,4617 "The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,4618 name.ToString());4619 }4620 }4621}4622 4623void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(4624 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {4625 if (context_.ShouldWarn(common::UsageWarning::Portability)) {4626 for (auto &[symbol, source] : symbols) {4627 if (IsPolymorphicAllocatable(*symbol)) {4628 context_.Warn(common::UsageWarning::Portability, source,4629 "If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,4630 symbol->name(),4631 parser::ToUpperCaseLetters(getClauseName(clause).str()));4632 }4633 }4634 }4635}4636 4637void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {4638 CheckAllowedClause(llvm::omp::Clause::OMPC_copyprivate);4639 SymbolSourceMap symbols;4640 GetSymbolsInObjectList(x.v, symbols);4641 CheckVariableListItem(symbols);4642 CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_copyprivate);4643 CheckCopyingPolymorphicAllocatable(4644 symbols, llvm::omp::Clause::OMPC_copyprivate);4645}4646 4647void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {4648 CheckAllowedClause(llvm::omp::Clause::OMPC_lastprivate);4649 4650 const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)};4651 CheckVarIsNotPartOfAnotherVar(4652 GetContext().clauseSource, objectList, "LASTPRIVATE");4653 CheckCrayPointee(objectList, "LASTPRIVATE");4654 4655 DirectivesClauseTriple dirClauseTriple;4656 SymbolSourceMap currSymbols;4657 GetSymbolsInObjectList(objectList, currSymbols);4658 CheckDefinableObjects(currSymbols, llvm::omp::Clause::OMPC_lastprivate);4659 CheckCopyingPolymorphicAllocatable(4660 currSymbols, llvm::omp::Clause::OMPC_lastprivate);4661 4662 // Check lastprivate variables in worksharing constructs4663 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,4664 std::make_pair(4665 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));4666 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,4667 std::make_pair(4668 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));4669 4670 CheckPrivateSymbolsInOuterCxt(4671 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_lastprivate);4672 4673 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_lastprivate,4674 GetContext().clauseSource, context_)) {4675 auto &modifiers{OmpGetModifiers(x.v)};4676 using LastprivateModifier = parser::OmpLastprivateModifier;4677 if (auto *modifier{OmpGetUniqueModifier<LastprivateModifier>(modifiers)}) {4678 CheckLastprivateModifier(*modifier);4679 }4680 }4681}4682 4683// Add any restrictions related to Modifiers/Directives with4684// Lastprivate clause here:4685void OmpStructureChecker::CheckLastprivateModifier(4686 const parser::OmpLastprivateModifier &modifier) {4687 using LastprivateModifier = parser::OmpLastprivateModifier;4688 const DirectiveContext &dirCtx{GetContext()};4689 if (modifier.v == LastprivateModifier::Value::Conditional &&4690 dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {4691 // [5.2:268:17]4692 // The conditional lastprivate-modifier must not be specified.4693 context_.Say(GetContext().clauseSource,4694 "'CONDITIONAL' modifier on lastprivate clause with TASKLOOP "4695 "directive is not allowed"_err_en_US);4696 }4697}4698 4699void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {4700 CheckAllowedClause(llvm::omp::Clause::OMPC_copyin);4701 4702 SymbolSourceMap currSymbols;4703 GetSymbolsInObjectList(x.v, currSymbols);4704 CheckCopyingPolymorphicAllocatable(4705 currSymbols, llvm::omp::Clause::OMPC_copyin);4706}4707 4708void OmpStructureChecker::CheckStructureComponent(4709 const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {4710 auto CheckComponent{[&](const parser::Designator &designator) {4711 if (const parser::DataRef *dataRef{4712 std::get_if<parser::DataRef>(&designator.u)}) {4713 if (!IsDataRefTypeParamInquiry(dataRef)) {4714 const auto expr{AnalyzeExpr(context_, designator)};4715 if (expr.has_value() && evaluate::HasStructureComponent(expr.value())) {4716 context_.Say(designator.source,4717 "A variable that is part of another variable cannot appear on the %s clause"_err_en_US,4718 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));4719 }4720 }4721 }4722 }};4723 4724 for (const auto &object : objects.v) {4725 common::visit(common::visitors{4726 CheckComponent,4727 [&](const parser::Name &name) {},4728 [&](const parser::OmpObject::Invalid &invalid) {},4729 },4730 object.u);4731 }4732}4733 4734void OmpStructureChecker::Enter(const parser::OmpClause::Update &x) {4735 CheckAllowedClause(llvm::omp::Clause::OMPC_update);4736 llvm::omp::Directive dir{GetContext().directive};4737 unsigned version{context_.langOptions().OpenMPVersion};4738 4739 const parser::OmpDependenceType *depType{nullptr};4740 const parser::OmpTaskDependenceType *taskType{nullptr};4741 if (auto &maybeUpdate{x.v}) {4742 depType = std::get_if<parser::OmpDependenceType>(&maybeUpdate->u);4743 taskType = std::get_if<parser::OmpTaskDependenceType>(&maybeUpdate->u);4744 }4745 4746 if (!depType && !taskType) {4747 assert(dir == llvm::omp::Directive::OMPD_atomic &&4748 "Unexpected alternative in update clause");4749 return;4750 }4751 4752 if (depType) {4753 CheckDependenceType(depType->v);4754 } else if (taskType) {4755 CheckTaskDependenceType(taskType->v);4756 }4757 4758 // [5.1:288:4-5]4759 // An update clause on a depobj construct must not have source, sink or depobj4760 // as dependence-type.4761 // [5.2:322:3]4762 // task-dependence-type must not be depobj.4763 if (dir == llvm::omp::OMPD_depobj) {4764 if (version >= 51) {4765 bool invalidDep{false};4766 if (taskType) {4767 invalidDep =4768 taskType->v == parser::OmpTaskDependenceType::Value::Depobj;4769 } else {4770 invalidDep = true;4771 }4772 if (invalidDep) {4773 context_.Say(GetContext().clauseSource,4774 "An UPDATE clause on a DEPOBJ construct must not have SINK, SOURCE or DEPOBJ as dependence type"_err_en_US);4775 }4776 }4777 }4778}4779 4780void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {4781 CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_ptr);4782 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_ptr);4783 SymbolSourceMap currSymbols;4784 GetSymbolsInObjectList(x.v, currSymbols);4785 semantics::UnorderedSymbolSet listVars;4786 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)) {4787 const auto &useDevicePtrClause{4788 std::get<parser::OmpClause::UseDevicePtr>(clause->u)};4789 const auto &useDevicePtrList{useDevicePtrClause.v};4790 std::list<parser::Name> useDevicePtrNameList;4791 for (const auto &ompObject : useDevicePtrList.v) {4792 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {4793 if (name->symbol) {4794 if (!(IsBuiltinCPtr(*(name->symbol)))) {4795 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,4796 "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,4797 name->ToString());4798 } else {4799 useDevicePtrNameList.push_back(*name);4800 }4801 }4802 }4803 }4804 CheckMultipleOccurrence(4805 listVars, useDevicePtrNameList, clause->source, "USE_DEVICE_PTR");4806 }4807}4808 4809void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {4810 CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_addr);4811 CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_addr);4812 SymbolSourceMap currSymbols;4813 GetSymbolsInObjectList(x.v, currSymbols);4814 semantics::UnorderedSymbolSet listVars;4815 for (auto [_, clause] :4816 FindClauses(llvm::omp::Clause::OMPC_use_device_addr)) {4817 const auto &useDeviceAddrClause{4818 std::get<parser::OmpClause::UseDeviceAddr>(clause->u)};4819 const auto &useDeviceAddrList{useDeviceAddrClause.v};4820 std::list<parser::Name> useDeviceAddrNameList;4821 for (const auto &ompObject : useDeviceAddrList.v) {4822 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {4823 if (name->symbol) {4824 useDeviceAddrNameList.push_back(*name);4825 }4826 }4827 }4828 CheckMultipleOccurrence(4829 listVars, useDeviceAddrNameList, clause->source, "USE_DEVICE_ADDR");4830 }4831}4832 4833void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {4834 CheckAllowedClause(llvm::omp::Clause::OMPC_is_device_ptr);4835 SymbolSourceMap currSymbols;4836 GetSymbolsInObjectList(x.v, currSymbols);4837 semantics::UnorderedSymbolSet listVars;4838 for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)) {4839 const auto &isDevicePtrClause{4840 std::get<parser::OmpClause::IsDevicePtr>(clause->u)};4841 const auto &isDevicePtrList{isDevicePtrClause.v};4842 SymbolSourceMap currSymbols;4843 GetSymbolsInObjectList(isDevicePtrList, currSymbols);4844 for (auto &[symbol, source] : currSymbols) {4845 if (!(IsBuiltinCPtr(*symbol))) {4846 context_.Say(clause->source,4847 "Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,4848 source.ToString());4849 } else if (!(IsDummy(*symbol))) {4850 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,4851 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "4852 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,4853 source.ToString());4854 } else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {4855 context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,4856 "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "4857 "that does not have the ALLOCATABLE, POINTER or VALUE attribute. "4858 "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,4859 source.ToString());4860 }4861 }4862 }4863}4864 4865void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {4866 CheckAllowedClause(llvm::omp::Clause::OMPC_has_device_addr);4867 SymbolSourceMap currSymbols;4868 GetSymbolsInObjectList(x.v, currSymbols);4869 semantics::UnorderedSymbolSet listVars;4870 for (auto [_, clause] :4871 FindClauses(llvm::omp::Clause::OMPC_has_device_addr)) {4872 const auto &hasDeviceAddrClause{4873 std::get<parser::OmpClause::HasDeviceAddr>(clause->u)};4874 const auto &hasDeviceAddrList{hasDeviceAddrClause.v};4875 std::list<parser::Name> hasDeviceAddrNameList;4876 for (const auto &ompObject : hasDeviceAddrList.v) {4877 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {4878 if (name->symbol) {4879 hasDeviceAddrNameList.push_back(*name);4880 }4881 }4882 }4883 }4884}4885 4886void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) {4887 CheckAllowedClause(llvm::omp::Clause::OMPC_enter);4888 if (!OmpVerifyModifiers(4889 x.v, llvm::omp::OMPC_enter, GetContext().clauseSource, context_)) {4890 return;4891 }4892 const parser::OmpObjectList &objList{std::get<parser::OmpObjectList>(x.v.t)};4893 SymbolSourceMap symbols;4894 GetSymbolsInObjectList(objList, symbols);4895 for (const auto &[symbol, source] : symbols) {4896 if (!IsExtendedListItem(*symbol)) {4897 context_.SayWithDecl(*symbol, source,4898 "'%s' must be a variable or a procedure"_err_en_US, symbol->name());4899 }4900 }4901}4902 4903void OmpStructureChecker::Enter(const parser::OmpClause::From &x) {4904 CheckAllowedClause(llvm::omp::Clause::OMPC_from);4905 if (!OmpVerifyModifiers(4906 x.v, llvm::omp::OMPC_from, GetContext().clauseSource, context_)) {4907 return;4908 }4909 4910 auto &modifiers{OmpGetModifiers(x.v)};4911 unsigned version{context_.langOptions().OpenMPVersion};4912 4913 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {4914 CheckIteratorModifier(*iter);4915 }4916 4917 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};4918 SymbolSourceMap symbols;4919 GetSymbolsInObjectList(objList, symbols);4920 CheckVariableListItem(symbols);4921 4922 // Ref: [4.5:109:19]4923 // If a list item is an array section it must specify contiguous storage.4924 if (version <= 45) {4925 for (const parser::OmpObject &object : objList.v) {4926 CheckIfContiguous(object);4927 }4928 }4929}4930 4931void OmpStructureChecker::Enter(const parser::OmpClause::To &x) {4932 CheckAllowedClause(llvm::omp::Clause::OMPC_to);4933 if (!OmpVerifyModifiers(4934 x.v, llvm::omp::OMPC_to, GetContext().clauseSource, context_)) {4935 return;4936 }4937 4938 auto &modifiers{OmpGetModifiers(x.v)};4939 unsigned version{context_.langOptions().OpenMPVersion};4940 4941 // The "to" clause is only allowed on "declare target" (pre-5.1), and4942 // "target update". In the former case it can take an extended list item,4943 // in the latter a variable (a locator).4944 4945 // The "declare target" construct (and the "to" clause on it) are already4946 // handled (in the declare-target checkers), so just look at "to" in "target4947 // update".4948 if (GetContext().directive == llvm::omp::OMPD_declare_target) {4949 return;4950 }4951 4952 assert(GetContext().directive == llvm::omp::OMPD_target_update);4953 if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {4954 CheckIteratorModifier(*iter);4955 }4956 4957 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};4958 SymbolSourceMap symbols;4959 GetSymbolsInObjectList(objList, symbols);4960 CheckVariableListItem(symbols);4961 4962 // Ref: [4.5:109:19]4963 // If a list item is an array section it must specify contiguous storage.4964 if (version <= 45) {4965 for (const parser::OmpObject &object : objList.v) {4966 CheckIfContiguous(object);4967 }4968 }4969}4970 4971void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {4972 // Don't call CheckAllowedClause, because it allows "ompx_bare" on4973 // a non-combined "target" directive (for reasons of splitting combined4974 // directives). In source code it's only allowed on "target teams".4975 if (GetContext().directive != llvm::omp::Directive::OMPD_target_teams) {4976 context_.Say(GetContext().clauseSource,4977 "%s clause is only allowed on combined TARGET TEAMS"_err_en_US,4978 parser::ToUpperCaseLetters(getClauseName(llvm::omp::OMPC_ompx_bare)));4979 }4980}4981 4982llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {4983 return llvm::omp::getOpenMPClauseName(clause);4984}4985 4986llvm::StringRef OmpStructureChecker::getDirectiveName(4987 llvm::omp::Directive directive) {4988 unsigned version{context_.langOptions().OpenMPVersion};4989 return llvm::omp::getOpenMPDirectiveName(directive, version);4990}4991 4992void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {4993 common::visit(4994 common::visitors{4995 [&](const common::Indirection<parser::ArrayElement> &elem) {4996 // Check if the base element is valid on Depend Clause4997 CheckDependList(elem.value().base);4998 },4999 [&](const common::Indirection<parser::StructureComponent> &comp) {5000 CheckDependList(comp.value().base);5001 },5002 [&](const common::Indirection<parser::CoindexedNamedObject> &) {5003 context_.Say(GetContext().clauseSource,5004 "Coarrays are not supported in DEPEND clause"_err_en_US);5005 },5006 [&](const parser::Name &) {},5007 },5008 d.u);5009}5010 5011// Called from both Reduction and Depend clause.5012void OmpStructureChecker::CheckArraySection(5013 const parser::ArrayElement &arrayElement, const parser::Name &name,5014 const llvm::omp::Clause clause) {5015 // Sometimes substring operations are incorrectly parsed as array accesses.5016 // Detect this by looking for array accesses on character variables which are5017 // not arrays.5018 bool isSubstring{false};5019 // Cannot analyze a base of an assumed-size array on its own. If we know5020 // this is an array (assumed-size or not) we can ignore it, since we're5021 // looking for strings.5022 if (!IsAssumedSizeArray(*name.symbol)) {5023 evaluate::ExpressionAnalyzer ea{context_};5024 if (MaybeExpr expr = ea.Analyze(arrayElement.base)) {5025 if (expr->Rank() == 0) {5026 // Not an array: rank 05027 if (std::optional<evaluate::DynamicType> type = expr->GetType()) {5028 if (type->category() == evaluate::TypeCategory::Character) {5029 // Substrings are explicitly denied by the standard [6.0:163:9-11].5030 // This is supported as an extension. This restriction was added in5031 // OpenMP 5.2.5032 isSubstring = true;5033 context_.Say(GetContext().clauseSource,5034 "The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2."_port_en_US);5035 } else {5036 llvm_unreachable(5037 "Array indexing on a variable that isn't an array");5038 }5039 }5040 }5041 }5042 }5043 if (!arrayElement.subscripts.empty()) {5044 for (const auto &subscript : arrayElement.subscripts) {5045 if (const auto *triplet{5046 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {5047 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {5048 std::optional<int64_t> strideVal{std::nullopt};5049 if (const auto &strideExpr = std::get<2>(triplet->t)) {5050 // OpenMP 6.0 Section 5.2.5: Array Sections5051 // Restrictions: if a stride expression is specified it must be5052 // positive. A stride of 0 doesn't make sense.5053 strideVal = GetIntValue(strideExpr);5054 if (strideVal && *strideVal < 1) {5055 context_.Say(GetContext().clauseSource,5056 "'%s' in %s clause must have a positive stride"_err_en_US,5057 name.ToString(),5058 parser::ToUpperCaseLetters(getClauseName(clause).str()));5059 }5060 if (isSubstring) {5061 context_.Say(GetContext().clauseSource,5062 "Cannot specify a step for a substring"_err_en_US);5063 }5064 }5065 const auto &lower{std::get<0>(triplet->t)};5066 const auto &upper{std::get<1>(triplet->t)};5067 if (lower && upper) {5068 const auto lval{GetIntValue(lower)};5069 const auto uval{GetIntValue(upper)};5070 if (lval && uval) {5071 int64_t sectionLen = *uval - *lval;5072 if (strideVal) {5073 sectionLen = sectionLen / *strideVal;5074 }5075 5076 if (sectionLen < 1) {5077 context_.Say(GetContext().clauseSource,5078 "'%s' in %s clause"5079 " is a zero size array section"_err_en_US,5080 name.ToString(),5081 parser::ToUpperCaseLetters(getClauseName(clause).str()));5082 break;5083 }5084 }5085 }5086 }5087 } else if (std::get_if<parser::IntExpr>(&subscript.u)) {5088 // base(n) is valid as an array index but not as a substring operation5089 if (isSubstring) {5090 context_.Say(GetContext().clauseSource,5091 "Substrings must be in the form parent-string(lb:ub)"_err_en_US);5092 }5093 }5094 }5095 }5096}5097 5098void OmpStructureChecker::CheckIntentInPointer(5099 SymbolSourceMap &symbols, llvm::omp::Clause clauseId) {5100 for (auto &[symbol, source] : symbols) {5101 if (IsPointer(*symbol) && IsIntentIn(*symbol)) {5102 context_.Say(source,5103 "Pointer '%s' with the INTENT(IN) attribute may not appear in a %s clause"_err_en_US,5104 symbol->name(),5105 parser::ToUpperCaseLetters(getClauseName(clauseId).str()));5106 }5107 }5108}5109 5110void OmpStructureChecker::CheckProcedurePointer(5111 SymbolSourceMap &symbols, llvm::omp::Clause clause) {5112 for (const auto &[symbol, source] : symbols) {5113 if (IsProcedurePointer(*symbol)) {5114 context_.Say(source,5115 "Procedure pointer '%s' may not appear in a %s clause"_err_en_US,5116 symbol->name(),5117 parser::ToUpperCaseLetters(getClauseName(clause).str()));5118 }5119 }5120}5121 5122void OmpStructureChecker::CheckCrayPointee(5123 const parser::OmpObjectList &objectList, llvm::StringRef clause,5124 bool suggestToUseCrayPointer) {5125 SymbolSourceMap symbols;5126 GetSymbolsInObjectList(objectList, symbols);5127 for (auto it{symbols.begin()}; it != symbols.end(); ++it) {5128 const auto *symbol{it->first};5129 const auto source{it->second};5130 if (symbol->test(Symbol::Flag::CrayPointee)) {5131 std::string suggestionMsg = "";5132 if (suggestToUseCrayPointer)5133 suggestionMsg = ", use Cray Pointer '" +5134 semantics::GetCrayPointer(*symbol).name().ToString() + "' instead";5135 context_.Say(source,5136 "Cray Pointee '%s' may not appear in %s clause%s"_err_en_US,5137 symbol->name(), clause.str(), suggestionMsg);5138 }5139 }5140}5141 5142void OmpStructureChecker::GetSymbolsInObjectList(5143 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {5144 for (const auto &ompObject : objectList.v) {5145 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {5146 if (const auto *symbol{name->symbol}) {5147 if (const auto *commonBlockDetails{5148 symbol->detailsIf<CommonBlockDetails>()}) {5149 for (const auto &object : commonBlockDetails->objects()) {5150 symbols.emplace(&object->GetUltimate(), name->source);5151 }5152 } else {5153 symbols.emplace(&symbol->GetUltimate(), name->source);5154 }5155 }5156 }5157 }5158}5159 5160void OmpStructureChecker::CheckDefinableObjects(5161 SymbolSourceMap &symbols, const llvm::omp::Clause clause) {5162 for (auto &[symbol, source] : symbols) {5163 if (auto msg{WhyNotDefinable(source, context_.FindScope(source),5164 DefinabilityFlags{}, *symbol)}) {5165 context_5166 .Say(source,5167 "Variable '%s' on the %s clause is not definable"_err_en_US,5168 symbol->name(),5169 parser::ToUpperCaseLetters(getClauseName(clause).str()))5170 .Attach(std::move(msg->set_severity(parser::Severity::Because)));5171 }5172 }5173}5174 5175void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(5176 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,5177 const llvm::omp::Clause currClause) {5178 SymbolSourceMap enclosingSymbols;5179 auto range{dirClauseTriple.equal_range(GetContext().directive)};5180 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {5181 auto enclosingDir{dirIter->second.first};5182 auto enclosingClauseSet{dirIter->second.second};5183 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {5184 for (auto it{enclosingContext->clauseInfo.begin()};5185 it != enclosingContext->clauseInfo.end(); ++it) {5186 if (enclosingClauseSet.test(it->first)) {5187 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {5188 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);5189 }5190 }5191 }5192 5193 // Check if the symbols in current context are private in outer context5194 for (auto &[symbol, source] : currSymbols) {5195 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {5196 context_.Say(source,5197 "%s variable '%s' is PRIVATE in outer context"_err_en_US,5198 parser::ToUpperCaseLetters(getClauseName(currClause).str()),5199 symbol->name());5200 }5201 }5202 }5203 }5204}5205 5206bool OmpStructureChecker::CheckTargetBlockOnlyTeams(5207 const parser::Block &block) {5208 bool nestedTeams{false};5209 5210 if (!block.empty()) {5211 auto it{block.begin()};5212 if (const auto *ompConstruct{5213 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {5214 if (const auto *ompBlockConstruct{5215 std::get_if<parser::OmpBlockConstruct>(&ompConstruct->u)}) {5216 llvm::omp::Directive dirId{ompBlockConstruct->BeginDir().DirId()};5217 if (dirId == llvm::omp::Directive::OMPD_teams) {5218 nestedTeams = true;5219 }5220 } else if (const auto *ompLoopConstruct{5221 std::get_if<parser::OpenMPLoopConstruct>(5222 &ompConstruct->u)}) {5223 llvm::omp::Directive dirId{ompLoopConstruct->BeginDir().DirId()};5224 if (llvm::omp::topTeamsSet.test(dirId)) {5225 nestedTeams = true;5226 }5227 }5228 }5229 5230 if (nestedTeams && ++it == block.end()) {5231 return true;5232 }5233 }5234 5235 return false;5236}5237 5238void OmpStructureChecker::CheckWorkshareBlockStmts(5239 const parser::Block &block, parser::CharBlock source) {5240 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};5241 5242 for (auto it{block.begin()}; it != block.end(); ++it) {5243 if (parser::Unwrap<parser::AssignmentStmt>(*it) ||5244 parser::Unwrap<parser::ForallStmt>(*it) ||5245 parser::Unwrap<parser::ForallConstruct>(*it) ||5246 parser::Unwrap<parser::WhereStmt>(*it) ||5247 parser::Unwrap<parser::WhereConstruct>(*it)) {5248 parser::Walk(*it, ompWorkshareBlockChecker);5249 } else if (const auto *ompConstruct{5250 parser::Unwrap<parser::OpenMPConstruct>(*it)}) {5251 if (const auto *ompAtomicConstruct{5252 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {5253 // Check if assignment statements in the enclosing OpenMP Atomic5254 // construct are allowed in the Workshare construct5255 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);5256 } else if (const auto *ompCriticalConstruct{5257 std::get_if<parser::OpenMPCriticalConstruct>(5258 &ompConstruct->u)}) {5259 // All the restrictions on the Workshare construct apply to the5260 // statements in the enclosing critical constructs5261 const auto &criticalBlock{5262 std::get<parser::Block>(ompCriticalConstruct->t)};5263 CheckWorkshareBlockStmts(criticalBlock, source);5264 } else {5265 // Check if OpenMP constructs enclosed in the Workshare construct are5266 // 'Parallel' constructs5267 auto currentDir{llvm::omp::Directive::OMPD_unknown};5268 if (const auto *ompBlockConstruct{5269 std::get_if<parser::OmpBlockConstruct>(&ompConstruct->u)}) {5270 currentDir = ompBlockConstruct->BeginDir().DirId();5271 } else if (const auto *ompLoopConstruct{5272 std::get_if<parser::OpenMPLoopConstruct>(5273 &ompConstruct->u)}) {5274 currentDir = ompLoopConstruct->BeginDir().DirId();5275 } else if (const auto *ompSectionsConstruct{5276 std::get_if<parser::OpenMPSectionsConstruct>(5277 &ompConstruct->u)}) {5278 currentDir = ompSectionsConstruct->BeginDir().DirId();5279 }5280 5281 if (!llvm::omp::topParallelSet.test(currentDir)) {5282 context_.Say(source,5283 "OpenMP constructs enclosed in WORKSHARE construct may consist "5284 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);5285 }5286 }5287 } else {5288 context_.Say(source,5289 "The structured block in a WORKSHARE construct may consist of only "5290 "SCALAR or ARRAY assignments, FORALL or WHERE statements, "5291 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);5292 }5293 }5294}5295 5296void OmpStructureChecker::CheckWorkdistributeBlockStmts(5297 const parser::Block &block, parser::CharBlock source) {5298 unsigned version{context_.langOptions().OpenMPVersion};5299 unsigned since{60};5300 if (version < since)5301 context_.Say(source,5302 "WORKDISTRIBUTE construct is not allowed in %s, %s"_err_en_US,5303 ThisVersion(version), TryVersion(since));5304 5305 OmpWorkdistributeBlockChecker ompWorkdistributeBlockChecker{context_, source};5306 5307 for (auto it{block.begin()}; it != block.end(); ++it) {5308 if (parser::Unwrap<parser::AssignmentStmt>(*it)) {5309 parser::Walk(*it, ompWorkdistributeBlockChecker);5310 } else {5311 context_.Say(source,5312 "The structured block in a WORKDISTRIBUTE construct may consist of only SCALAR or ARRAY assignments"_err_en_US);5313 }5314 }5315}5316 5317void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {5318 if (!IsContiguous(context_, object).value_or(true)) { // known discontiguous5319 const parser::Name *name{GetObjectName(object)};5320 assert(name && "Expecting name component");5321 context_.Say(name->source,5322 "Reference to '%s' must be a contiguous object"_err_en_US,5323 name->ToString());5324 }5325}5326 5327namespace {5328struct NameHelper {5329 template <typename T>5330 static const parser::Name *Visit(const common::Indirection<T> &x) {5331 return Visit(x.value());5332 }5333 static const parser::Name *Visit(const parser::Substring &x) {5334 return Visit(std::get<parser::DataRef>(x.t));5335 }5336 static const parser::Name *Visit(const parser::ArrayElement &x) {5337 return Visit(x.base);5338 }5339 static const parser::Name *Visit(const parser::Designator &x) {5340 return common::visit([](auto &&s) { return Visit(s); }, x.u);5341 }5342 static const parser::Name *Visit(const parser::DataRef &x) {5343 return common::visit([](auto &&s) { return Visit(s); }, x.u);5344 }5345 static const parser::Name *Visit(const parser::OmpObject &x) {5346 return common::visit([](auto &&s) { return Visit(s); }, x.u);5347 }5348 template <typename T> static const parser::Name *Visit(T &&) {5349 return nullptr;5350 }5351 static const parser::Name *Visit(const parser::Name &x) { return &x; }5352};5353} // namespace5354 5355const parser::Name *OmpStructureChecker::GetObjectName(5356 const parser::OmpObject &object) {5357 return NameHelper::Visit(object);5358}5359 5360void OmpStructureChecker::Enter(5361 const parser::OmpClause::AtomicDefaultMemOrder &x) {5362 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_atomic_default_mem_order);5363}5364 5365void OmpStructureChecker::Enter(const parser::OmpClause::DeviceSafesync &x) {5366 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_device_safesync);5367}5368 5369void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {5370 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_dynamic_allocators);5371}5372 5373void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {5374 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_reverse_offload);5375}5376 5377void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {5378 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_address);5379}5380 5381void OmpStructureChecker::Enter(5382 const parser::OmpClause::UnifiedSharedMemory &x) {5383 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);5384}5385 5386void OmpStructureChecker::Enter(const parser::OmpClause::SelfMaps &x) {5387 CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_self_maps);5388}5389 5390void OmpStructureChecker::Enter(const parser::OpenMPInteropConstruct &x) {5391 bool isDependClauseOccured{false};5392 int targetCount{0}, targetSyncCount{0};5393 const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};5394 std::set<const Symbol *> objectSymbolList;5395 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_interop);5396 const auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};5397 for (const auto &clause : clauseList->v) {5398 common::visit(5399 common::visitors{5400 [&](const parser::OmpClause::Init &initClause) {5401 if (OmpVerifyModifiers(initClause.v, llvm::omp::OMPC_init,5402 GetContext().directiveSource, context_)) {5403 5404 auto &modifiers{OmpGetModifiers(initClause.v)};5405 auto &&interopTypeModifier{5406 OmpGetRepeatableModifier<parser::OmpInteropType>(5407 modifiers)};5408 for (const auto &it : interopTypeModifier) {5409 if (it->v == parser::OmpInteropType::Value::TargetSync) {5410 ++targetSyncCount;5411 } else {5412 ++targetCount;5413 }5414 }5415 }5416 const auto &interopVar{parser::Unwrap<parser::OmpObject>(5417 std::get<parser::OmpObject>(initClause.v.t))};5418 const auto *name{parser::Unwrap<parser::Name>(interopVar)};5419 const auto *objectSymbol{name->symbol};5420 if (llvm::is_contained(objectSymbolList, objectSymbol)) {5421 context_.Say(GetContext().directiveSource,5422 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);5423 } else {5424 objectSymbolList.insert(objectSymbol);5425 }5426 },5427 [&](const parser::OmpClause::Depend &dependClause) {5428 isDependClauseOccured = true;5429 },5430 [&](const parser::OmpClause::Destroy &destroyClause) {5431 const auto &interopVar{5432 parser::Unwrap<parser::OmpObject>(destroyClause.v)};5433 const auto *name{parser::Unwrap<parser::Name>(interopVar)};5434 const auto *objectSymbol{name->symbol};5435 if (llvm::is_contained(objectSymbolList, objectSymbol)) {5436 context_.Say(GetContext().directiveSource,5437 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);5438 } else {5439 objectSymbolList.insert(objectSymbol);5440 }5441 },5442 [&](const parser::OmpClause::Use &useClause) {5443 const auto &interopVar{5444 parser::Unwrap<parser::OmpObject>(useClause.v)};5445 const auto *name{parser::Unwrap<parser::Name>(interopVar)};5446 const auto *objectSymbol{name->symbol};5447 if (llvm::is_contained(objectSymbolList, objectSymbol)) {5448 context_.Say(GetContext().directiveSource,5449 "Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);5450 } else {5451 objectSymbolList.insert(objectSymbol);5452 }5453 },5454 [&](const auto &) {},5455 },5456 clause.u);5457 }5458 if (targetCount > 1 || targetSyncCount > 1) {5459 context_.Say(GetContext().directiveSource,5460 "Each interop-type may be specified at most once."_err_en_US);5461 }5462 if (isDependClauseOccured && !targetSyncCount) {5463 context_.Say(GetContext().directiveSource,5464 "A DEPEND clause can only appear on the directive if the interop-type includes TARGETSYNC"_err_en_US);5465 }5466}5467 5468void OmpStructureChecker::Leave(const parser::OpenMPInteropConstruct &) {5469 dirContext_.pop_back();5470}5471 5472void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {5473 CheckAllowedClause(clause);5474 5475 if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {5476 // Check that it does not appear after a device construct5477 if (deviceConstructFound_) {5478 context_.Say(GetContext().clauseSource,5479 "REQUIRES directive with '%s' clause found lexically after device "5480 "construct"_err_en_US,5481 parser::ToUpperCaseLetters(getClauseName(clause).str()));5482 }5483 }5484}5485 5486void OmpStructureChecker::Enter(const parser::OpenMPMisplacedEndDirective &x) {5487 context_.Say(x.DirName().source, "Misplaced OpenMP end-directive"_err_en_US);5488 PushContextAndClauseSets(5489 x.DirName().source, llvm::omp::Directive::OMPD_unknown);5490}5491 5492void OmpStructureChecker::Leave(const parser::OpenMPMisplacedEndDirective &x) {5493 dirContext_.pop_back();5494}5495 5496void OmpStructureChecker::Enter(const parser::OpenMPInvalidDirective &x) {5497 context_.Say(x.source, "Invalid OpenMP directive"_err_en_US);5498 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_unknown);5499}5500 5501void OmpStructureChecker::Leave(const parser::OpenMPInvalidDirective &x) {5502 dirContext_.pop_back();5503}5504 5505// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.5506#define CHECK_SIMPLE_CLAUSE(X, Y) \5507 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \5508 CheckAllowedClause(llvm::omp::Clause::Y); \5509 }5510 5511#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \5512 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \5513 CheckAllowedClause(llvm::omp::Clause::Y); \5514 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \5515 }5516 5517#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \5518 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \5519 CheckAllowedClause(llvm::omp::Clause::Y); \5520 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \5521 }5522 5523// Following clauses do not have a separate node in parse-tree.h.5524CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent)5525CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)5526CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)5527CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)5528CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)5529CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)5530CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)5531CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)5532CHECK_SIMPLE_CLAUSE(Collector, OMPC_collector)5533CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)5534CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains)5535CHECK_SIMPLE_CLAUSE(Default, OMPC_default)5536CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)5537CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)5538CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)5539CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)5540CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)5541CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)5542CHECK_SIMPLE_CLAUSE(Final, OMPC_final)5543CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)5544CHECK_SIMPLE_CLAUSE(Full, OMPC_full)5545CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)5546CHECK_SIMPLE_CLAUSE(GraphId, OMPC_graph_id)5547CHECK_SIMPLE_CLAUSE(GraphReset, OMPC_graph_reset)5548CHECK_SIMPLE_CLAUSE(Groupprivate, OMPC_groupprivate)5549CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)5550CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)5551CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)5552CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)5553CHECK_SIMPLE_CLAUSE(Inductor, OMPC_inductor)5554CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer)5555CHECK_SIMPLE_CLAUSE(Init, OMPC_init)5556CHECK_SIMPLE_CLAUSE(Link, OMPC_link)5557CHECK_SIMPLE_CLAUSE(Match, OMPC_match)5558CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)5559CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)5560CHECK_SIMPLE_CLAUSE(Message, OMPC_message)5561CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)5562CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)5563CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)5564CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs)5565CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp)5566CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines)5567CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism)5568CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)5569CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)5570CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks)5571CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)5572CHECK_SIMPLE_CLAUSE(Order, OMPC_order)5573CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise)5574CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)5575CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation)5576CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)5577CHECK_SIMPLE_CLAUSE(Read, OMPC_read)5578CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)5579CHECK_SIMPLE_CLAUSE(Release, OMPC_release)5580CHECK_SIMPLE_CLAUSE(Replayable, OMPC_replayable)5581CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)5582CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)5583CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)5584CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)5585CHECK_SIMPLE_CLAUSE(Threadset, OMPC_threadset)5586CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)5587CHECK_SIMPLE_CLAUSE(Transparent, OMPC_transparent)5588CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)5589CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)5590CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)5591CHECK_SIMPLE_CLAUSE(Use, OMPC_use)5592CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)5593CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)5594CHECK_SIMPLE_CLAUSE(Write, OMPC_write)5595 5596CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)5597CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)5598CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)5599CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)5600CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)5601 5602CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)5603CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)5604CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)5605 5606} // namespace Fortran::semantics5607