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