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