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