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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "check-omp-structure.h" 10 #include "flang/Parser/parse-tree.h" 11 #include "flang/Semantics/tools.h" 12 #include <algorithm> 13 14 namespace Fortran::semantics { 15 16 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. 17 #define CHECK_SIMPLE_CLAUSE(X, Y) \ 18 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \ 19 CheckAllowed(llvm::omp::Clause::Y); \ 20 } 21 22 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \ 23 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ 24 CheckAllowed(llvm::omp::Clause::Y); \ 25 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \ 26 } 27 28 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \ 29 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ 30 CheckAllowed(llvm::omp::Clause::Y); \ 31 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \ 32 } 33 34 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'. 35 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \ 36 void OmpStructureChecker::Enter(const parser::X &) { \ 37 CheckAllowed(llvm::omp::Y); \ 38 } 39 40 // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment 41 // statements and the expressions enclosed in an OpenMP Workshare construct 42 class OmpWorkshareBlockChecker { 43 public: 44 OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source) 45 : context_{context}, source_{source} {} 46 47 template <typename T> bool Pre(const T &) { return true; } 48 template <typename T> void Post(const T &) {} 49 50 bool Pre(const parser::AssignmentStmt &assignment) { 51 const auto &var{std::get<parser::Variable>(assignment.t)}; 52 const auto &expr{std::get<parser::Expr>(assignment.t)}; 53 const auto *lhs{GetExpr(var)}; 54 const auto *rhs{GetExpr(expr)}; 55 if (lhs && rhs) { 56 Tristate isDefined{semantics::IsDefinedAssignment( 57 lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())}; 58 if (isDefined == Tristate::Yes) { 59 context_.Say(expr.source, 60 "Defined assignment statement is not " 61 "allowed in a WORKSHARE construct"_err_en_US); 62 } 63 } 64 return true; 65 } 66 67 bool Pre(const parser::Expr &expr) { 68 if (const auto *e{GetExpr(expr)}) { 69 for (const Symbol &symbol : evaluate::CollectSymbols(*e)) { 70 const Symbol &root{GetAssociationRoot(symbol)}; 71 if (IsFunction(root) && 72 !(root.attrs().test(Attr::ELEMENTAL) || 73 root.attrs().test(Attr::INTRINSIC))) { 74 context_.Say(expr.source, 75 "User defined non-ELEMENTAL function " 76 "'%s' is not allowed in a WORKSHARE construct"_err_en_US, 77 root.name()); 78 } 79 } 80 } 81 return false; 82 } 83 84 private: 85 SemanticsContext &context_; 86 parser::CharBlock source_; 87 }; 88 89 class OmpCycleChecker { 90 public: 91 OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel) 92 : context_{context}, cycleLevel_{cycleLevel} {} 93 94 template <typename T> bool Pre(const T &) { return true; } 95 template <typename T> void Post(const T &) {} 96 97 bool Pre(const parser::DoConstruct &dc) { 98 cycleLevel_--; 99 const auto &labelName{std::get<0>(std::get<0>(dc.t).statement.t)}; 100 if (labelName) { 101 labelNamesandLevels_.emplace(labelName.value().ToString(), cycleLevel_); 102 } 103 return true; 104 } 105 106 bool Pre(const parser::CycleStmt &cyclestmt) { 107 std::map<std::string, std::int64_t>::iterator it; 108 bool err{false}; 109 if (cyclestmt.v) { 110 it = labelNamesandLevels_.find(cyclestmt.v->source.ToString()); 111 err = (it != labelNamesandLevels_.end() && it->second > 0); 112 } 113 if (cycleLevel_ > 0 || err) { 114 context_.Say(*cycleSource_, 115 "CYCLE statement to non-innermost associated loop of an OpenMP DO construct"_err_en_US); 116 } 117 return true; 118 } 119 120 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) { 121 cycleSource_ = &actionstmt.source; 122 return true; 123 } 124 125 private: 126 SemanticsContext &context_; 127 const parser::CharBlock *cycleSource_; 128 std::int64_t cycleLevel_; 129 std::map<std::string, std::int64_t> labelNamesandLevels_; 130 }; 131 132 bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { 133 // Definition of close nesting: 134 // 135 // `A region nested inside another region with no parallel region nested 136 // between them` 137 // 138 // Examples: 139 // non-parallel construct 1 140 // non-parallel construct 2 141 // parallel construct 142 // construct 3 143 // In the above example, construct 3 is NOT closely nested inside construct 1 144 // or 2 145 // 146 // non-parallel construct 1 147 // non-parallel construct 2 148 // construct 3 149 // In the above example, construct 3 is closely nested inside BOTH construct 1 150 // and 2 151 // 152 // Algorithm: 153 // Starting from the parent context, Check in a bottom-up fashion, each level 154 // of the context stack. If we have a match for one of the (supplied) 155 // violating directives, `close nesting` is satisfied. If no match is there in 156 // the entire stack, `close nesting` is not satisfied. If at any level, a 157 // `parallel` region is found, `close nesting` is not satisfied. 158 159 if (CurrentDirectiveIsNested()) { 160 int index = dirContext_.size() - 2; 161 while (index != -1) { 162 if (set.test(dirContext_[index].directive)) { 163 return true; 164 } else if (llvm::omp::parallelSet.test(dirContext_[index].directive)) { 165 return false; 166 } 167 index--; 168 } 169 } 170 return false; 171 } 172 173 bool OmpStructureChecker::HasInvalidWorksharingNesting( 174 const parser::CharBlock &source, const OmpDirectiveSet &set) { 175 // set contains all the invalid closely nested directives 176 // for the given directive (`source` here) 177 if (IsCloselyNestedRegion(set)) { 178 context_.Say(source, 179 "A worksharing region may not be closely nested inside a " 180 "worksharing, explicit task, taskloop, critical, ordered, atomic, or " 181 "master region"_err_en_US); 182 return true; 183 } 184 return false; 185 } 186 187 void OmpStructureChecker::HasInvalidDistributeNesting( 188 const parser::OpenMPLoopConstruct &x) { 189 bool violation{false}; 190 191 OmpDirectiveSet distributeSet{llvm::omp::Directive::OMPD_distribute, 192 llvm::omp::Directive::OMPD_distribute_parallel_do, 193 llvm::omp::Directive::OMPD_distribute_parallel_do_simd, 194 llvm::omp::Directive::OMPD_distribute_parallel_for, 195 llvm::omp::Directive::OMPD_distribute_parallel_for_simd, 196 llvm::omp::Directive::OMPD_distribute_simd}; 197 198 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 199 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 200 if (distributeSet.test(beginDir.v)) { 201 // `distribute` region has to be nested 202 if (!CurrentDirectiveIsNested()) { 203 violation = true; 204 } else { 205 // `distribute` region has to be strictly nested inside `teams` 206 if (!llvm::omp::teamSet.test(GetContextParent().directive)) { 207 violation = true; 208 } 209 } 210 } 211 if (violation) { 212 context_.Say(beginDir.source, 213 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` region."_err_en_US); 214 } 215 } 216 217 void OmpStructureChecker::HasInvalidTeamsNesting( 218 const llvm::omp::Directive &dir, const parser::CharBlock &source) { 219 OmpDirectiveSet allowedSet{llvm::omp::Directive::OMPD_parallel, 220 llvm::omp::Directive::OMPD_parallel_do, 221 llvm::omp::Directive::OMPD_parallel_do_simd, 222 llvm::omp::Directive::OMPD_parallel_for, 223 llvm::omp::Directive::OMPD_parallel_for_simd, 224 llvm::omp::Directive::OMPD_parallel_master, 225 llvm::omp::Directive::OMPD_parallel_master_taskloop, 226 llvm::omp::Directive::OMPD_parallel_master_taskloop_simd, 227 llvm::omp::Directive::OMPD_parallel_sections, 228 llvm::omp::Directive::OMPD_parallel_workshare, 229 llvm::omp::Directive::OMPD_distribute, 230 llvm::omp::Directive::OMPD_distribute_parallel_do, 231 llvm::omp::Directive::OMPD_distribute_parallel_do_simd, 232 llvm::omp::Directive::OMPD_distribute_parallel_for, 233 llvm::omp::Directive::OMPD_distribute_parallel_for_simd, 234 llvm::omp::Directive::OMPD_distribute_simd}; 235 236 if (!allowedSet.test(dir)) { 237 context_.Say(source, 238 "Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region."_err_en_US); 239 } 240 } 241 242 void OmpStructureChecker::CheckPredefinedAllocatorRestriction( 243 const parser::CharBlock &source, const parser::Name &name) { 244 if (const auto *symbol{name.symbol}) { 245 const auto *commonBlock{FindCommonBlockContaining(*symbol)}; 246 const auto &scope{context_.FindScope(symbol->name())}; 247 const Scope &containingScope{GetProgramUnitContaining(scope)}; 248 if (!isPredefinedAllocator && 249 (IsSave(*symbol) || commonBlock || 250 containingScope.kind() == Scope::Kind::Module)) { 251 context_.Say(source, 252 "If list items within the ALLOCATE directive have the " 253 "SAVE attribute, are a common block name, or are " 254 "declared in the scope of a module, then only " 255 "predefined memory allocator parameters can be used " 256 "in the allocator clause"_err_en_US); 257 } 258 } 259 } 260 261 void OmpStructureChecker::CheckPredefinedAllocatorRestriction( 262 const parser::CharBlock &source, 263 const parser::OmpObjectList &ompObjectList) { 264 for (const auto &ompObject : ompObjectList.v) { 265 std::visit( 266 common::visitors{ 267 [&](const parser::Designator &designator) { 268 if (const auto *dataRef{ 269 std::get_if<parser::DataRef>(&designator.u)}) { 270 if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) { 271 CheckPredefinedAllocatorRestriction(source, *name); 272 } 273 } 274 }, 275 [&](const parser::Name &name) { 276 CheckPredefinedAllocatorRestriction(source, name); 277 }, 278 }, 279 ompObject.u); 280 } 281 } 282 283 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) { 284 // Simd Construct with Ordered Construct Nesting check 285 // We cannot use CurrentDirectiveIsNested() here because 286 // PushContextAndClauseSets() has not been called yet, it is 287 // called individually for each construct. Therefore a 288 // dirContext_ size `1` means the current construct is nested 289 if (dirContext_.size() >= 1) { 290 if (GetDirectiveNest(SIMDNest) > 0) { 291 CheckSIMDNest(x); 292 } 293 if (GetDirectiveNest(TargetNest) > 0) { 294 CheckTargetNest(x); 295 } 296 } 297 } 298 299 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { 300 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 301 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 302 303 // check matching, End directive is optional 304 if (const auto &endLoopDir{ 305 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) { 306 const auto &endDir{ 307 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)}; 308 309 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir); 310 } 311 312 PushContextAndClauseSets(beginDir.source, beginDir.v); 313 if (llvm::omp::simdSet.test(GetContext().directive)) { 314 EnterDirectiveNest(SIMDNest); 315 } 316 317 if (beginDir.v == llvm::omp::Directive::OMPD_do) { 318 // 2.7.1 do-clause -> private-clause | 319 // firstprivate-clause | 320 // lastprivate-clause | 321 // linear-clause | 322 // reduction-clause | 323 // schedule-clause | 324 // collapse-clause | 325 // ordered-clause 326 327 // nesting check 328 HasInvalidWorksharingNesting( 329 beginDir.source, llvm::omp::nestedWorkshareErrSet); 330 } 331 SetLoopInfo(x); 332 333 if (const auto &doConstruct{ 334 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 335 const auto &doBlock{std::get<parser::Block>(doConstruct->t)}; 336 CheckNoBranching(doBlock, beginDir.v, beginDir.source); 337 } 338 CheckDoWhile(x); 339 CheckLoopItrVariableIsInt(x); 340 CheckCycleConstraints(x); 341 HasInvalidDistributeNesting(x); 342 if (CurrentDirectiveIsNested() && 343 llvm::omp::teamSet.test(GetContextParent().directive)) { 344 HasInvalidTeamsNesting(beginDir.v, beginDir.source); 345 } 346 if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) || 347 (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) { 348 CheckDistLinear(x); 349 } 350 } 351 const parser::Name OmpStructureChecker::GetLoopIndex( 352 const parser::DoConstruct *x) { 353 using Bounds = parser::LoopControl::Bounds; 354 return std::get<Bounds>(x->GetLoopControl()->u).name.thing; 355 } 356 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { 357 if (const auto &loopConstruct{ 358 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 359 const parser::DoConstruct *loop{&*loopConstruct}; 360 if (loop && loop->IsDoNormal()) { 361 const parser::Name &itrVal{GetLoopIndex(loop)}; 362 SetLoopIv(itrVal.symbol); 363 } 364 } 365 } 366 void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) { 367 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 368 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 369 if (beginDir.v == llvm::omp::Directive::OMPD_do) { 370 if (const auto &doConstruct{ 371 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 372 if (doConstruct.value().IsDoWhile()) { 373 const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>( 374 doConstruct.value().t)}; 375 context_.Say(doStmt.source, 376 "The DO loop cannot be a DO WHILE with DO directive."_err_en_US); 377 } 378 } 379 } 380 } 381 382 void OmpStructureChecker::CheckLoopItrVariableIsInt( 383 const parser::OpenMPLoopConstruct &x) { 384 if (const auto &loopConstruct{ 385 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 386 387 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) { 388 if (loop->IsDoNormal()) { 389 const parser::Name &itrVal{GetLoopIndex(loop)}; 390 if (itrVal.symbol) { 391 const auto *type{itrVal.symbol->GetType()}; 392 if (!type->IsNumeric(TypeCategory::Integer)) { 393 context_.Say(itrVal.source, 394 "The DO loop iteration" 395 " variable must be of the type integer."_err_en_US, 396 itrVal.ToString()); 397 } 398 } 399 } 400 // Get the next DoConstruct if block is not empty. 401 const auto &block{std::get<parser::Block>(loop->t)}; 402 const auto it{block.begin()}; 403 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) 404 : nullptr; 405 } 406 } 407 } 408 409 void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) { 410 // Check the following: 411 // The only OpenMP constructs that can be encountered during execution of 412 // a simd region are the `atomic` construct, the `loop` construct, the `simd` 413 // construct and the `ordered` construct with the `simd` clause. 414 // TODO: Expand the check to include `LOOP` construct as well when it is 415 // supported. 416 417 // Check if the parent context has the SIMD clause 418 // Please note that we use GetContext() instead of GetContextParent() 419 // because PushContextAndClauseSets() has not been called on the 420 // current context yet. 421 // TODO: Check for declare simd regions. 422 bool eligibleSIMD{false}; 423 std::visit(Fortran::common::visitors{ 424 // Allow `!$OMP ORDERED SIMD` 425 [&](const parser::OpenMPBlockConstruct &c) { 426 const auto &beginBlockDir{ 427 std::get<parser::OmpBeginBlockDirective>(c.t)}; 428 const auto &beginDir{ 429 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 430 if (beginDir.v == llvm::omp::Directive::OMPD_ordered) { 431 const auto &clauses{ 432 std::get<parser::OmpClauseList>(beginBlockDir.t)}; 433 for (const auto &clause : clauses.v) { 434 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) { 435 eligibleSIMD = true; 436 break; 437 } 438 } 439 } 440 }, 441 [&](const parser::OpenMPSimpleStandaloneConstruct &c) { 442 const auto &dir{ 443 std::get<parser::OmpSimpleStandaloneDirective>(c.t)}; 444 if (dir.v == llvm::omp::Directive::OMPD_ordered) { 445 const auto &clauses{std::get<parser::OmpClauseList>(c.t)}; 446 for (const auto &clause : clauses.v) { 447 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) { 448 eligibleSIMD = true; 449 break; 450 } 451 } 452 } 453 }, 454 // Allowing SIMD construct 455 [&](const parser::OpenMPLoopConstruct &c) { 456 const auto &beginLoopDir{ 457 std::get<parser::OmpBeginLoopDirective>(c.t)}; 458 const auto &beginDir{ 459 std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 460 if ((beginDir.v == llvm::omp::Directive::OMPD_simd) || 461 (beginDir.v == llvm::omp::Directive::OMPD_do_simd)) { 462 eligibleSIMD = true; 463 } 464 }, 465 [&](const parser::OpenMPAtomicConstruct &c) { 466 // Allow `!$OMP ATOMIC` 467 eligibleSIMD = true; 468 }, 469 [&](const auto &c) {}, 470 }, 471 c.u); 472 if (!eligibleSIMD) { 473 context_.Say(parser::FindSourceLocation(c), 474 "The only OpenMP constructs that can be encountered during execution " 475 "of a 'SIMD'" 476 " region are the `ATOMIC` construct, the `LOOP` construct, the `SIMD`" 477 " construct and the `ORDERED` construct with the `SIMD` clause."_err_en_US); 478 } 479 } 480 481 void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) { 482 // 2.12.5 Target Construct Restriction 483 bool eligibleTarget{true}; 484 llvm::omp::Directive ineligibleTargetDir; 485 std::visit( 486 common::visitors{ 487 [&](const parser::OpenMPBlockConstruct &c) { 488 const auto &beginBlockDir{ 489 std::get<parser::OmpBeginBlockDirective>(c.t)}; 490 const auto &beginDir{ 491 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 492 if (beginDir.v == llvm::omp::Directive::OMPD_target_data) { 493 eligibleTarget = false; 494 ineligibleTargetDir = beginDir.v; 495 } 496 }, 497 [&](const parser::OpenMPStandaloneConstruct &c) { 498 std::visit( 499 common::visitors{ 500 [&](const parser::OpenMPSimpleStandaloneConstruct &c) { 501 const auto &dir{ 502 std::get<parser::OmpSimpleStandaloneDirective>(c.t)}; 503 if (dir.v == llvm::omp::Directive::OMPD_target_update || 504 dir.v == 505 llvm::omp::Directive::OMPD_target_enter_data || 506 dir.v == 507 llvm::omp::Directive::OMPD_target_exit_data) { 508 eligibleTarget = false; 509 ineligibleTargetDir = dir.v; 510 } 511 }, 512 [&](const auto &c) {}, 513 }, 514 c.u); 515 }, 516 [&](const auto &c) {}, 517 }, 518 c.u); 519 if (!eligibleTarget) { 520 context_.Say(parser::FindSourceLocation(c), 521 "If %s directive is nested inside TARGET region, the behaviour " 522 "is unspecified"_port_en_US, 523 parser::ToUpperCaseLetters( 524 getDirectiveName(ineligibleTargetDir).str())); 525 } 526 } 527 528 std::int64_t OmpStructureChecker::GetOrdCollapseLevel( 529 const parser::OpenMPLoopConstruct &x) { 530 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 531 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 532 std::int64_t orderedCollapseLevel{1}; 533 std::int64_t orderedLevel{0}; 534 std::int64_t collapseLevel{0}; 535 536 for (const auto &clause : clauseList.v) { 537 if (const auto *collapseClause{ 538 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) { 539 if (const auto v{GetIntValue(collapseClause->v)}) { 540 collapseLevel = *v; 541 } 542 } 543 if (const auto *orderedClause{ 544 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) { 545 if (const auto v{GetIntValue(orderedClause->v)}) { 546 orderedLevel = *v; 547 } 548 } 549 } 550 if (orderedLevel >= collapseLevel) { 551 orderedCollapseLevel = orderedLevel; 552 } else { 553 orderedCollapseLevel = collapseLevel; 554 } 555 return orderedCollapseLevel; 556 } 557 558 void OmpStructureChecker::CheckCycleConstraints( 559 const parser::OpenMPLoopConstruct &x) { 560 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)}; 561 OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel}; 562 parser::Walk(x, ompCycleChecker); 563 } 564 565 void OmpStructureChecker::CheckDistLinear( 566 const parser::OpenMPLoopConstruct &x) { 567 568 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 569 const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 570 571 semantics::UnorderedSymbolSet indexVars; 572 573 // Collect symbols of all the variables from linear clauses 574 for (const auto &clause : clauses.v) { 575 if (const auto *linearClause{ 576 std::get_if<parser::OmpClause::Linear>(&clause.u)}) { 577 578 std::list<parser::Name> values; 579 // Get the variant type 580 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>( 581 linearClause->v.u)) { 582 const auto &withM{ 583 std::get<parser::OmpLinearClause::WithModifier>(linearClause->v.u)}; 584 values = withM.names; 585 } else { 586 const auto &withOutM{std::get<parser::OmpLinearClause::WithoutModifier>( 587 linearClause->v.u)}; 588 values = withOutM.names; 589 } 590 for (auto const &v : values) { 591 indexVars.insert(*(v.symbol)); 592 } 593 } 594 } 595 596 if (!indexVars.empty()) { 597 // Get collapse level, if given, to find which loops are "associated." 598 std::int64_t collapseVal{GetOrdCollapseLevel(x)}; 599 // Include the top loop if no collapse is specified 600 if (collapseVal == 0) { 601 collapseVal = 1; 602 } 603 604 // Match the loop index variables with the collected symbols from linear 605 // clauses. 606 if (const auto &loopConstruct{ 607 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 608 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) { 609 if (loop->IsDoNormal()) { 610 const parser::Name &itrVal{GetLoopIndex(loop)}; 611 if (itrVal.symbol) { 612 // Remove the symbol from the collcted set 613 indexVars.erase(*(itrVal.symbol)); 614 } 615 collapseVal--; 616 if (collapseVal == 0) { 617 break; 618 } 619 } 620 // Get the next DoConstruct if block is not empty. 621 const auto &block{std::get<parser::Block>(loop->t)}; 622 const auto it{block.begin()}; 623 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) 624 : nullptr; 625 } 626 } 627 628 // Show error for the remaining variables 629 for (auto var : indexVars) { 630 const Symbol &root{GetAssociationRoot(var)}; 631 context_.Say(parser::FindSourceLocation(x), 632 "Variable '%s' not allowed in `LINEAR` clause, only loop iterator can be specified in `LINEAR` clause of a construct combined with `DISTRIBUTE`"_err_en_US, 633 root.name()); 634 } 635 } 636 } 637 638 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) { 639 if (llvm::omp::simdSet.test(GetContext().directive)) { 640 ExitDirectiveNest(SIMDNest); 641 } 642 dirContext_.pop_back(); 643 } 644 645 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) { 646 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)}; 647 ResetPartialContext(dir.source); 648 switch (dir.v) { 649 // 2.7.1 end-do -> END DO [nowait-clause] 650 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause] 651 case llvm::omp::Directive::OMPD_do: 652 case llvm::omp::Directive::OMPD_do_simd: 653 SetClauseSets(dir.v); 654 break; 655 default: 656 // no clauses are allowed 657 break; 658 } 659 } 660 661 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { 662 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 663 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)}; 664 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 665 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)}; 666 const parser::Block &block{std::get<parser::Block>(x.t)}; 667 668 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir); 669 670 PushContextAndClauseSets(beginDir.source, beginDir.v); 671 if (GetContext().directive == llvm::omp::Directive::OMPD_target) { 672 EnterDirectiveNest(TargetNest); 673 } 674 675 if (CurrentDirectiveIsNested()) { 676 if (llvm::omp::teamSet.test(GetContextParent().directive)) { 677 HasInvalidTeamsNesting(beginDir.v, beginDir.source); 678 } 679 if (GetContext().directive == llvm::omp::Directive::OMPD_master) { 680 CheckMasterNesting(x); 681 } 682 // A teams region can only be strictly nested within the implicit parallel 683 // region or a target region. 684 if (GetContext().directive == llvm::omp::Directive::OMPD_teams && 685 GetContextParent().directive != llvm::omp::Directive::OMPD_target) { 686 context_.Say(parser::FindSourceLocation(x), 687 "%s region can only be strictly nested within the implicit parallel " 688 "region or TARGET region"_err_en_US, 689 ContextDirectiveAsFortran()); 690 } 691 // If a teams construct is nested within a target construct, that target 692 // construct must contain no statements, declarations or directives outside 693 // of the teams construct. 694 if (GetContext().directive == llvm::omp::Directive::OMPD_teams && 695 GetContextParent().directive == llvm::omp::Directive::OMPD_target && 696 !GetDirectiveNest(TargetBlockOnlyTeams)) { 697 context_.Say(GetContextParent().directiveSource, 698 "TARGET construct with nested TEAMS region contains statements or " 699 "directives outside of the TEAMS construct"_err_en_US); 700 } 701 } 702 703 CheckNoBranching(block, beginDir.v, beginDir.source); 704 705 switch (beginDir.v) { 706 case llvm::omp::Directive::OMPD_target: 707 if (CheckTargetBlockOnlyTeams(block)) { 708 EnterDirectiveNest(TargetBlockOnlyTeams); 709 } 710 break; 711 case llvm::omp::OMPD_workshare: 712 case llvm::omp::OMPD_parallel_workshare: 713 CheckWorkshareBlockStmts(block, beginDir.source); 714 HasInvalidWorksharingNesting( 715 beginDir.source, llvm::omp::nestedWorkshareErrSet); 716 break; 717 case llvm::omp::Directive::OMPD_single: 718 // TODO: This check needs to be extended while implementing nesting of 719 // regions checks. 720 HasInvalidWorksharingNesting( 721 beginDir.source, llvm::omp::nestedWorkshareErrSet); 722 break; 723 default: 724 break; 725 } 726 } 727 728 void OmpStructureChecker::CheckMasterNesting( 729 const parser::OpenMPBlockConstruct &x) { 730 // A MASTER region may not be `closely nested` inside a worksharing, loop, 731 // task, taskloop, or atomic region. 732 // TODO: Expand the check to include `LOOP` construct as well when it is 733 // supported. 734 if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) { 735 context_.Say(parser::FindSourceLocation(x), 736 "`MASTER` region may not be closely nested inside of `WORKSHARING`, " 737 "`LOOP`, `TASK`, `TASKLOOP`," 738 " or `ATOMIC` region."_err_en_US); 739 } 740 } 741 742 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) { 743 if (GetDirectiveNest(TargetBlockOnlyTeams)) { 744 ExitDirectiveNest(TargetBlockOnlyTeams); 745 } 746 if (GetContext().directive == llvm::omp::Directive::OMPD_target) { 747 ExitDirectiveNest(TargetNest); 748 } 749 dirContext_.pop_back(); 750 } 751 752 void OmpStructureChecker::ChecksOnOrderedAsBlock() { 753 if (FindClause(llvm::omp::Clause::OMPC_depend)) { 754 context_.Say(GetContext().clauseSource, 755 "DEPEND(*) clauses are not allowed when ORDERED construct is a block" 756 " construct with an ORDERED region"_err_en_US); 757 return; 758 } 759 760 OmpDirectiveSet notAllowedParallelSet{llvm::omp::Directive::OMPD_parallel, 761 llvm::omp::Directive::OMPD_target_parallel, 762 llvm::omp::Directive::OMPD_parallel_sections, 763 llvm::omp::Directive::OMPD_parallel_workshare}; 764 bool isNestedInDo{false}; 765 bool isNestedInDoSIMD{false}; 766 bool isNestedInSIMD{false}; 767 bool noOrderedClause{false}; 768 bool isOrderedClauseWithPara{false}; 769 bool isCloselyNestedRegion{true}; 770 if (CurrentDirectiveIsNested()) { 771 for (int i = (int)dirContext_.size() - 2; i >= 0; i--) { 772 if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) { 773 context_.Say(GetContext().directiveSource, 774 "`ORDERED` region may not be closely nested inside of `CRITICAL`, " 775 "`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US); 776 break; 777 } else if (llvm::omp::doSet.test(dirContext_[i].directive)) { 778 isNestedInDo = true; 779 isNestedInDoSIMD = llvm::omp::doSimdSet.test(dirContext_[i].directive); 780 if (const auto *clause{ 781 FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) { 782 const auto &orderedClause{ 783 std::get<parser::OmpClause::Ordered>(clause->u)}; 784 const auto orderedValue{GetIntValue(orderedClause.v)}; 785 isOrderedClauseWithPara = orderedValue > 0; 786 } else { 787 noOrderedClause = true; 788 } 789 break; 790 } else if (llvm::omp::simdSet.test(dirContext_[i].directive)) { 791 isNestedInSIMD = true; 792 break; 793 } else if (notAllowedParallelSet.test(dirContext_[i].directive)) { 794 isCloselyNestedRegion = false; 795 break; 796 } 797 } 798 } 799 800 if (!isCloselyNestedRegion) { 801 context_.Say(GetContext().directiveSource, 802 "An ORDERED directive without the DEPEND clause must be closely nested " 803 "in a SIMD, worksharing-loop, or worksharing-loop SIMD " 804 "region"_err_en_US); 805 } else { 806 if (CurrentDirectiveIsNested() && 807 FindClause(llvm::omp::Clause::OMPC_simd) && 808 (!isNestedInDoSIMD && !isNestedInSIMD)) { 809 context_.Say(GetContext().directiveSource, 810 "An ORDERED directive with SIMD clause must be closely nested in a " 811 "SIMD or worksharing-loop SIMD region"_err_en_US); 812 } 813 if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) { 814 context_.Say(GetContext().directiveSource, 815 "An ORDERED directive without the DEPEND clause must be closely " 816 "nested in a worksharing-loop (or worksharing-loop SIMD) region with " 817 "ORDERED clause without the parameter"_err_en_US); 818 } 819 } 820 } 821 822 void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) { 823 switch (GetContext().directive) { 824 case llvm::omp::Directive::OMPD_ordered: 825 // [5.1] 2.19.9 Ordered Construct Restriction 826 ChecksOnOrderedAsBlock(); 827 break; 828 default: 829 break; 830 } 831 } 832 833 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) { 834 const auto &beginSectionsDir{ 835 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 836 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)}; 837 const auto &beginDir{ 838 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 839 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)}; 840 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir); 841 842 PushContextAndClauseSets(beginDir.source, beginDir.v); 843 const auto §ionBlocks{std::get<parser::OmpSectionBlocks>(x.t)}; 844 for (const parser::OpenMPConstruct &block : sectionBlocks.v) { 845 CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v, 846 beginDir.v, beginDir.source); 847 } 848 HasInvalidWorksharingNesting( 849 beginDir.source, llvm::omp::nestedWorkshareErrSet); 850 } 851 852 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) { 853 dirContext_.pop_back(); 854 } 855 856 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) { 857 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)}; 858 ResetPartialContext(dir.source); 859 switch (dir.v) { 860 // 2.7.2 end-sections -> END SECTIONS [nowait-clause] 861 case llvm::omp::Directive::OMPD_sections: 862 PushContextAndClauseSets( 863 dir.source, llvm::omp::Directive::OMPD_end_sections); 864 break; 865 default: 866 // no clauses are allowed 867 break; 868 } 869 } 870 871 // TODO: Verify the popping of dirContext requirement after nowait 872 // implementation, as there is an implicit barrier at the end of the worksharing 873 // constructs unless a nowait clause is specified. Only OMPD_end_sections is 874 // popped becuase it is pushed while entering the EndSectionsDirective. 875 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) { 876 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) { 877 dirContext_.pop_back(); 878 } 879 } 880 881 void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar( 882 const parser::OmpObjectList &objList) { 883 for (const auto &ompObject : objList.v) { 884 std::visit( 885 common::visitors{ 886 [&](const parser::Designator &) { 887 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 888 const auto &declScope{ 889 GetProgramUnitContaining(name->symbol->GetUltimate())}; 890 const auto *sym = 891 declScope.parent().FindSymbol(name->symbol->name()); 892 if (sym && 893 (sym->has<MainProgramDetails>() || 894 sym->has<ModuleDetails>())) { 895 context_.Say(name->source, 896 "The module name or main program name cannot be in a %s " 897 "directive"_err_en_US, 898 ContextDirectiveAsFortran()); 899 } else if (name->symbol->GetUltimate().IsSubprogram()) { 900 if (GetContext().directive == 901 llvm::omp::Directive::OMPD_threadprivate) 902 context_.Say(name->source, 903 "The procedure name cannot be in a %s " 904 "directive"_err_en_US, 905 ContextDirectiveAsFortran()); 906 // TODO: Check for procedure name in declare target directive. 907 } else if (name->symbol->attrs().test(Attr::PARAMETER)) { 908 if (GetContext().directive == 909 llvm::omp::Directive::OMPD_threadprivate) 910 context_.Say(name->source, 911 "The entity with PARAMETER attribute cannot be in a %s " 912 "directive"_err_en_US, 913 ContextDirectiveAsFortran()); 914 else if (GetContext().directive == 915 llvm::omp::Directive::OMPD_declare_target) 916 context_.Say(name->source, 917 "The entity with PARAMETER attribute is used in a %s " 918 "directive"_warn_en_US, 919 ContextDirectiveAsFortran()); 920 } else if (FindCommonBlockContaining(*name->symbol)) { 921 context_.Say(name->source, 922 "A variable in a %s directive cannot be an element of a " 923 "common block"_err_en_US, 924 ContextDirectiveAsFortran()); 925 } else if (!IsSave(*name->symbol) && 926 declScope.kind() != Scope::Kind::MainProgram && 927 declScope.kind() != Scope::Kind::Module) { 928 context_.Say(name->source, 929 "A variable that appears in a %s directive must be " 930 "declared in the scope of a module or have the SAVE " 931 "attribute, either explicitly or implicitly"_err_en_US, 932 ContextDirectiveAsFortran()); 933 } else if (FindEquivalenceSet(*name->symbol)) { 934 context_.Say(name->source, 935 "A variable in a %s directive cannot appear in an " 936 "EQUIVALENCE statement"_err_en_US, 937 ContextDirectiveAsFortran()); 938 } else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) && 939 GetContext().directive == 940 llvm::omp::Directive::OMPD_declare_target) { 941 context_.Say(name->source, 942 "A THREADPRIVATE variable cannot appear in a %s " 943 "directive"_err_en_US, 944 ContextDirectiveAsFortran()); 945 } 946 } 947 }, 948 [&](const parser::Name &) {}, // common block 949 }, 950 ompObject.u); 951 } 952 } 953 954 void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) { 955 const auto &dir{std::get<parser::Verbatim>(c.t)}; 956 PushContextAndClauseSets( 957 dir.source, llvm::omp::Directive::OMPD_threadprivate); 958 } 959 960 void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) { 961 const auto &dir{std::get<parser::Verbatim>(c.t)}; 962 const auto &objectList{std::get<parser::OmpObjectList>(c.t)}; 963 CheckIsVarPartOfAnotherVar(dir.source, objectList); 964 CheckThreadprivateOrDeclareTargetVar(objectList); 965 dirContext_.pop_back(); 966 } 967 968 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) { 969 const auto &dir{std::get<parser::Verbatim>(x.t)}; 970 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd); 971 } 972 973 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) { 974 dirContext_.pop_back(); 975 } 976 977 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { 978 isPredefinedAllocator = true; 979 const auto &dir{std::get<parser::Verbatim>(x.t)}; 980 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 981 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 982 CheckIsVarPartOfAnotherVar(dir.source, objectList); 983 } 984 985 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { 986 const auto &dir{std::get<parser::Verbatim>(x.t)}; 987 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 988 CheckPredefinedAllocatorRestriction(dir.source, objectList); 989 dirContext_.pop_back(); 990 } 991 992 void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) { 993 CheckAllowed(llvm::omp::Clause::OMPC_allocator); 994 // Note: Predefined allocators are stored in ScalarExpr as numbers 995 // whereas custom allocators are stored as strings, so if the ScalarExpr 996 // actually has an int value, then it must be a predefined allocator 997 isPredefinedAllocator = GetIntValue(x.v).has_value(); 998 RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v); 999 } 1000 1001 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) { 1002 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1003 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target); 1004 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)}; 1005 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) { 1006 SetClauseSets(llvm::omp::Directive::OMPD_declare_target); 1007 } 1008 } 1009 1010 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) { 1011 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1012 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)}; 1013 if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) { 1014 CheckIsVarPartOfAnotherVar(dir.source, *objectList); 1015 CheckThreadprivateOrDeclareTargetVar(*objectList); 1016 } else if (const auto *clauseList{ 1017 parser::Unwrap<parser::OmpClauseList>(spec.u)}) { 1018 for (const auto &clause : clauseList->v) { 1019 if (const auto *toClause{std::get_if<parser::OmpClause::To>(&clause.u)}) { 1020 CheckIsVarPartOfAnotherVar(dir.source, toClause->v); 1021 CheckThreadprivateOrDeclareTargetVar(toClause->v); 1022 } else if (const auto *linkClause{ 1023 std::get_if<parser::OmpClause::Link>(&clause.u)}) { 1024 CheckIsVarPartOfAnotherVar(dir.source, linkClause->v); 1025 CheckThreadprivateOrDeclareTargetVar(linkClause->v); 1026 } 1027 } 1028 } 1029 dirContext_.pop_back(); 1030 } 1031 1032 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { 1033 isPredefinedAllocator = true; 1034 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1035 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)}; 1036 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 1037 if (objectList) { 1038 CheckIsVarPartOfAnotherVar(dir.source, *objectList); 1039 } 1040 } 1041 1042 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { 1043 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1044 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)}; 1045 if (objectList) 1046 CheckPredefinedAllocatorRestriction(dir.source, *objectList); 1047 dirContext_.pop_back(); 1048 } 1049 1050 void OmpStructureChecker::CheckBarrierNesting( 1051 const parser::OpenMPSimpleStandaloneConstruct &x) { 1052 // A barrier region may not be `closely nested` inside a worksharing, loop, 1053 // task, taskloop, critical, ordered, atomic, or master region. 1054 // TODO: Expand the check to include `LOOP` construct as well when it is 1055 // supported. 1056 if (GetContext().directive == llvm::omp::Directive::OMPD_barrier) { 1057 if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) { 1058 context_.Say(parser::FindSourceLocation(x), 1059 "`BARRIER` region may not be closely nested inside of `WORKSHARING`, " 1060 "`LOOP`, `TASK`, `TASKLOOP`," 1061 "`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US); 1062 } 1063 } 1064 } 1065 1066 void OmpStructureChecker::ChecksOnOrderedAsStandalone() { 1067 if (FindClause(llvm::omp::Clause::OMPC_threads) || 1068 FindClause(llvm::omp::Clause::OMPC_simd)) { 1069 context_.Say(GetContext().clauseSource, 1070 "THREADS, SIMD clauses are not allowed when ORDERED construct is a " 1071 "standalone construct with no ORDERED region"_err_en_US); 1072 } 1073 1074 bool isSinkPresent{false}; 1075 int dependSourceCount{0}; 1076 auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_depend); 1077 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) { 1078 const auto &dependClause{ 1079 std::get<parser::OmpClause::Depend>(itr->second->u)}; 1080 if (std::get_if<parser::OmpDependClause::Source>(&dependClause.v.u)) { 1081 dependSourceCount++; 1082 if (isSinkPresent) { 1083 context_.Say(itr->second->source, 1084 "DEPEND(SOURCE) is not allowed when DEPEND(SINK: vec) is present " 1085 "on ORDERED directive"_err_en_US); 1086 } 1087 if (dependSourceCount > 1) { 1088 context_.Say(itr->second->source, 1089 "At most one DEPEND(SOURCE) clause can appear on the ORDERED " 1090 "directive"_err_en_US); 1091 } 1092 } else if (std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)) { 1093 isSinkPresent = true; 1094 if (dependSourceCount > 0) { 1095 context_.Say(itr->second->source, 1096 "DEPEND(SINK: vec) is not allowed when DEPEND(SOURCE) is present " 1097 "on ORDERED directive"_err_en_US); 1098 } 1099 } else { 1100 context_.Say(itr->second->source, 1101 "Only DEPEND(SOURCE) or DEPEND(SINK: vec) are allowed when ORDERED " 1102 "construct is a standalone construct with no ORDERED " 1103 "region"_err_en_US); 1104 } 1105 } 1106 1107 OmpDirectiveSet allowedDoSet{llvm::omp::Directive::OMPD_do, 1108 llvm::omp::Directive::OMPD_parallel_do, 1109 llvm::omp::Directive::OMPD_target_parallel_do}; 1110 bool isNestedInDoOrderedWithPara{false}; 1111 if (CurrentDirectiveIsNested() && 1112 allowedDoSet.test(GetContextParent().directive)) { 1113 if (const auto *clause{ 1114 FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) { 1115 const auto &orderedClause{ 1116 std::get<parser::OmpClause::Ordered>(clause->u)}; 1117 const auto orderedValue{GetIntValue(orderedClause.v)}; 1118 if (orderedValue > 0) { 1119 isNestedInDoOrderedWithPara = true; 1120 CheckOrderedDependClause(orderedValue); 1121 } 1122 } 1123 } 1124 1125 if (FindClause(llvm::omp::Clause::OMPC_depend) && 1126 !isNestedInDoOrderedWithPara) { 1127 context_.Say(GetContext().clauseSource, 1128 "An ORDERED construct with the DEPEND clause must be closely nested " 1129 "in a worksharing-loop (or parallel worksharing-loop) construct with " 1130 "ORDERED clause with a parameter"_err_en_US); 1131 } 1132 } 1133 1134 void OmpStructureChecker::CheckOrderedDependClause( 1135 std::optional<std::int64_t> orderedValue) { 1136 auto clauseAll{FindClauses(llvm::omp::Clause::OMPC_depend)}; 1137 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) { 1138 const auto &dependClause{ 1139 std::get<parser::OmpClause::Depend>(itr->second->u)}; 1140 if (const auto *sinkVectors{ 1141 std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)}) { 1142 std::int64_t numVar = sinkVectors->v.size(); 1143 if (orderedValue != numVar) { 1144 context_.Say(itr->second->source, 1145 "The number of variables in DEPEND(SINK: vec) clause does not " 1146 "match the parameter specified in ORDERED clause"_err_en_US); 1147 } 1148 } 1149 } 1150 } 1151 1152 void OmpStructureChecker::Enter( 1153 const parser::OpenMPSimpleStandaloneConstruct &x) { 1154 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)}; 1155 PushContextAndClauseSets(dir.source, dir.v); 1156 CheckBarrierNesting(x); 1157 } 1158 1159 void OmpStructureChecker::Leave( 1160 const parser::OpenMPSimpleStandaloneConstruct &) { 1161 switch (GetContext().directive) { 1162 case llvm::omp::Directive::OMPD_ordered: 1163 // [5.1] 2.19.9 Ordered Construct Restriction 1164 ChecksOnOrderedAsStandalone(); 1165 break; 1166 default: 1167 break; 1168 } 1169 dirContext_.pop_back(); 1170 } 1171 1172 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) { 1173 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1174 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush); 1175 } 1176 1177 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) { 1178 if (FindClause(llvm::omp::Clause::OMPC_acquire) || 1179 FindClause(llvm::omp::Clause::OMPC_release) || 1180 FindClause(llvm::omp::Clause::OMPC_acq_rel)) { 1181 if (const auto &flushList{ 1182 std::get<std::optional<parser::OmpObjectList>>(x.t)}) { 1183 context_.Say(parser::FindSourceLocation(flushList), 1184 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items " 1185 "must not be specified on the FLUSH directive"_err_en_US); 1186 } 1187 } 1188 dirContext_.pop_back(); 1189 } 1190 1191 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) { 1192 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1193 const auto &type{std::get<parser::OmpCancelType>(x.t)}; 1194 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel); 1195 CheckCancellationNest(dir.source, type.v); 1196 } 1197 1198 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) { 1199 dirContext_.pop_back(); 1200 } 1201 1202 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { 1203 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)}; 1204 const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)}; 1205 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); 1206 const auto &block{std::get<parser::Block>(x.t)}; 1207 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); 1208 const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)}; 1209 const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)}; 1210 const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)}; 1211 if (dirName && endDirName && 1212 dirName->ToString().compare(endDirName->ToString())) { 1213 context_ 1214 .Say(endDirName->source, 1215 parser::MessageFormattedText{ 1216 "CRITICAL directive names do not match"_err_en_US}) 1217 .Attach(dirName->source, "should be "_en_US); 1218 } else if (dirName && !endDirName) { 1219 context_ 1220 .Say(dirName->source, 1221 parser::MessageFormattedText{ 1222 "CRITICAL directive names do not match"_err_en_US}) 1223 .Attach(dirName->source, "should be NULL"_en_US); 1224 } else if (!dirName && endDirName) { 1225 context_ 1226 .Say(endDirName->source, 1227 parser::MessageFormattedText{ 1228 "CRITICAL directive names do not match"_err_en_US}) 1229 .Attach(endDirName->source, "should be NULL"_en_US); 1230 } 1231 if (!dirName && !ompClause.source.empty() && 1232 ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") { 1233 context_.Say(dir.source, 1234 parser::MessageFormattedText{ 1235 "Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive"_err_en_US}); 1236 } 1237 } 1238 1239 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { 1240 dirContext_.pop_back(); 1241 } 1242 1243 void OmpStructureChecker::Enter( 1244 const parser::OpenMPCancellationPointConstruct &x) { 1245 const auto &dir{std::get<parser::Verbatim>(x.t)}; 1246 const auto &type{std::get<parser::OmpCancelType>(x.t)}; 1247 PushContextAndClauseSets( 1248 dir.source, llvm::omp::Directive::OMPD_cancellation_point); 1249 CheckCancellationNest(dir.source, type.v); 1250 } 1251 1252 void OmpStructureChecker::Leave( 1253 const parser::OpenMPCancellationPointConstruct &) { 1254 dirContext_.pop_back(); 1255 } 1256 1257 void OmpStructureChecker::CheckCancellationNest( 1258 const parser::CharBlock &source, const parser::OmpCancelType::Type &type) { 1259 if (CurrentDirectiveIsNested()) { 1260 // If construct-type-clause is taskgroup, the cancellation construct must be 1261 // closely nested inside a task or a taskloop construct and the cancellation 1262 // region must be closely nested inside a taskgroup region. If 1263 // construct-type-clause is sections, the cancellation construct must be 1264 // closely nested inside a sections or section construct. Otherwise, the 1265 // cancellation construct must be closely nested inside an OpenMP construct 1266 // that matches the type specified in construct-type-clause of the 1267 // cancellation construct. 1268 1269 OmpDirectiveSet allowedTaskgroupSet{ 1270 llvm::omp::Directive::OMPD_task, llvm::omp::Directive::OMPD_taskloop}; 1271 OmpDirectiveSet allowedSectionsSet{llvm::omp::Directive::OMPD_sections, 1272 llvm::omp::Directive::OMPD_parallel_sections}; 1273 OmpDirectiveSet allowedDoSet{llvm::omp::Directive::OMPD_do, 1274 llvm::omp::Directive::OMPD_distribute_parallel_do, 1275 llvm::omp::Directive::OMPD_parallel_do, 1276 llvm::omp::Directive::OMPD_target_parallel_do, 1277 llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do, 1278 llvm::omp::Directive::OMPD_teams_distribute_parallel_do}; 1279 OmpDirectiveSet allowedParallelSet{llvm::omp::Directive::OMPD_parallel, 1280 llvm::omp::Directive::OMPD_target_parallel}; 1281 1282 bool eligibleCancellation{false}; 1283 switch (type) { 1284 case parser::OmpCancelType::Type::Taskgroup: 1285 if (allowedTaskgroupSet.test(GetContextParent().directive)) { 1286 eligibleCancellation = true; 1287 if (dirContext_.size() >= 3) { 1288 // Check if the cancellation region is closely nested inside a 1289 // taskgroup region when there are more than two levels of directives 1290 // in the directive context stack. 1291 if (GetContextParent().directive == llvm::omp::Directive::OMPD_task || 1292 FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) { 1293 for (int i = dirContext_.size() - 3; i >= 0; i--) { 1294 if (dirContext_[i].directive == 1295 llvm::omp::Directive::OMPD_taskgroup) { 1296 break; 1297 } 1298 if (allowedParallelSet.test(dirContext_[i].directive)) { 1299 eligibleCancellation = false; 1300 break; 1301 } 1302 } 1303 } 1304 } 1305 } 1306 if (!eligibleCancellation) { 1307 context_.Say(source, 1308 "With %s clause, %s construct must be closely nested inside TASK " 1309 "or TASKLOOP construct and %s region must be closely nested inside " 1310 "TASKGROUP region"_err_en_US, 1311 parser::ToUpperCaseLetters( 1312 parser::OmpCancelType::EnumToString(type)), 1313 ContextDirectiveAsFortran(), ContextDirectiveAsFortran()); 1314 } 1315 return; 1316 case parser::OmpCancelType::Type::Sections: 1317 if (allowedSectionsSet.test(GetContextParent().directive)) { 1318 eligibleCancellation = true; 1319 } 1320 break; 1321 case Fortran::parser::OmpCancelType::Type::Do: 1322 if (allowedDoSet.test(GetContextParent().directive)) { 1323 eligibleCancellation = true; 1324 } 1325 break; 1326 case parser::OmpCancelType::Type::Parallel: 1327 if (allowedParallelSet.test(GetContextParent().directive)) { 1328 eligibleCancellation = true; 1329 } 1330 break; 1331 } 1332 if (!eligibleCancellation) { 1333 context_.Say(source, 1334 "With %s clause, %s construct cannot be closely nested inside %s " 1335 "construct"_err_en_US, 1336 parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)), 1337 ContextDirectiveAsFortran(), 1338 parser::ToUpperCaseLetters( 1339 getDirectiveName(GetContextParent().directive).str())); 1340 } 1341 } else { 1342 // The cancellation directive cannot be orphaned. 1343 switch (type) { 1344 case parser::OmpCancelType::Type::Taskgroup: 1345 context_.Say(source, 1346 "%s %s directive is not closely nested inside " 1347 "TASK or TASKLOOP"_err_en_US, 1348 ContextDirectiveAsFortran(), 1349 parser::ToUpperCaseLetters( 1350 parser::OmpCancelType::EnumToString(type))); 1351 break; 1352 case parser::OmpCancelType::Type::Sections: 1353 context_.Say(source, 1354 "%s %s directive is not closely nested inside " 1355 "SECTION or SECTIONS"_err_en_US, 1356 ContextDirectiveAsFortran(), 1357 parser::ToUpperCaseLetters( 1358 parser::OmpCancelType::EnumToString(type))); 1359 break; 1360 case Fortran::parser::OmpCancelType::Type::Do: 1361 context_.Say(source, 1362 "%s %s directive is not closely nested inside " 1363 "the construct that matches the DO clause type"_err_en_US, 1364 ContextDirectiveAsFortran(), 1365 parser::ToUpperCaseLetters( 1366 parser::OmpCancelType::EnumToString(type))); 1367 break; 1368 case parser::OmpCancelType::Type::Parallel: 1369 context_.Say(source, 1370 "%s %s directive is not closely nested inside " 1371 "the construct that matches the PARALLEL clause type"_err_en_US, 1372 ContextDirectiveAsFortran(), 1373 parser::ToUpperCaseLetters( 1374 parser::OmpCancelType::EnumToString(type))); 1375 break; 1376 } 1377 } 1378 } 1379 1380 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) { 1381 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)}; 1382 ResetPartialContext(dir.source); 1383 switch (dir.v) { 1384 // 2.7.3 end-single-clause -> copyprivate-clause | 1385 // nowait-clause 1386 case llvm::omp::Directive::OMPD_single: 1387 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single); 1388 break; 1389 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause] 1390 case llvm::omp::Directive::OMPD_workshare: 1391 PushContextAndClauseSets( 1392 dir.source, llvm::omp::Directive::OMPD_end_workshare); 1393 break; 1394 default: 1395 // no clauses are allowed 1396 break; 1397 } 1398 } 1399 1400 // TODO: Verify the popping of dirContext requirement after nowait 1401 // implementation, as there is an implicit barrier at the end of the worksharing 1402 // constructs unless a nowait clause is specified. Only OMPD_end_single and 1403 // end_workshareare popped as they are pushed while entering the 1404 // EndBlockDirective. 1405 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) { 1406 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) || 1407 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) { 1408 dirContext_.pop_back(); 1409 } 1410 } 1411 1412 template <typename T, typename D> 1413 bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) { 1414 using AllowedBinaryOperators = 1415 std::variant<parser::Expr::Add, parser::Expr::Multiply, 1416 parser::Expr::Subtract, parser::Expr::Divide, parser::Expr::AND, 1417 parser::Expr::OR, parser::Expr::EQV, parser::Expr::NEQV>; 1418 using BinaryOperators = std::variant<parser::Expr::Add, 1419 parser::Expr::Multiply, parser::Expr::Subtract, parser::Expr::Divide, 1420 parser::Expr::AND, parser::Expr::OR, parser::Expr::EQV, 1421 parser::Expr::NEQV, parser::Expr::Power, parser::Expr::Concat, 1422 parser::Expr::LT, parser::Expr::LE, parser::Expr::EQ, parser::Expr::NE, 1423 parser::Expr::GE, parser::Expr::GT>; 1424 1425 if constexpr (common::HasMember<T, BinaryOperators>) { 1426 const auto &variableName{variable.GetSource().ToString()}; 1427 const auto &exprLeft{std::get<0>(node.t)}; 1428 const auto &exprRight{std::get<1>(node.t)}; 1429 if ((exprLeft.value().source.ToString() != variableName) && 1430 (exprRight.value().source.ToString() != variableName)) { 1431 context_.Say(variable.GetSource(), 1432 "Atomic update variable '%s' not found in the RHS of the " 1433 "assignment statement in an ATOMIC (UPDATE) construct"_err_en_US, 1434 variableName); 1435 } 1436 return common::HasMember<T, AllowedBinaryOperators>; 1437 } 1438 return true; 1439 } 1440 1441 void OmpStructureChecker::CheckAtomicUpdateAssignmentStmt( 1442 const parser::AssignmentStmt &assignment) { 1443 const auto &expr{std::get<parser::Expr>(assignment.t)}; 1444 const auto &var{std::get<parser::Variable>(assignment.t)}; 1445 std::visit( 1446 common::visitors{ 1447 [&](const common::Indirection<parser::FunctionReference> &x) { 1448 const auto &procedureDesignator{ 1449 std::get<parser::ProcedureDesignator>(x.value().v.t)}; 1450 const parser::Name *name{ 1451 std::get_if<parser::Name>(&procedureDesignator.u)}; 1452 if (name && 1453 !(name->source == "max" || name->source == "min" || 1454 name->source == "iand" || name->source == "ior" || 1455 name->source == "ieor")) { 1456 context_.Say(expr.source, 1457 "Invalid intrinsic procedure name in " 1458 "OpenMP ATOMIC (UPDATE) statement"_err_en_US); 1459 } else if (name) { 1460 bool foundMatch{false}; 1461 if (auto varDesignatorIndirection = 1462 std::get_if<Fortran::common::Indirection< 1463 Fortran::parser::Designator>>(&var.u)) { 1464 const auto &varDesignator = varDesignatorIndirection->value(); 1465 if (const auto *dataRef = std::get_if<Fortran::parser::DataRef>( 1466 &varDesignator.u)) { 1467 if (const auto *name = 1468 std::get_if<Fortran::parser::Name>(&dataRef->u)) { 1469 const auto &varSymbol = *name->symbol; 1470 if (const auto *e{GetExpr(expr)}) { 1471 for (const Symbol &symbol : 1472 evaluate::CollectSymbols(*e)) { 1473 if (symbol == varSymbol) { 1474 foundMatch = true; 1475 break; 1476 } 1477 } 1478 } 1479 } 1480 } 1481 } 1482 if (!foundMatch) { 1483 context_.Say(expr.source, 1484 "Atomic update variable '%s' not found in the " 1485 "argument list of intrinsic procedure"_err_en_US, 1486 var.GetSource().ToString()); 1487 } 1488 } 1489 }, 1490 [&](const auto &x) { 1491 if (!IsOperatorValid(x, var)) { 1492 context_.Say(expr.source, 1493 "Invalid operator in OpenMP ATOMIC (UPDATE) statement"_err_en_US); 1494 } 1495 }, 1496 }, 1497 expr.u); 1498 } 1499 1500 void OmpStructureChecker::CheckAtomicMemoryOrderClause( 1501 const parser::OmpAtomicClauseList &clauseList) { 1502 int numMemoryOrderClause = 0; 1503 for (const auto &clause : clauseList.v) { 1504 if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) { 1505 numMemoryOrderClause++; 1506 if (numMemoryOrderClause > 1) { 1507 context_.Say(clause.source, 1508 "More than one memory order clause not allowed on OpenMP " 1509 "Atomic construct"_err_en_US); 1510 return; 1511 } 1512 } 1513 } 1514 } 1515 1516 void OmpStructureChecker::CheckAtomicMemoryOrderClause( 1517 const parser::OmpAtomicClauseList &leftHandClauseList, 1518 const parser::OmpAtomicClauseList &rightHandClauseList) { 1519 int numMemoryOrderClause = 0; 1520 for (const auto &clause : leftHandClauseList.v) { 1521 if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) { 1522 numMemoryOrderClause++; 1523 if (numMemoryOrderClause > 1) { 1524 context_.Say(clause.source, 1525 "More than one memory order clause not allowed on " 1526 "OpenMP Atomic construct"_err_en_US); 1527 return; 1528 } 1529 } 1530 } 1531 for (const auto &clause : rightHandClauseList.v) { 1532 if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) { 1533 numMemoryOrderClause++; 1534 if (numMemoryOrderClause > 1) { 1535 context_.Say(clause.source, 1536 "More than one memory order clause not " 1537 "allowed on OpenMP Atomic construct"_err_en_US); 1538 return; 1539 } 1540 } 1541 } 1542 } 1543 1544 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) { 1545 std::visit( 1546 common::visitors{ 1547 [&](const parser::OmpAtomic &atomicConstruct) { 1548 const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)}; 1549 PushContextAndClauseSets( 1550 dir.source, llvm::omp::Directive::OMPD_atomic); 1551 CheckAtomicUpdateAssignmentStmt( 1552 std::get<parser::Statement<parser::AssignmentStmt>>( 1553 atomicConstruct.t) 1554 .statement); 1555 CheckAtomicMemoryOrderClause( 1556 std::get<parser::OmpAtomicClauseList>(atomicConstruct.t)); 1557 }, 1558 [&](const parser::OmpAtomicUpdate &atomicConstruct) { 1559 const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)}; 1560 PushContextAndClauseSets( 1561 dir.source, llvm::omp::Directive::OMPD_atomic); 1562 CheckAtomicUpdateAssignmentStmt( 1563 std::get<parser::Statement<parser::AssignmentStmt>>( 1564 atomicConstruct.t) 1565 .statement); 1566 CheckAtomicMemoryOrderClause( 1567 std::get<0>(atomicConstruct.t), std::get<2>(atomicConstruct.t)); 1568 }, 1569 [&](const auto &atomicConstruct) { 1570 const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)}; 1571 PushContextAndClauseSets( 1572 dir.source, llvm::omp::Directive::OMPD_atomic); 1573 CheckAtomicMemoryOrderClause( 1574 std::get<0>(atomicConstruct.t), std::get<2>(atomicConstruct.t)); 1575 }, 1576 }, 1577 x.u); 1578 } 1579 1580 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) { 1581 dirContext_.pop_back(); 1582 } 1583 1584 // Clauses 1585 // Mainly categorized as 1586 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'. 1587 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h. 1588 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h. 1589 1590 void OmpStructureChecker::Leave(const parser::OmpClauseList &) { 1591 // 2.7.1 Loop Construct Restriction 1592 if (llvm::omp::doSet.test(GetContext().directive)) { 1593 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) { 1594 // only one schedule clause is allowed 1595 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)}; 1596 if (ScheduleModifierHasType(schedClause.v, 1597 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 1598 if (FindClause(llvm::omp::Clause::OMPC_ordered)) { 1599 context_.Say(clause->source, 1600 "The NONMONOTONIC modifier cannot be specified " 1601 "if an ORDERED clause is specified"_err_en_US); 1602 } 1603 if (ScheduleModifierHasType(schedClause.v, 1604 parser::OmpScheduleModifierType::ModType::Monotonic)) { 1605 context_.Say(clause->source, 1606 "The MONOTONIC and NONMONOTONIC modifiers " 1607 "cannot be both specified"_err_en_US); 1608 } 1609 } 1610 } 1611 1612 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) { 1613 // only one ordered clause is allowed 1614 const auto &orderedClause{ 1615 std::get<parser::OmpClause::Ordered>(clause->u)}; 1616 1617 if (orderedClause.v) { 1618 CheckNotAllowedIfClause( 1619 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear}); 1620 1621 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) { 1622 const auto &collapseClause{ 1623 std::get<parser::OmpClause::Collapse>(clause2->u)}; 1624 // ordered and collapse both have parameters 1625 if (const auto orderedValue{GetIntValue(orderedClause.v)}) { 1626 if (const auto collapseValue{GetIntValue(collapseClause.v)}) { 1627 if (*orderedValue > 0 && *orderedValue < *collapseValue) { 1628 context_.Say(clause->source, 1629 "The parameter of the ORDERED clause must be " 1630 "greater than or equal to " 1631 "the parameter of the COLLAPSE clause"_err_en_US); 1632 } 1633 } 1634 } 1635 } 1636 } 1637 1638 // TODO: ordered region binding check (requires nesting implementation) 1639 } 1640 } // doSet 1641 1642 // 2.8.1 Simd Construct Restriction 1643 if (llvm::omp::simdSet.test(GetContext().directive)) { 1644 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) { 1645 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) { 1646 const auto &simdlenClause{ 1647 std::get<parser::OmpClause::Simdlen>(clause->u)}; 1648 const auto &safelenClause{ 1649 std::get<parser::OmpClause::Safelen>(clause2->u)}; 1650 // simdlen and safelen both have parameters 1651 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) { 1652 if (const auto safelenValue{GetIntValue(safelenClause.v)}) { 1653 if (*safelenValue > 0 && *simdlenValue > *safelenValue) { 1654 context_.Say(clause->source, 1655 "The parameter of the SIMDLEN clause must be less than or " 1656 "equal to the parameter of the SAFELEN clause"_err_en_US); 1657 } 1658 } 1659 } 1660 } 1661 } 1662 // A list-item cannot appear in more than one aligned clause 1663 semantics::UnorderedSymbolSet alignedVars; 1664 auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_aligned); 1665 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) { 1666 const auto &alignedClause{ 1667 std::get<parser::OmpClause::Aligned>(itr->second->u)}; 1668 const auto &alignedNameList{ 1669 std::get<std::list<parser::Name>>(alignedClause.v.t)}; 1670 for (auto const &var : alignedNameList) { 1671 if (alignedVars.count(*(var.symbol)) == 1) { 1672 context_.Say(itr->second->source, 1673 "List item '%s' present at multiple ALIGNED clauses"_err_en_US, 1674 var.ToString()); 1675 break; 1676 } 1677 alignedVars.insert(*(var.symbol)); 1678 } 1679 } 1680 } // SIMD 1681 1682 // 2.7.3 Single Construct Restriction 1683 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) { 1684 CheckNotAllowedIfClause( 1685 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait}); 1686 } 1687 1688 auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name, 1689 llvmOmpClause clauseTy) { 1690 if (sym.test(Symbol::Flag::OmpThreadprivate)) 1691 context_.Say(name.source, 1692 "A THREADPRIVATE variable cannot be in %s clause"_err_en_US, 1693 parser::ToUpperCaseLetters(getClauseName(clauseTy).str())); 1694 }; 1695 1696 // [5.1] 2.21.2 Threadprivate Directive Restriction 1697 OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin, 1698 llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule, 1699 llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit, 1700 llvm::omp::Clause::OMPC_if}; 1701 for (auto it : GetContext().clauseInfo) { 1702 llvmOmpClause type = it.first; 1703 const auto *clause = it.second; 1704 if (!threadprivateAllowedSet.test(type)) { 1705 if (const auto *objList{GetOmpObjectList(*clause)}) { 1706 for (const auto &ompObject : objList->v) { 1707 std::visit( 1708 common::visitors{ 1709 [&](const parser::Designator &) { 1710 if (const auto *name{ 1711 parser::Unwrap<parser::Name>(ompObject)}) 1712 testThreadprivateVarErr( 1713 name->symbol->GetUltimate(), *name, type); 1714 }, 1715 [&](const parser::Name &name) { 1716 if (name.symbol) { 1717 for (const auto &mem : 1718 name.symbol->get<CommonBlockDetails>().objects()) { 1719 testThreadprivateVarErr(mem->GetUltimate(), name, type); 1720 break; 1721 } 1722 } 1723 }, 1724 }, 1725 ompObject.u); 1726 } 1727 } 1728 } 1729 } 1730 1731 CheckRequireAtLeastOneOf(); 1732 } 1733 1734 void OmpStructureChecker::Enter(const parser::OmpClause &x) { 1735 SetContextClause(x); 1736 } 1737 1738 // Following clauses do not have a separate node in parse-tree.h. 1739 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel) 1740 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire) 1741 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order) 1742 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) 1743 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate) 1744 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) 1745 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin) 1746 CHECK_SIMPLE_CLAUSE(Default, OMPC_default) 1747 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) 1748 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy) 1749 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach) 1750 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) 1751 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) 1752 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators) 1753 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) 1754 CHECK_SIMPLE_CLAUSE(Final, OMPC_final) 1755 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush) 1756 CHECK_SIMPLE_CLAUSE(From, OMPC_from) 1757 CHECK_SIMPLE_CLAUSE(Full, OMPC_full) 1758 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint) 1759 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction) 1760 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) 1761 CHECK_SIMPLE_CLAUSE(Match, OMPC_match) 1762 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal) 1763 CHECK_SIMPLE_CLAUSE(Order, OMPC_order) 1764 CHECK_SIMPLE_CLAUSE(Read, OMPC_read) 1765 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload) 1766 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate) 1767 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads) 1768 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) 1769 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr) 1770 CHECK_SIMPLE_CLAUSE(HasDeviceAddr, OMPC_has_device_addr) 1771 CHECK_SIMPLE_CLAUSE(Link, OMPC_link) 1772 CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect) 1773 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) 1774 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) 1775 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) 1776 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait) 1777 CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial) 1778 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind) 1779 CHECK_SIMPLE_CLAUSE(Release, OMPC_release) 1780 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) 1781 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) 1782 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) 1783 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes) 1784 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction) 1785 CHECK_SIMPLE_CLAUSE(To, OMPC_to) 1786 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address) 1787 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory) 1788 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) 1789 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) 1790 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) 1791 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr) 1792 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators) 1793 CHECK_SIMPLE_CLAUSE(Update, OMPC_update) 1794 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr) 1795 CHECK_SIMPLE_CLAUSE(Write, OMPC_write) 1796 CHECK_SIMPLE_CLAUSE(Init, OMPC_init) 1797 CHECK_SIMPLE_CLAUSE(Use, OMPC_use) 1798 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants) 1799 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) 1800 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) 1801 CHECK_SIMPLE_CLAUSE(When, OMPC_when) 1802 CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args) 1803 CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args) 1804 CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order) 1805 CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind) 1806 CHECK_SIMPLE_CLAUSE(Align, OMPC_align) 1807 CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare) 1808 1809 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) 1810 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks) 1811 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) 1812 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads) 1813 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority) 1814 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit) 1815 CHECK_REQ_SCALAR_INT_CLAUSE(Device, OMPC_device) 1816 1817 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse) 1818 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen) 1819 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen) 1820 1821 // Restrictions specific to each clause are implemented apart from the 1822 // generalized restrictions. 1823 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) { 1824 CheckAllowed(llvm::omp::Clause::OMPC_reduction); 1825 if (CheckReductionOperators(x)) { 1826 CheckReductionTypeList(x); 1827 } 1828 } 1829 bool OmpStructureChecker::CheckReductionOperators( 1830 const parser::OmpClause::Reduction &x) { 1831 1832 const auto &definedOp{std::get<0>(x.v.t)}; 1833 bool ok = false; 1834 std::visit( 1835 common::visitors{ 1836 [&](const parser::DefinedOperator &dOpr) { 1837 const auto &intrinsicOp{ 1838 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)}; 1839 ok = CheckIntrinsicOperator(intrinsicOp); 1840 }, 1841 [&](const parser::ProcedureDesignator &procD) { 1842 const parser::Name *name{std::get_if<parser::Name>(&procD.u)}; 1843 if (name) { 1844 if (name->source == "max" || name->source == "min" || 1845 name->source == "iand" || name->source == "ior" || 1846 name->source == "ieor") { 1847 ok = true; 1848 } else { 1849 context_.Say(GetContext().clauseSource, 1850 "Invalid reduction identifier in REDUCTION clause."_err_en_US, 1851 ContextDirectiveAsFortran()); 1852 } 1853 } 1854 }, 1855 }, 1856 definedOp.u); 1857 1858 return ok; 1859 } 1860 bool OmpStructureChecker::CheckIntrinsicOperator( 1861 const parser::DefinedOperator::IntrinsicOperator &op) { 1862 1863 switch (op) { 1864 case parser::DefinedOperator::IntrinsicOperator::Add: 1865 case parser::DefinedOperator::IntrinsicOperator::Subtract: 1866 case parser::DefinedOperator::IntrinsicOperator::Multiply: 1867 case parser::DefinedOperator::IntrinsicOperator::AND: 1868 case parser::DefinedOperator::IntrinsicOperator::OR: 1869 case parser::DefinedOperator::IntrinsicOperator::EQV: 1870 case parser::DefinedOperator::IntrinsicOperator::NEQV: 1871 return true; 1872 default: 1873 context_.Say(GetContext().clauseSource, 1874 "Invalid reduction operator in REDUCTION clause."_err_en_US, 1875 ContextDirectiveAsFortran()); 1876 } 1877 return false; 1878 } 1879 1880 void OmpStructureChecker::CheckReductionTypeList( 1881 const parser::OmpClause::Reduction &x) { 1882 const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)}; 1883 CheckIntentInPointerAndDefinable( 1884 ompObjectList, llvm::omp::Clause::OMPC_reduction); 1885 CheckReductionArraySection(ompObjectList); 1886 CheckMultipleAppearanceAcrossContext(ompObjectList); 1887 } 1888 1889 void OmpStructureChecker::CheckIntentInPointerAndDefinable( 1890 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 1891 for (const auto &ompObject : objectList.v) { 1892 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1893 if (const auto *symbol{name->symbol}) { 1894 if (IsPointer(symbol->GetUltimate()) && 1895 IsIntentIn(symbol->GetUltimate())) { 1896 context_.Say(GetContext().clauseSource, 1897 "Pointer '%s' with the INTENT(IN) attribute may not appear " 1898 "in a %s clause"_err_en_US, 1899 symbol->name(), 1900 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1901 } 1902 if (auto msg{ 1903 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) { 1904 context_ 1905 .Say(GetContext().clauseSource, 1906 "Variable '%s' on the %s clause is not definable"_err_en_US, 1907 symbol->name(), 1908 parser::ToUpperCaseLetters(getClauseName(clause).str())) 1909 .Attach(std::move(*msg)); 1910 } 1911 } 1912 } 1913 } 1914 } 1915 1916 void OmpStructureChecker::CheckReductionArraySection( 1917 const parser::OmpObjectList &ompObjectList) { 1918 for (const auto &ompObject : ompObjectList.v) { 1919 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) { 1920 if (const auto *arrayElement{ 1921 parser::Unwrap<parser::ArrayElement>(ompObject)}) { 1922 if (arrayElement) { 1923 CheckArraySection(*arrayElement, GetLastName(*dataRef), 1924 llvm::omp::Clause::OMPC_reduction); 1925 } 1926 } 1927 } 1928 } 1929 } 1930 1931 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext( 1932 const parser::OmpObjectList &redObjectList) { 1933 // TODO: Verify the assumption here that the immediately enclosing region is 1934 // the parallel region to which the worksharing construct having reduction 1935 // binds to. 1936 if (auto *enclosingContext{GetEnclosingDirContext()}) { 1937 for (auto it : enclosingContext->clauseInfo) { 1938 llvmOmpClause type = it.first; 1939 const auto *clause = it.second; 1940 if (llvm::omp::privateReductionSet.test(type)) { 1941 if (const auto *objList{GetOmpObjectList(*clause)}) { 1942 for (const auto &ompObject : objList->v) { 1943 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1944 if (const auto *symbol{name->symbol}) { 1945 for (const auto &redOmpObject : redObjectList.v) { 1946 if (const auto *rname{ 1947 parser::Unwrap<parser::Name>(redOmpObject)}) { 1948 if (const auto *rsymbol{rname->symbol}) { 1949 if (rsymbol->name() == symbol->name()) { 1950 context_.Say(GetContext().clauseSource, 1951 "%s variable '%s' is %s in outer context must" 1952 " be shared in the parallel regions to which any" 1953 " of the worksharing regions arising from the " 1954 "worksharing" 1955 " construct bind."_err_en_US, 1956 parser::ToUpperCaseLetters( 1957 getClauseName(llvm::omp::Clause::OMPC_reduction) 1958 .str()), 1959 symbol->name(), 1960 parser::ToUpperCaseLetters( 1961 getClauseName(type).str())); 1962 } 1963 } 1964 } 1965 } 1966 } 1967 } 1968 } 1969 } 1970 } 1971 } 1972 } 1973 } 1974 1975 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) { 1976 CheckAllowed(llvm::omp::Clause::OMPC_ordered); 1977 // the parameter of ordered clause is optional 1978 if (const auto &expr{x.v}) { 1979 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr); 1980 // 2.8.3 Loop SIMD Construct Restriction 1981 if (llvm::omp::doSimdSet.test(GetContext().directive)) { 1982 context_.Say(GetContext().clauseSource, 1983 "No ORDERED clause with a parameter can be specified " 1984 "on the %s directive"_err_en_US, 1985 ContextDirectiveAsFortran()); 1986 } 1987 } 1988 } 1989 1990 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) { 1991 CheckAllowed(llvm::omp::Clause::OMPC_shared); 1992 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); 1993 } 1994 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { 1995 CheckAllowed(llvm::omp::Clause::OMPC_private); 1996 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); 1997 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); 1998 } 1999 2000 bool OmpStructureChecker::IsDataRefTypeParamInquiry( 2001 const parser::DataRef *dataRef) { 2002 bool dataRefIsTypeParamInquiry{false}; 2003 if (const auto *structComp{ 2004 parser::Unwrap<parser::StructureComponent>(dataRef)}) { 2005 if (const auto *compSymbol{structComp->component.symbol}) { 2006 if (const auto *compSymbolMiscDetails{ 2007 std::get_if<MiscDetails>(&compSymbol->details())}) { 2008 const auto detailsKind = compSymbolMiscDetails->kind(); 2009 dataRefIsTypeParamInquiry = 2010 (detailsKind == MiscDetails::Kind::KindParamInquiry || 2011 detailsKind == MiscDetails::Kind::LenParamInquiry); 2012 } else if (compSymbol->has<TypeParamDetails>()) { 2013 dataRefIsTypeParamInquiry = true; 2014 } 2015 } 2016 } 2017 return dataRefIsTypeParamInquiry; 2018 } 2019 2020 void OmpStructureChecker::CheckIsVarPartOfAnotherVar( 2021 const parser::CharBlock &source, const parser::OmpObjectList &objList) { 2022 OmpDirectiveSet nonPartialVarSet{llvm::omp::Directive::OMPD_allocate, 2023 llvm::omp::Directive::OMPD_threadprivate, 2024 llvm::omp::Directive::OMPD_declare_target}; 2025 for (const auto &ompObject : objList.v) { 2026 std::visit( 2027 common::visitors{ 2028 [&](const parser::Designator &designator) { 2029 if (const auto *dataRef{ 2030 std::get_if<parser::DataRef>(&designator.u)}) { 2031 if (IsDataRefTypeParamInquiry(dataRef)) { 2032 context_.Say(source, 2033 "A type parameter inquiry cannot appear on the %s " 2034 "directive"_err_en_US, 2035 ContextDirectiveAsFortran()); 2036 } else if (parser::Unwrap<parser::StructureComponent>( 2037 ompObject) || 2038 parser::Unwrap<parser::ArrayElement>(ompObject)) { 2039 if (nonPartialVarSet.test(GetContext().directive)) { 2040 context_.Say(source, 2041 "A variable that is part of another variable (as an " 2042 "array or structure element) cannot appear on the %s " 2043 "directive"_err_en_US, 2044 ContextDirectiveAsFortran()); 2045 } else { 2046 context_.Say(source, 2047 "A variable that is part of another variable (as an " 2048 "array or structure element) cannot appear in a " 2049 "PRIVATE or SHARED clause"_err_en_US); 2050 } 2051 } 2052 } 2053 }, 2054 [&](const parser::Name &name) {}, 2055 }, 2056 ompObject.u); 2057 } 2058 } 2059 2060 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { 2061 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); 2062 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); 2063 2064 SymbolSourceMap currSymbols; 2065 GetSymbolsInObjectList(x.v, currSymbols); 2066 2067 DirectivesClauseTriple dirClauseTriple; 2068 // Check firstprivate variables in worksharing constructs 2069 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 2070 std::make_pair( 2071 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 2072 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 2073 std::make_pair( 2074 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 2075 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single, 2076 std::make_pair( 2077 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 2078 // Check firstprivate variables in distribute construct 2079 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 2080 std::make_pair( 2081 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet)); 2082 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 2083 std::make_pair(llvm::omp::Directive::OMPD_target_teams, 2084 llvm::omp::privateReductionSet)); 2085 // Check firstprivate variables in task and taskloop constructs 2086 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task, 2087 std::make_pair(llvm::omp::Directive::OMPD_parallel, 2088 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 2089 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop, 2090 std::make_pair(llvm::omp::Directive::OMPD_parallel, 2091 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 2092 2093 CheckPrivateSymbolsInOuterCxt( 2094 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate); 2095 } 2096 2097 void OmpStructureChecker::CheckIsLoopIvPartOfClause( 2098 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) { 2099 for (const auto &ompObject : ompObjectList.v) { 2100 if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) { 2101 if (name->symbol == GetContext().loopIV) { 2102 context_.Say(name->source, 2103 "DO iteration variable %s is not allowed in %s clause."_err_en_US, 2104 name->ToString(), 2105 parser::ToUpperCaseLetters(getClauseName(clause).str())); 2106 } 2107 } 2108 } 2109 } 2110 // Following clauses have a seperate node in parse-tree.h. 2111 // Atomic-clause 2112 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read) 2113 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write) 2114 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update) 2115 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture) 2116 2117 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) { 2118 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read, 2119 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel}); 2120 } 2121 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) { 2122 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write, 2123 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 2124 } 2125 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) { 2126 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update, 2127 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 2128 } 2129 // OmpAtomic node represents atomic directive without atomic-clause. 2130 // atomic-clause - READ,WRITE,UPDATE,CAPTURE. 2131 void OmpStructureChecker::Leave(const parser::OmpAtomic &) { 2132 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) { 2133 context_.Say(clause->source, 2134 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US); 2135 } 2136 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) { 2137 context_.Say(clause->source, 2138 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US); 2139 } 2140 } 2141 // Restrictions specific to each clause are implemented apart from the 2142 // generalized restrictions. 2143 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) { 2144 CheckAllowed(llvm::omp::Clause::OMPC_aligned); 2145 2146 if (const auto &expr{ 2147 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) { 2148 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr); 2149 } 2150 // 2.8.1 TODO: list-item attribute check 2151 } 2152 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) { 2153 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap); 2154 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory; 2155 if (!std::get<std::optional<VariableCategory>>(x.v.t)) { 2156 context_.Say(GetContext().clauseSource, 2157 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP " 2158 "clause"_err_en_US); 2159 } 2160 } 2161 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) { 2162 CheckAllowed(llvm::omp::Clause::OMPC_if); 2163 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier; 2164 static std::unordered_map<dirNameModifier, OmpDirectiveSet> 2165 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet}, 2166 {dirNameModifier::Target, llvm::omp::targetSet}, 2167 {dirNameModifier::TargetEnterData, 2168 {llvm::omp::Directive::OMPD_target_enter_data}}, 2169 {dirNameModifier::TargetExitData, 2170 {llvm::omp::Directive::OMPD_target_exit_data}}, 2171 {dirNameModifier::TargetData, 2172 {llvm::omp::Directive::OMPD_target_data}}, 2173 {dirNameModifier::TargetUpdate, 2174 {llvm::omp::Directive::OMPD_target_update}}, 2175 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}}, 2176 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}}; 2177 if (const auto &directiveName{ 2178 std::get<std::optional<dirNameModifier>>(x.v.t)}) { 2179 auto search{dirNameModifierMap.find(*directiveName)}; 2180 if (search == dirNameModifierMap.end() || 2181 !search->second.test(GetContext().directive)) { 2182 context_ 2183 .Say(GetContext().clauseSource, 2184 "Unmatched directive name modifier %s on the IF clause"_err_en_US, 2185 parser::ToUpperCaseLetters( 2186 parser::OmpIfClause::EnumToString(*directiveName))) 2187 .Attach( 2188 GetContext().directiveSource, "Cannot apply to directive"_en_US); 2189 } 2190 } 2191 } 2192 2193 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { 2194 CheckAllowed(llvm::omp::Clause::OMPC_linear); 2195 2196 // 2.7 Loop Construct Restriction 2197 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) { 2198 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) { 2199 context_.Say(GetContext().clauseSource, 2200 "A modifier may not be specified in a LINEAR clause " 2201 "on the %s directive"_err_en_US, 2202 ContextDirectiveAsFortran()); 2203 } 2204 } 2205 } 2206 2207 void OmpStructureChecker::CheckAllowedMapTypes( 2208 const parser::OmpMapType::Type &type, 2209 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) { 2210 const auto found{std::find( 2211 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)}; 2212 if (found == std::end(allowedMapTypeList)) { 2213 std::string commaSeperatedMapTypes; 2214 llvm::interleave( 2215 allowedMapTypeList.begin(), allowedMapTypeList.end(), 2216 [&](const parser::OmpMapType::Type &mapType) { 2217 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters( 2218 parser::OmpMapType::EnumToString(mapType))); 2219 }, 2220 [&] { commaSeperatedMapTypes.append(", "); }); 2221 context_.Say(GetContext().clauseSource, 2222 "Only the %s map types are permitted " 2223 "for MAP clauses on the %s directive"_err_en_US, 2224 commaSeperatedMapTypes, ContextDirectiveAsFortran()); 2225 } 2226 } 2227 2228 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) { 2229 CheckAllowed(llvm::omp::Clause::OMPC_map); 2230 2231 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) { 2232 using Type = parser::OmpMapType::Type; 2233 const Type &type{std::get<Type>(maptype->t)}; 2234 switch (GetContext().directive) { 2235 case llvm::omp::Directive::OMPD_target: 2236 case llvm::omp::Directive::OMPD_target_teams: 2237 case llvm::omp::Directive::OMPD_target_teams_distribute: 2238 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 2239 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 2240 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 2241 case llvm::omp::Directive::OMPD_target_data: 2242 CheckAllowedMapTypes( 2243 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc}); 2244 break; 2245 case llvm::omp::Directive::OMPD_target_enter_data: 2246 CheckAllowedMapTypes(type, {Type::To, Type::Alloc}); 2247 break; 2248 case llvm::omp::Directive::OMPD_target_exit_data: 2249 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete}); 2250 break; 2251 default: 2252 break; 2253 } 2254 } 2255 } 2256 2257 bool OmpStructureChecker::ScheduleModifierHasType( 2258 const parser::OmpScheduleClause &x, 2259 const parser::OmpScheduleModifierType::ModType &type) { 2260 const auto &modifier{ 2261 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)}; 2262 if (modifier) { 2263 const auto &modType1{ 2264 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)}; 2265 const auto &modType2{ 2266 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>( 2267 modifier->t)}; 2268 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) { 2269 return true; 2270 } 2271 } 2272 return false; 2273 } 2274 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) { 2275 CheckAllowed(llvm::omp::Clause::OMPC_schedule); 2276 const parser::OmpScheduleClause &scheduleClause = x.v; 2277 2278 // 2.7 Loop Construct Restriction 2279 if (llvm::omp::doSet.test(GetContext().directive)) { 2280 const auto &kind{std::get<1>(scheduleClause.t)}; 2281 const auto &chunk{std::get<2>(scheduleClause.t)}; 2282 if (chunk) { 2283 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime || 2284 kind == parser::OmpScheduleClause::ScheduleType::Auto) { 2285 context_.Say(GetContext().clauseSource, 2286 "When SCHEDULE clause has %s specified, " 2287 "it must not have chunk size specified"_err_en_US, 2288 parser::ToUpperCaseLetters( 2289 parser::OmpScheduleClause::EnumToString(kind))); 2290 } 2291 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>( 2292 scheduleClause.t)}) { 2293 RequiresPositiveParameter( 2294 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size"); 2295 } 2296 } 2297 2298 if (ScheduleModifierHasType(scheduleClause, 2299 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 2300 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic && 2301 kind != parser::OmpScheduleClause::ScheduleType::Guided) { 2302 context_.Say(GetContext().clauseSource, 2303 "The NONMONOTONIC modifier can only be specified with " 2304 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US); 2305 } 2306 } 2307 } 2308 } 2309 2310 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) { 2311 CheckAllowed(llvm::omp::Clause::OMPC_depend); 2312 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) { 2313 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)}; 2314 for (const auto &ele : designators) { 2315 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) { 2316 CheckDependList(*dataRef); 2317 if (const auto *arr{ 2318 std::get_if<common::Indirection<parser::ArrayElement>>( 2319 &dataRef->u)}) { 2320 CheckArraySection(arr->value(), GetLastName(*dataRef), 2321 llvm::omp::Clause::OMPC_depend); 2322 } 2323 } 2324 } 2325 } 2326 } 2327 2328 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) { 2329 CheckAllowed(llvm::omp::Clause::OMPC_copyprivate); 2330 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate); 2331 } 2332 2333 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) { 2334 CheckAllowed(llvm::omp::Clause::OMPC_lastprivate); 2335 2336 DirectivesClauseTriple dirClauseTriple; 2337 SymbolSourceMap currSymbols; 2338 GetSymbolsInObjectList(x.v, currSymbols); 2339 CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x)); 2340 2341 // Check lastprivate variables in worksharing constructs 2342 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 2343 std::make_pair( 2344 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 2345 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 2346 std::make_pair( 2347 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 2348 2349 CheckPrivateSymbolsInOuterCxt( 2350 currSymbols, dirClauseTriple, GetClauseKindForParserClass(x)); 2351 } 2352 2353 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { 2354 return llvm::omp::getOpenMPClauseName(clause); 2355 } 2356 2357 llvm::StringRef OmpStructureChecker::getDirectiveName( 2358 llvm::omp::Directive directive) { 2359 return llvm::omp::getOpenMPDirectiveName(directive); 2360 } 2361 2362 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) { 2363 std::visit( 2364 common::visitors{ 2365 [&](const common::Indirection<parser::ArrayElement> &elem) { 2366 // Check if the base element is valid on Depend Clause 2367 CheckDependList(elem.value().base); 2368 }, 2369 [&](const common::Indirection<parser::StructureComponent> &) { 2370 context_.Say(GetContext().clauseSource, 2371 "A variable that is part of another variable " 2372 "(such as an element of a structure) but is not an array " 2373 "element or an array section cannot appear in a DEPEND " 2374 "clause"_err_en_US); 2375 }, 2376 [&](const common::Indirection<parser::CoindexedNamedObject> &) { 2377 context_.Say(GetContext().clauseSource, 2378 "Coarrays are not supported in DEPEND clause"_err_en_US); 2379 }, 2380 [&](const parser::Name &) { return; }, 2381 }, 2382 d.u); 2383 } 2384 2385 // Called from both Reduction and Depend clause. 2386 void OmpStructureChecker::CheckArraySection( 2387 const parser::ArrayElement &arrayElement, const parser::Name &name, 2388 const llvm::omp::Clause clause) { 2389 if (!arrayElement.subscripts.empty()) { 2390 for (const auto &subscript : arrayElement.subscripts) { 2391 if (const auto *triplet{ 2392 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) { 2393 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) { 2394 const auto &lower{std::get<0>(triplet->t)}; 2395 const auto &upper{std::get<1>(triplet->t)}; 2396 if (lower && upper) { 2397 const auto lval{GetIntValue(lower)}; 2398 const auto uval{GetIntValue(upper)}; 2399 if (lval && uval && *uval < *lval) { 2400 context_.Say(GetContext().clauseSource, 2401 "'%s' in %s clause" 2402 " is a zero size array section"_err_en_US, 2403 name.ToString(), 2404 parser::ToUpperCaseLetters(getClauseName(clause).str())); 2405 break; 2406 } else if (std::get<2>(triplet->t)) { 2407 const auto &strideExpr{std::get<2>(triplet->t)}; 2408 if (strideExpr) { 2409 if (clause == llvm::omp::Clause::OMPC_depend) { 2410 context_.Say(GetContext().clauseSource, 2411 "Stride should not be specified for array section in " 2412 "DEPEND " 2413 "clause"_err_en_US); 2414 } 2415 const auto stride{GetIntValue(strideExpr)}; 2416 if ((stride && stride != 1)) { 2417 context_.Say(GetContext().clauseSource, 2418 "A list item that appears in a REDUCTION clause" 2419 " should have a contiguous storage array section."_err_en_US, 2420 ContextDirectiveAsFortran()); 2421 break; 2422 } 2423 } 2424 } 2425 } 2426 } 2427 } 2428 } 2429 } 2430 } 2431 2432 void OmpStructureChecker::CheckIntentInPointer( 2433 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 2434 SymbolSourceMap symbols; 2435 GetSymbolsInObjectList(objectList, symbols); 2436 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 2437 const auto *symbol{it->first}; 2438 const auto source{it->second}; 2439 if (IsPointer(*symbol) && IsIntentIn(*symbol)) { 2440 context_.Say(source, 2441 "Pointer '%s' with the INTENT(IN) attribute may not appear " 2442 "in a %s clause"_err_en_US, 2443 symbol->name(), 2444 parser::ToUpperCaseLetters(getClauseName(clause).str())); 2445 } 2446 } 2447 } 2448 2449 void OmpStructureChecker::GetSymbolsInObjectList( 2450 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) { 2451 for (const auto &ompObject : objectList.v) { 2452 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 2453 if (const auto *symbol{name->symbol}) { 2454 if (const auto *commonBlockDetails{ 2455 symbol->detailsIf<CommonBlockDetails>()}) { 2456 for (const auto &object : commonBlockDetails->objects()) { 2457 symbols.emplace(&object->GetUltimate(), name->source); 2458 } 2459 } else { 2460 symbols.emplace(&symbol->GetUltimate(), name->source); 2461 } 2462 } 2463 } 2464 } 2465 } 2466 2467 void OmpStructureChecker::CheckDefinableObjects( 2468 SymbolSourceMap &symbols, const llvm::omp::Clause clause) { 2469 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 2470 const auto *symbol{it->first}; 2471 const auto source{it->second}; 2472 if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) { 2473 context_ 2474 .Say(source, 2475 "Variable '%s' on the %s clause is not definable"_err_en_US, 2476 symbol->name(), 2477 parser::ToUpperCaseLetters(getClauseName(clause).str())) 2478 .Attach(std::move(*msg)); 2479 } 2480 } 2481 } 2482 2483 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt( 2484 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple, 2485 const llvm::omp::Clause currClause) { 2486 SymbolSourceMap enclosingSymbols; 2487 auto range{dirClauseTriple.equal_range(GetContext().directive)}; 2488 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) { 2489 auto enclosingDir{dirIter->second.first}; 2490 auto enclosingClauseSet{dirIter->second.second}; 2491 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) { 2492 for (auto it{enclosingContext->clauseInfo.begin()}; 2493 it != enclosingContext->clauseInfo.end(); ++it) { 2494 if (enclosingClauseSet.test(it->first)) { 2495 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) { 2496 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols); 2497 } 2498 } 2499 } 2500 2501 // Check if the symbols in current context are private in outer context 2502 for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) { 2503 const auto *symbol{iter->first}; 2504 const auto source{iter->second}; 2505 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) { 2506 context_.Say(source, 2507 "%s variable '%s' is PRIVATE in outer context"_err_en_US, 2508 parser::ToUpperCaseLetters(getClauseName(currClause).str()), 2509 symbol->name()); 2510 } 2511 } 2512 } 2513 } 2514 } 2515 2516 bool OmpStructureChecker::CheckTargetBlockOnlyTeams( 2517 const parser::Block &block) { 2518 bool nestedTeams{false}; 2519 auto it{block.begin()}; 2520 2521 if (const auto *ompConstruct{parser::Unwrap<parser::OpenMPConstruct>(*it)}) { 2522 if (const auto *ompBlockConstruct{ 2523 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) { 2524 const auto &beginBlockDir{ 2525 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)}; 2526 const auto &beginDir{ 2527 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 2528 if (beginDir.v == llvm::omp::Directive::OMPD_teams) { 2529 nestedTeams = true; 2530 } 2531 } 2532 } 2533 2534 if (nestedTeams && ++it == block.end()) { 2535 return true; 2536 } 2537 return false; 2538 } 2539 2540 void OmpStructureChecker::CheckWorkshareBlockStmts( 2541 const parser::Block &block, parser::CharBlock source) { 2542 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source}; 2543 2544 for (auto it{block.begin()}; it != block.end(); ++it) { 2545 if (parser::Unwrap<parser::AssignmentStmt>(*it) || 2546 parser::Unwrap<parser::ForallStmt>(*it) || 2547 parser::Unwrap<parser::ForallConstruct>(*it) || 2548 parser::Unwrap<parser::WhereStmt>(*it) || 2549 parser::Unwrap<parser::WhereConstruct>(*it)) { 2550 parser::Walk(*it, ompWorkshareBlockChecker); 2551 } else if (const auto *ompConstruct{ 2552 parser::Unwrap<parser::OpenMPConstruct>(*it)}) { 2553 if (const auto *ompAtomicConstruct{ 2554 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) { 2555 // Check if assignment statements in the enclosing OpenMP Atomic 2556 // construct are allowed in the Workshare construct 2557 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker); 2558 } else if (const auto *ompCriticalConstruct{ 2559 std::get_if<parser::OpenMPCriticalConstruct>( 2560 &ompConstruct->u)}) { 2561 // All the restrictions on the Workshare construct apply to the 2562 // statements in the enclosing critical constructs 2563 const auto &criticalBlock{ 2564 std::get<parser::Block>(ompCriticalConstruct->t)}; 2565 CheckWorkshareBlockStmts(criticalBlock, source); 2566 } else { 2567 // Check if OpenMP constructs enclosed in the Workshare construct are 2568 // 'Parallel' constructs 2569 auto currentDir{llvm::omp::Directive::OMPD_unknown}; 2570 const OmpDirectiveSet parallelDirSet{ 2571 llvm::omp::Directive::OMPD_parallel, 2572 llvm::omp::Directive::OMPD_parallel_do, 2573 llvm::omp::Directive::OMPD_parallel_sections, 2574 llvm::omp::Directive::OMPD_parallel_workshare, 2575 llvm::omp::Directive::OMPD_parallel_do_simd}; 2576 2577 if (const auto *ompBlockConstruct{ 2578 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) { 2579 const auto &beginBlockDir{ 2580 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)}; 2581 const auto &beginDir{ 2582 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 2583 currentDir = beginDir.v; 2584 } else if (const auto *ompLoopConstruct{ 2585 std::get_if<parser::OpenMPLoopConstruct>( 2586 &ompConstruct->u)}) { 2587 const auto &beginLoopDir{ 2588 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)}; 2589 const auto &beginDir{ 2590 std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 2591 currentDir = beginDir.v; 2592 } else if (const auto *ompSectionsConstruct{ 2593 std::get_if<parser::OpenMPSectionsConstruct>( 2594 &ompConstruct->u)}) { 2595 const auto &beginSectionsDir{ 2596 std::get<parser::OmpBeginSectionsDirective>( 2597 ompSectionsConstruct->t)}; 2598 const auto &beginDir{ 2599 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 2600 currentDir = beginDir.v; 2601 } 2602 2603 if (!parallelDirSet.test(currentDir)) { 2604 context_.Say(source, 2605 "OpenMP constructs enclosed in WORKSHARE construct may consist " 2606 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US); 2607 } 2608 } 2609 } else { 2610 context_.Say(source, 2611 "The structured block in a WORKSHARE construct may consist of only " 2612 "SCALAR or ARRAY assignments, FORALL or WHERE statements, " 2613 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US); 2614 } 2615 } 2616 } 2617 2618 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList( 2619 const parser::OmpClause &clause) { 2620 2621 // Clauses with OmpObjectList as its data member 2622 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate, 2623 parser::OmpClause::Copyin, parser::OmpClause::Firstprivate, 2624 parser::OmpClause::From, parser::OmpClause::Lastprivate, 2625 parser::OmpClause::Link, parser::OmpClause::Private, 2626 parser::OmpClause::Shared, parser::OmpClause::To>; 2627 2628 // Clauses with OmpObjectList in the tuple 2629 using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate, 2630 parser::OmpClause::Map, parser::OmpClause::Reduction>; 2631 2632 // TODO:: Generate the tuples using TableGen. 2633 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate. 2634 return std::visit( 2635 common::visitors{ 2636 [&](const auto &x) -> const parser::OmpObjectList * { 2637 using Ty = std::decay_t<decltype(x)>; 2638 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) { 2639 return &x.v; 2640 } else if constexpr (common::HasMember<Ty, 2641 TupleObjectListClauses>) { 2642 return &(std::get<parser::OmpObjectList>(x.v.t)); 2643 } else { 2644 return nullptr; 2645 } 2646 }, 2647 }, 2648 clause.u); 2649 } 2650 2651 } // namespace Fortran::semantics 2652