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