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