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