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 } 508 509 CheckNoBranching(block, beginDir.v, beginDir.source); 510 511 switch (beginDir.v) { 512 case llvm::omp::OMPD_workshare: 513 case llvm::omp::OMPD_parallel_workshare: 514 CheckWorkshareBlockStmts(block, beginDir.source); 515 HasInvalidWorksharingNesting( 516 beginDir.source, llvm::omp::nestedWorkshareErrSet); 517 break; 518 case llvm::omp::Directive::OMPD_single: 519 // TODO: This check needs to be extended while implementing nesting of 520 // regions checks. 521 HasInvalidWorksharingNesting( 522 beginDir.source, llvm::omp::nestedWorkshareErrSet); 523 break; 524 default: 525 break; 526 } 527 } 528 529 void OmpStructureChecker::CheckIfDoOrderedClause( 530 const parser::OmpBlockDirective &blkDirective) { 531 if (blkDirective.v == llvm::omp::OMPD_ordered) { 532 // Loops 533 if (llvm::omp::doSet.test(GetContextParent().directive) && 534 !FindClauseParent(llvm::omp::Clause::OMPC_ordered)) { 535 context_.Say(blkDirective.source, 536 "The ORDERED clause must be present on the loop" 537 " construct if any ORDERED region ever binds" 538 " to a loop region arising from the loop construct."_err_en_US); 539 } 540 // Other disallowed nestings, these directives do not support 541 // ordered clause in them, so no need to check 542 else if (IsCloselyNestedRegion(llvm::omp::nestedOrderedErrSet)) { 543 context_.Say(blkDirective.source, 544 "`ORDERED` region may not be closely nested inside of " 545 "`CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US); 546 } 547 } 548 } 549 550 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) { 551 dirContext_.pop_back(); 552 } 553 554 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) { 555 const auto &beginSectionsDir{ 556 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 557 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)}; 558 const auto &beginDir{ 559 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 560 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)}; 561 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir); 562 563 PushContextAndClauseSets(beginDir.source, beginDir.v); 564 const auto §ionBlocks{std::get<parser::OmpSectionBlocks>(x.t)}; 565 for (const auto &block : sectionBlocks.v) { 566 CheckNoBranching(block, beginDir.v, beginDir.source); 567 } 568 HasInvalidWorksharingNesting( 569 beginDir.source, llvm::omp::nestedWorkshareErrSet); 570 } 571 572 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) { 573 dirContext_.pop_back(); 574 } 575 576 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) { 577 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)}; 578 ResetPartialContext(dir.source); 579 switch (dir.v) { 580 // 2.7.2 end-sections -> END SECTIONS [nowait-clause] 581 case llvm::omp::Directive::OMPD_sections: 582 PushContextAndClauseSets( 583 dir.source, llvm::omp::Directive::OMPD_end_sections); 584 break; 585 default: 586 // no clauses are allowed 587 break; 588 } 589 } 590 591 // TODO: Verify the popping of dirContext requirement after nowait 592 // implementation, as there is an implicit barrier at the end of the worksharing 593 // constructs unless a nowait clause is specified. Only OMPD_end_sections is 594 // popped becuase it is pushed while entering the EndSectionsDirective. 595 void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) { 596 if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) { 597 dirContext_.pop_back(); 598 } 599 } 600 601 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) { 602 const auto &dir{std::get<parser::Verbatim>(x.t)}; 603 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd); 604 } 605 606 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) { 607 dirContext_.pop_back(); 608 } 609 610 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { 611 const auto &dir{std::get<parser::Verbatim>(x.t)}; 612 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 613 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 614 CheckIsVarPartOfAnotherVar(dir.source, objectList); 615 } 616 617 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { 618 dirContext_.pop_back(); 619 } 620 621 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) { 622 const auto &dir{std::get<parser::Verbatim>(x.t)}; 623 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target); 624 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)}; 625 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) { 626 SetClauseSets(llvm::omp::Directive::OMPD_declare_target); 627 } 628 } 629 630 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) { 631 dirContext_.pop_back(); 632 } 633 634 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { 635 const auto &dir{std::get<parser::Verbatim>(x.t)}; 636 const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)}; 637 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 638 if (objectList) 639 CheckIsVarPartOfAnotherVar(dir.source, *objectList); 640 } 641 642 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) { 643 dirContext_.pop_back(); 644 } 645 646 void OmpStructureChecker::Enter( 647 const parser::OpenMPSimpleStandaloneConstruct &x) { 648 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)}; 649 PushContextAndClauseSets(dir.source, dir.v); 650 } 651 652 void OmpStructureChecker::Leave( 653 const parser::OpenMPSimpleStandaloneConstruct &) { 654 dirContext_.pop_back(); 655 } 656 657 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) { 658 const auto &dir{std::get<parser::Verbatim>(x.t)}; 659 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush); 660 } 661 662 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) { 663 if (FindClause(llvm::omp::Clause::OMPC_acquire) || 664 FindClause(llvm::omp::Clause::OMPC_release) || 665 FindClause(llvm::omp::Clause::OMPC_acq_rel)) { 666 if (const auto &flushList{ 667 std::get<std::optional<parser::OmpObjectList>>(x.t)}) { 668 context_.Say(parser::FindSourceLocation(flushList), 669 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items " 670 "must not be specified on the FLUSH directive"_err_en_US); 671 } 672 } 673 dirContext_.pop_back(); 674 } 675 676 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) { 677 const auto &dir{std::get<parser::Verbatim>(x.t)}; 678 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel); 679 } 680 681 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) { 682 dirContext_.pop_back(); 683 } 684 685 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { 686 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)}; 687 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); 688 const auto &block{std::get<parser::Block>(x.t)}; 689 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); 690 } 691 692 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { 693 dirContext_.pop_back(); 694 } 695 696 void OmpStructureChecker::Enter( 697 const parser::OpenMPCancellationPointConstruct &x) { 698 const auto &dir{std::get<parser::Verbatim>(x.t)}; 699 PushContextAndClauseSets( 700 dir.source, llvm::omp::Directive::OMPD_cancellation_point); 701 } 702 703 void OmpStructureChecker::Leave( 704 const parser::OpenMPCancellationPointConstruct &) { 705 dirContext_.pop_back(); 706 } 707 708 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) { 709 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)}; 710 ResetPartialContext(dir.source); 711 switch (dir.v) { 712 // 2.7.3 end-single-clause -> copyprivate-clause | 713 // nowait-clause 714 case llvm::omp::Directive::OMPD_single: 715 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single); 716 break; 717 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause] 718 case llvm::omp::Directive::OMPD_workshare: 719 PushContextAndClauseSets( 720 dir.source, llvm::omp::Directive::OMPD_end_workshare); 721 break; 722 default: 723 // no clauses are allowed 724 break; 725 } 726 } 727 728 // TODO: Verify the popping of dirContext requirement after nowait 729 // implementation, as there is an implicit barrier at the end of the worksharing 730 // constructs unless a nowait clause is specified. Only OMPD_end_single and 731 // end_workshareare popped as they are pushed while entering the 732 // EndBlockDirective. 733 void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) { 734 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) || 735 (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) { 736 dirContext_.pop_back(); 737 } 738 } 739 740 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) { 741 std::visit( 742 common::visitors{ 743 [&](const auto &someAtomicConstruct) { 744 const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)}; 745 PushContextAndClauseSets( 746 dir.source, llvm::omp::Directive::OMPD_atomic); 747 }, 748 }, 749 x.u); 750 } 751 752 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) { 753 dirContext_.pop_back(); 754 } 755 756 // Clauses 757 // Mainly categorized as 758 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'. 759 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h. 760 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h. 761 762 void OmpStructureChecker::Leave(const parser::OmpClauseList &) { 763 // 2.7 Loop Construct Restriction 764 if (llvm::omp::doSet.test(GetContext().directive)) { 765 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) { 766 // only one schedule clause is allowed 767 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)}; 768 if (ScheduleModifierHasType(schedClause.v, 769 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 770 if (FindClause(llvm::omp::Clause::OMPC_ordered)) { 771 context_.Say(clause->source, 772 "The NONMONOTONIC modifier cannot be specified " 773 "if an ORDERED clause is specified"_err_en_US); 774 } 775 if (ScheduleModifierHasType(schedClause.v, 776 parser::OmpScheduleModifierType::ModType::Monotonic)) { 777 context_.Say(clause->source, 778 "The MONOTONIC and NONMONOTONIC modifiers " 779 "cannot be both specified"_err_en_US); 780 } 781 } 782 } 783 784 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) { 785 // only one ordered clause is allowed 786 const auto &orderedClause{ 787 std::get<parser::OmpClause::Ordered>(clause->u)}; 788 789 if (orderedClause.v) { 790 CheckNotAllowedIfClause( 791 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear}); 792 793 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) { 794 const auto &collapseClause{ 795 std::get<parser::OmpClause::Collapse>(clause2->u)}; 796 // ordered and collapse both have parameters 797 if (const auto orderedValue{GetIntValue(orderedClause.v)}) { 798 if (const auto collapseValue{GetIntValue(collapseClause.v)}) { 799 if (*orderedValue > 0 && *orderedValue < *collapseValue) { 800 context_.Say(clause->source, 801 "The parameter of the ORDERED clause must be " 802 "greater than or equal to " 803 "the parameter of the COLLAPSE clause"_err_en_US); 804 } 805 } 806 } 807 } 808 } 809 810 // TODO: ordered region binding check (requires nesting implementation) 811 } 812 } // doSet 813 814 // 2.8.1 Simd Construct Restriction 815 if (llvm::omp::simdSet.test(GetContext().directive)) { 816 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) { 817 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) { 818 const auto &simdlenClause{ 819 std::get<parser::OmpClause::Simdlen>(clause->u)}; 820 const auto &safelenClause{ 821 std::get<parser::OmpClause::Safelen>(clause2->u)}; 822 // simdlen and safelen both have parameters 823 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) { 824 if (const auto safelenValue{GetIntValue(safelenClause.v)}) { 825 if (*safelenValue > 0 && *simdlenValue > *safelenValue) { 826 context_.Say(clause->source, 827 "The parameter of the SIMDLEN clause must be less than or " 828 "equal to the parameter of the SAFELEN clause"_err_en_US); 829 } 830 } 831 } 832 } 833 } 834 // A list-item cannot appear in more than one aligned clause 835 semantics::UnorderedSymbolSet alignedVars; 836 auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_aligned); 837 for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) { 838 const auto &alignedClause{ 839 std::get<parser::OmpClause::Aligned>(itr->second->u)}; 840 const auto &alignedNameList{ 841 std::get<std::list<parser::Name>>(alignedClause.v.t)}; 842 for (auto const &var : alignedNameList) { 843 if (alignedVars.count(*(var.symbol)) == 1) { 844 context_.Say(itr->second->source, 845 "List item '%s' present at multiple ALIGNED clauses"_err_en_US, 846 var.ToString()); 847 break; 848 } 849 alignedVars.insert(*(var.symbol)); 850 } 851 } 852 } // SIMD 853 854 // 2.7.3 Single Construct Restriction 855 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) { 856 CheckNotAllowedIfClause( 857 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait}); 858 } 859 860 CheckRequireAtLeastOneOf(); 861 } 862 863 void OmpStructureChecker::Enter(const parser::OmpClause &x) { 864 SetContextClause(x); 865 } 866 867 // Following clauses do not have a separate node in parse-tree.h. 868 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel) 869 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire) 870 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order) 871 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) 872 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate) 873 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) 874 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin) 875 CHECK_SIMPLE_CLAUSE(Default, OMPC_default) 876 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) 877 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy) 878 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach) 879 CHECK_SIMPLE_CLAUSE(Device, OMPC_device) 880 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) 881 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) 882 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators) 883 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) 884 CHECK_SIMPLE_CLAUSE(Final, OMPC_final) 885 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush) 886 CHECK_SIMPLE_CLAUSE(From, OMPC_from) 887 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint) 888 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction) 889 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) 890 CHECK_SIMPLE_CLAUSE(Match, OMPC_match) 891 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal) 892 CHECK_SIMPLE_CLAUSE(Order, OMPC_order) 893 CHECK_SIMPLE_CLAUSE(Read, OMPC_read) 894 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload) 895 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate) 896 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads) 897 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) 898 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr) 899 CHECK_SIMPLE_CLAUSE(Link, OMPC_link) 900 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) 901 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) 902 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) 903 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait) 904 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind) 905 CHECK_SIMPLE_CLAUSE(Release, OMPC_release) 906 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) 907 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) 908 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) 909 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes) 910 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction) 911 CHECK_SIMPLE_CLAUSE(To, OMPC_to) 912 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address) 913 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory) 914 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) 915 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) 916 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) 917 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr) 918 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators) 919 CHECK_SIMPLE_CLAUSE(Update, OMPC_update) 920 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr) 921 CHECK_SIMPLE_CLAUSE(Write, OMPC_write) 922 CHECK_SIMPLE_CLAUSE(Init, OMPC_init) 923 CHECK_SIMPLE_CLAUSE(Use, OMPC_use) 924 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants) 925 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) 926 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) 927 928 CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator) 929 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) 930 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks) 931 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) 932 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads) 933 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority) 934 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit) 935 936 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse) 937 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen) 938 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen) 939 940 // Restrictions specific to each clause are implemented apart from the 941 // generalized restrictions. 942 void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) { 943 CheckAllowed(llvm::omp::Clause::OMPC_reduction); 944 if (CheckReductionOperators(x)) { 945 CheckReductionTypeList(x); 946 } 947 } 948 bool OmpStructureChecker::CheckReductionOperators( 949 const parser::OmpClause::Reduction &x) { 950 951 const auto &definedOp{std::get<0>(x.v.t)}; 952 bool ok = false; 953 std::visit( 954 common::visitors{ 955 [&](const parser::DefinedOperator &dOpr) { 956 const auto &intrinsicOp{ 957 std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)}; 958 ok = CheckIntrinsicOperator(intrinsicOp); 959 }, 960 [&](const parser::ProcedureDesignator &procD) { 961 const parser::Name *name{std::get_if<parser::Name>(&procD.u)}; 962 if (name) { 963 if (name->source == "max" || name->source == "min" || 964 name->source == "iand" || name->source == "ior" || 965 name->source == "ieor") { 966 ok = true; 967 } else { 968 context_.Say(GetContext().clauseSource, 969 "Invalid reduction identifier in REDUCTION clause."_err_en_US, 970 ContextDirectiveAsFortran()); 971 } 972 } 973 }, 974 }, 975 definedOp.u); 976 977 return ok; 978 } 979 bool OmpStructureChecker::CheckIntrinsicOperator( 980 const parser::DefinedOperator::IntrinsicOperator &op) { 981 982 switch (op) { 983 case parser::DefinedOperator::IntrinsicOperator::Add: 984 case parser::DefinedOperator::IntrinsicOperator::Subtract: 985 case parser::DefinedOperator::IntrinsicOperator::Multiply: 986 case parser::DefinedOperator::IntrinsicOperator::AND: 987 case parser::DefinedOperator::IntrinsicOperator::OR: 988 case parser::DefinedOperator::IntrinsicOperator::EQV: 989 case parser::DefinedOperator::IntrinsicOperator::NEQV: 990 return true; 991 default: 992 context_.Say(GetContext().clauseSource, 993 "Invalid reduction operator in REDUCTION clause."_err_en_US, 994 ContextDirectiveAsFortran()); 995 } 996 return false; 997 } 998 999 void OmpStructureChecker::CheckReductionTypeList( 1000 const parser::OmpClause::Reduction &x) { 1001 const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)}; 1002 CheckIntentInPointerAndDefinable( 1003 ompObjectList, llvm::omp::Clause::OMPC_reduction); 1004 CheckReductionArraySection(ompObjectList); 1005 CheckMultipleAppearanceAcrossContext(ompObjectList); 1006 } 1007 1008 void OmpStructureChecker::CheckIntentInPointerAndDefinable( 1009 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 1010 for (const auto &ompObject : objectList.v) { 1011 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1012 if (const auto *symbol{name->symbol}) { 1013 if (IsPointer(symbol->GetUltimate()) && 1014 IsIntentIn(symbol->GetUltimate())) { 1015 context_.Say(GetContext().clauseSource, 1016 "Pointer '%s' with the INTENT(IN) attribute may not appear " 1017 "in a %s clause"_err_en_US, 1018 symbol->name(), 1019 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1020 } 1021 if (auto msg{ 1022 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) { 1023 context_.Say(GetContext().clauseSource, 1024 "Variable '%s' on the %s clause is not definable"_err_en_US, 1025 symbol->name(), 1026 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1027 } 1028 } 1029 } 1030 } 1031 } 1032 1033 void OmpStructureChecker::CheckReductionArraySection( 1034 const parser::OmpObjectList &ompObjectList) { 1035 for (const auto &ompObject : ompObjectList.v) { 1036 if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) { 1037 if (const auto *arrayElement{ 1038 parser::Unwrap<parser::ArrayElement>(ompObject)}) { 1039 if (arrayElement) { 1040 CheckArraySection(*arrayElement, GetLastName(*dataRef), 1041 llvm::omp::Clause::OMPC_reduction); 1042 } 1043 } 1044 } 1045 } 1046 } 1047 1048 void OmpStructureChecker::CheckMultipleAppearanceAcrossContext( 1049 const parser::OmpObjectList &redObjectList) { 1050 // TODO: Verify the assumption here that the immediately enclosing region is 1051 // the parallel region to which the worksharing construct having reduction 1052 // binds to. 1053 if (auto *enclosingContext{GetEnclosingDirContext()}) { 1054 for (auto it : enclosingContext->clauseInfo) { 1055 llvmOmpClause type = it.first; 1056 const auto *clause = it.second; 1057 if (llvm::omp::privateReductionSet.test(type)) { 1058 if (const auto *objList{GetOmpObjectList(*clause)}) { 1059 for (const auto &ompObject : objList->v) { 1060 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1061 if (const auto *symbol{name->symbol}) { 1062 for (const auto &redOmpObject : redObjectList.v) { 1063 if (const auto *rname{ 1064 parser::Unwrap<parser::Name>(redOmpObject)}) { 1065 if (const auto *rsymbol{rname->symbol}) { 1066 if (rsymbol->name() == symbol->name()) { 1067 context_.Say(GetContext().clauseSource, 1068 "%s variable '%s' is %s in outer context must" 1069 " be shared in the parallel regions to which any" 1070 " of the worksharing regions arising from the " 1071 "worksharing" 1072 " construct bind."_err_en_US, 1073 parser::ToUpperCaseLetters( 1074 getClauseName(llvm::omp::Clause::OMPC_reduction) 1075 .str()), 1076 symbol->name(), 1077 parser::ToUpperCaseLetters( 1078 getClauseName(type).str())); 1079 } 1080 } 1081 } 1082 } 1083 } 1084 } 1085 } 1086 } 1087 } 1088 } 1089 } 1090 } 1091 1092 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) { 1093 CheckAllowed(llvm::omp::Clause::OMPC_ordered); 1094 // the parameter of ordered clause is optional 1095 if (const auto &expr{x.v}) { 1096 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr); 1097 // 2.8.3 Loop SIMD Construct Restriction 1098 if (llvm::omp::doSimdSet.test(GetContext().directive)) { 1099 context_.Say(GetContext().clauseSource, 1100 "No ORDERED clause with a parameter can be specified " 1101 "on the %s directive"_err_en_US, 1102 ContextDirectiveAsFortran()); 1103 } 1104 } 1105 } 1106 1107 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) { 1108 CheckAllowed(llvm::omp::Clause::OMPC_shared); 1109 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); 1110 } 1111 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { 1112 CheckAllowed(llvm::omp::Clause::OMPC_private); 1113 CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); 1114 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); 1115 } 1116 1117 void OmpStructureChecker::CheckIsVarPartOfAnotherVar( 1118 const parser::CharBlock &source, const parser::OmpObjectList &objList) { 1119 1120 for (const auto &ompObject : objList.v) { 1121 std::visit( 1122 common::visitors{ 1123 [&](const parser::Designator &designator) { 1124 if (std::get_if<parser::DataRef>(&designator.u)) { 1125 if ((parser::Unwrap<parser::StructureComponent>(ompObject)) || 1126 (parser::Unwrap<parser::ArrayElement>(ompObject))) { 1127 context_.Say(source, 1128 "A variable that is part of another variable (as an " 1129 "array or structure element)" 1130 " cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive."_err_en_US); 1131 } 1132 } 1133 }, 1134 [&](const parser::Name &name) {}, 1135 }, 1136 ompObject.u); 1137 } 1138 } 1139 1140 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { 1141 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); 1142 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); 1143 1144 SymbolSourceMap currSymbols; 1145 GetSymbolsInObjectList(x.v, currSymbols); 1146 1147 DirectivesClauseTriple dirClauseTriple; 1148 // Check firstprivate variables in worksharing constructs 1149 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 1150 std::make_pair( 1151 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1152 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 1153 std::make_pair( 1154 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1155 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single, 1156 std::make_pair( 1157 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1158 // Check firstprivate variables in distribute construct 1159 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 1160 std::make_pair( 1161 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet)); 1162 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 1163 std::make_pair(llvm::omp::Directive::OMPD_target_teams, 1164 llvm::omp::privateReductionSet)); 1165 // Check firstprivate variables in task and taskloop constructs 1166 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task, 1167 std::make_pair(llvm::omp::Directive::OMPD_parallel, 1168 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 1169 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop, 1170 std::make_pair(llvm::omp::Directive::OMPD_parallel, 1171 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 1172 1173 CheckPrivateSymbolsInOuterCxt( 1174 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate); 1175 } 1176 1177 void OmpStructureChecker::CheckIsLoopIvPartOfClause( 1178 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) { 1179 for (const auto &ompObject : ompObjectList.v) { 1180 if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) { 1181 if (name->symbol == GetContext().loopIV) { 1182 context_.Say(name->source, 1183 "DO iteration variable %s is not allowed in %s clause."_err_en_US, 1184 name->ToString(), 1185 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1186 } 1187 } 1188 } 1189 } 1190 // Following clauses have a seperate node in parse-tree.h. 1191 // Atomic-clause 1192 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read) 1193 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write) 1194 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update) 1195 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture) 1196 1197 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) { 1198 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read, 1199 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel}); 1200 } 1201 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) { 1202 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write, 1203 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 1204 } 1205 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) { 1206 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update, 1207 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 1208 } 1209 // OmpAtomic node represents atomic directive without atomic-clause. 1210 // atomic-clause - READ,WRITE,UPDATE,CAPTURE. 1211 void OmpStructureChecker::Leave(const parser::OmpAtomic &) { 1212 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) { 1213 context_.Say(clause->source, 1214 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US); 1215 } 1216 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) { 1217 context_.Say(clause->source, 1218 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US); 1219 } 1220 } 1221 // Restrictions specific to each clause are implemented apart from the 1222 // generalized restrictions. 1223 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) { 1224 CheckAllowed(llvm::omp::Clause::OMPC_aligned); 1225 1226 if (const auto &expr{ 1227 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) { 1228 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr); 1229 } 1230 // 2.8.1 TODO: list-item attribute check 1231 } 1232 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) { 1233 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap); 1234 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory; 1235 if (!std::get<std::optional<VariableCategory>>(x.v.t)) { 1236 context_.Say(GetContext().clauseSource, 1237 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP " 1238 "clause"_err_en_US); 1239 } 1240 } 1241 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) { 1242 CheckAllowed(llvm::omp::Clause::OMPC_if); 1243 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier; 1244 static std::unordered_map<dirNameModifier, OmpDirectiveSet> 1245 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet}, 1246 {dirNameModifier::Target, llvm::omp::targetSet}, 1247 {dirNameModifier::TargetEnterData, 1248 {llvm::omp::Directive::OMPD_target_enter_data}}, 1249 {dirNameModifier::TargetExitData, 1250 {llvm::omp::Directive::OMPD_target_exit_data}}, 1251 {dirNameModifier::TargetData, 1252 {llvm::omp::Directive::OMPD_target_data}}, 1253 {dirNameModifier::TargetUpdate, 1254 {llvm::omp::Directive::OMPD_target_update}}, 1255 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}}, 1256 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}}; 1257 if (const auto &directiveName{ 1258 std::get<std::optional<dirNameModifier>>(x.v.t)}) { 1259 auto search{dirNameModifierMap.find(*directiveName)}; 1260 if (search == dirNameModifierMap.end() || 1261 !search->second.test(GetContext().directive)) { 1262 context_ 1263 .Say(GetContext().clauseSource, 1264 "Unmatched directive name modifier %s on the IF clause"_err_en_US, 1265 parser::ToUpperCaseLetters( 1266 parser::OmpIfClause::EnumToString(*directiveName))) 1267 .Attach( 1268 GetContext().directiveSource, "Cannot apply to directive"_en_US); 1269 } 1270 } 1271 } 1272 1273 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { 1274 CheckAllowed(llvm::omp::Clause::OMPC_linear); 1275 1276 // 2.7 Loop Construct Restriction 1277 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) { 1278 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) { 1279 context_.Say(GetContext().clauseSource, 1280 "A modifier may not be specified in a LINEAR clause " 1281 "on the %s directive"_err_en_US, 1282 ContextDirectiveAsFortran()); 1283 } 1284 } 1285 } 1286 1287 void OmpStructureChecker::CheckAllowedMapTypes( 1288 const parser::OmpMapType::Type &type, 1289 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) { 1290 const auto found{std::find( 1291 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)}; 1292 if (found == std::end(allowedMapTypeList)) { 1293 std::string commaSeperatedMapTypes; 1294 llvm::interleave( 1295 allowedMapTypeList.begin(), allowedMapTypeList.end(), 1296 [&](const parser::OmpMapType::Type &mapType) { 1297 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters( 1298 parser::OmpMapType::EnumToString(mapType))); 1299 }, 1300 [&] { commaSeperatedMapTypes.append(", "); }); 1301 context_.Say(GetContext().clauseSource, 1302 "Only the %s map types are permitted " 1303 "for MAP clauses on the %s directive"_err_en_US, 1304 commaSeperatedMapTypes, ContextDirectiveAsFortran()); 1305 } 1306 } 1307 1308 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) { 1309 CheckAllowed(llvm::omp::Clause::OMPC_map); 1310 1311 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) { 1312 using Type = parser::OmpMapType::Type; 1313 const Type &type{std::get<Type>(maptype->t)}; 1314 switch (GetContext().directive) { 1315 case llvm::omp::Directive::OMPD_target: 1316 case llvm::omp::Directive::OMPD_target_teams: 1317 case llvm::omp::Directive::OMPD_target_teams_distribute: 1318 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 1319 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 1320 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 1321 case llvm::omp::Directive::OMPD_target_data: 1322 CheckAllowedMapTypes( 1323 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc}); 1324 break; 1325 case llvm::omp::Directive::OMPD_target_enter_data: 1326 CheckAllowedMapTypes(type, {Type::To, Type::Alloc}); 1327 break; 1328 case llvm::omp::Directive::OMPD_target_exit_data: 1329 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete}); 1330 break; 1331 default: 1332 break; 1333 } 1334 } 1335 } 1336 1337 bool OmpStructureChecker::ScheduleModifierHasType( 1338 const parser::OmpScheduleClause &x, 1339 const parser::OmpScheduleModifierType::ModType &type) { 1340 const auto &modifier{ 1341 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)}; 1342 if (modifier) { 1343 const auto &modType1{ 1344 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)}; 1345 const auto &modType2{ 1346 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>( 1347 modifier->t)}; 1348 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) { 1349 return true; 1350 } 1351 } 1352 return false; 1353 } 1354 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) { 1355 CheckAllowed(llvm::omp::Clause::OMPC_schedule); 1356 const parser::OmpScheduleClause &scheduleClause = x.v; 1357 1358 // 2.7 Loop Construct Restriction 1359 if (llvm::omp::doSet.test(GetContext().directive)) { 1360 const auto &kind{std::get<1>(scheduleClause.t)}; 1361 const auto &chunk{std::get<2>(scheduleClause.t)}; 1362 if (chunk) { 1363 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime || 1364 kind == parser::OmpScheduleClause::ScheduleType::Auto) { 1365 context_.Say(GetContext().clauseSource, 1366 "When SCHEDULE clause has %s specified, " 1367 "it must not have chunk size specified"_err_en_US, 1368 parser::ToUpperCaseLetters( 1369 parser::OmpScheduleClause::EnumToString(kind))); 1370 } 1371 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>( 1372 scheduleClause.t)}) { 1373 RequiresPositiveParameter( 1374 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size"); 1375 } 1376 } 1377 1378 if (ScheduleModifierHasType(scheduleClause, 1379 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 1380 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic && 1381 kind != parser::OmpScheduleClause::ScheduleType::Guided) { 1382 context_.Say(GetContext().clauseSource, 1383 "The NONMONOTONIC modifier can only be specified with " 1384 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US); 1385 } 1386 } 1387 } 1388 } 1389 1390 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) { 1391 CheckAllowed(llvm::omp::Clause::OMPC_depend); 1392 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) { 1393 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)}; 1394 for (const auto &ele : designators) { 1395 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) { 1396 CheckDependList(*dataRef); 1397 if (const auto *arr{ 1398 std::get_if<common::Indirection<parser::ArrayElement>>( 1399 &dataRef->u)}) { 1400 CheckArraySection(arr->value(), GetLastName(*dataRef), 1401 llvm::omp::Clause::OMPC_depend); 1402 } 1403 } 1404 } 1405 } 1406 } 1407 1408 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) { 1409 CheckAllowed(llvm::omp::Clause::OMPC_copyprivate); 1410 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate); 1411 } 1412 1413 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) { 1414 CheckAllowed(llvm::omp::Clause::OMPC_lastprivate); 1415 1416 DirectivesClauseTriple dirClauseTriple; 1417 SymbolSourceMap currSymbols; 1418 GetSymbolsInObjectList(x.v, currSymbols); 1419 CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x)); 1420 1421 // Check lastprivate variables in worksharing constructs 1422 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 1423 std::make_pair( 1424 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1425 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 1426 std::make_pair( 1427 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1428 1429 CheckPrivateSymbolsInOuterCxt( 1430 currSymbols, dirClauseTriple, GetClauseKindForParserClass(x)); 1431 } 1432 1433 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { 1434 return llvm::omp::getOpenMPClauseName(clause); 1435 } 1436 1437 llvm::StringRef OmpStructureChecker::getDirectiveName( 1438 llvm::omp::Directive directive) { 1439 return llvm::omp::getOpenMPDirectiveName(directive); 1440 } 1441 1442 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) { 1443 std::visit( 1444 common::visitors{ 1445 [&](const common::Indirection<parser::ArrayElement> &elem) { 1446 // Check if the base element is valid on Depend Clause 1447 CheckDependList(elem.value().base); 1448 }, 1449 [&](const common::Indirection<parser::StructureComponent> &) { 1450 context_.Say(GetContext().clauseSource, 1451 "A variable that is part of another variable " 1452 "(such as an element of a structure) but is not an array " 1453 "element or an array section cannot appear in a DEPEND " 1454 "clause"_err_en_US); 1455 }, 1456 [&](const common::Indirection<parser::CoindexedNamedObject> &) { 1457 context_.Say(GetContext().clauseSource, 1458 "Coarrays are not supported in DEPEND clause"_err_en_US); 1459 }, 1460 [&](const parser::Name &) { return; }, 1461 }, 1462 d.u); 1463 } 1464 1465 // Called from both Reduction and Depend clause. 1466 void OmpStructureChecker::CheckArraySection( 1467 const parser::ArrayElement &arrayElement, const parser::Name &name, 1468 const llvm::omp::Clause clause) { 1469 if (!arrayElement.subscripts.empty()) { 1470 for (const auto &subscript : arrayElement.subscripts) { 1471 if (const auto *triplet{ 1472 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) { 1473 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) { 1474 const auto &lower{std::get<0>(triplet->t)}; 1475 const auto &upper{std::get<1>(triplet->t)}; 1476 if (lower && upper) { 1477 const auto lval{GetIntValue(lower)}; 1478 const auto uval{GetIntValue(upper)}; 1479 if (lval && uval && *uval < *lval) { 1480 context_.Say(GetContext().clauseSource, 1481 "'%s' in %s clause" 1482 " is a zero size array section"_err_en_US, 1483 name.ToString(), 1484 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1485 break; 1486 } else if (std::get<2>(triplet->t)) { 1487 const auto &strideExpr{std::get<2>(triplet->t)}; 1488 if (strideExpr) { 1489 if (clause == llvm::omp::Clause::OMPC_depend) { 1490 context_.Say(GetContext().clauseSource, 1491 "Stride should not be specified for array section in " 1492 "DEPEND " 1493 "clause"_err_en_US); 1494 } 1495 const auto stride{GetIntValue(strideExpr)}; 1496 if ((stride && stride != 1)) { 1497 context_.Say(GetContext().clauseSource, 1498 "A list item that appears in a REDUCTION clause" 1499 " should have a contiguous storage array section."_err_en_US, 1500 ContextDirectiveAsFortran()); 1501 break; 1502 } 1503 } 1504 } 1505 } 1506 } 1507 } 1508 } 1509 } 1510 } 1511 1512 void OmpStructureChecker::CheckIntentInPointer( 1513 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 1514 SymbolSourceMap symbols; 1515 GetSymbolsInObjectList(objectList, symbols); 1516 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 1517 const auto *symbol{it->first}; 1518 const auto source{it->second}; 1519 if (IsPointer(*symbol) && IsIntentIn(*symbol)) { 1520 context_.Say(source, 1521 "Pointer '%s' with the INTENT(IN) attribute may not appear " 1522 "in a %s clause"_err_en_US, 1523 symbol->name(), 1524 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1525 } 1526 } 1527 } 1528 1529 void OmpStructureChecker::GetSymbolsInObjectList( 1530 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) { 1531 for (const auto &ompObject : objectList.v) { 1532 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1533 if (const auto *symbol{name->symbol}) { 1534 if (const auto *commonBlockDetails{ 1535 symbol->detailsIf<CommonBlockDetails>()}) { 1536 for (const auto &object : commonBlockDetails->objects()) { 1537 symbols.emplace(&object->GetUltimate(), name->source); 1538 } 1539 } else { 1540 symbols.emplace(&symbol->GetUltimate(), name->source); 1541 } 1542 } 1543 } 1544 } 1545 } 1546 1547 void OmpStructureChecker::CheckDefinableObjects( 1548 SymbolSourceMap &symbols, const llvm::omp::Clause clause) { 1549 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 1550 const auto *symbol{it->first}; 1551 const auto source{it->second}; 1552 if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) { 1553 context_ 1554 .Say(source, 1555 "Variable '%s' on the %s clause is not definable"_err_en_US, 1556 symbol->name(), 1557 parser::ToUpperCaseLetters(getClauseName(clause).str())) 1558 .Attach(source, std::move(*msg), symbol->name()); 1559 } 1560 } 1561 } 1562 1563 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt( 1564 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple, 1565 const llvm::omp::Clause currClause) { 1566 SymbolSourceMap enclosingSymbols; 1567 auto range{dirClauseTriple.equal_range(GetContext().directive)}; 1568 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) { 1569 auto enclosingDir{dirIter->second.first}; 1570 auto enclosingClauseSet{dirIter->second.second}; 1571 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) { 1572 for (auto it{enclosingContext->clauseInfo.begin()}; 1573 it != enclosingContext->clauseInfo.end(); ++it) { 1574 if (enclosingClauseSet.test(it->first)) { 1575 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) { 1576 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols); 1577 } 1578 } 1579 } 1580 1581 // Check if the symbols in current context are private in outer context 1582 for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) { 1583 const auto *symbol{iter->first}; 1584 const auto source{iter->second}; 1585 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) { 1586 context_.Say(source, 1587 "%s variable '%s' is PRIVATE in outer context"_err_en_US, 1588 parser::ToUpperCaseLetters(getClauseName(currClause).str()), 1589 symbol->name()); 1590 } 1591 } 1592 } 1593 } 1594 } 1595 1596 void OmpStructureChecker::CheckWorkshareBlockStmts( 1597 const parser::Block &block, parser::CharBlock source) { 1598 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source}; 1599 1600 for (auto it{block.begin()}; it != block.end(); ++it) { 1601 if (parser::Unwrap<parser::AssignmentStmt>(*it) || 1602 parser::Unwrap<parser::ForallStmt>(*it) || 1603 parser::Unwrap<parser::ForallConstruct>(*it) || 1604 parser::Unwrap<parser::WhereStmt>(*it) || 1605 parser::Unwrap<parser::WhereConstruct>(*it)) { 1606 parser::Walk(*it, ompWorkshareBlockChecker); 1607 } else if (const auto *ompConstruct{ 1608 parser::Unwrap<parser::OpenMPConstruct>(*it)}) { 1609 if (const auto *ompAtomicConstruct{ 1610 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) { 1611 // Check if assignment statements in the enclosing OpenMP Atomic 1612 // construct are allowed in the Workshare construct 1613 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker); 1614 } else if (const auto *ompCriticalConstruct{ 1615 std::get_if<parser::OpenMPCriticalConstruct>( 1616 &ompConstruct->u)}) { 1617 // All the restrictions on the Workshare construct apply to the 1618 // statements in the enclosing critical constructs 1619 const auto &criticalBlock{ 1620 std::get<parser::Block>(ompCriticalConstruct->t)}; 1621 CheckWorkshareBlockStmts(criticalBlock, source); 1622 } else { 1623 // Check if OpenMP constructs enclosed in the Workshare construct are 1624 // 'Parallel' constructs 1625 auto currentDir{llvm::omp::Directive::OMPD_unknown}; 1626 const OmpDirectiveSet parallelDirSet{ 1627 llvm::omp::Directive::OMPD_parallel, 1628 llvm::omp::Directive::OMPD_parallel_do, 1629 llvm::omp::Directive::OMPD_parallel_sections, 1630 llvm::omp::Directive::OMPD_parallel_workshare, 1631 llvm::omp::Directive::OMPD_parallel_do_simd}; 1632 1633 if (const auto *ompBlockConstruct{ 1634 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) { 1635 const auto &beginBlockDir{ 1636 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)}; 1637 const auto &beginDir{ 1638 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1639 currentDir = beginDir.v; 1640 } else if (const auto *ompLoopConstruct{ 1641 std::get_if<parser::OpenMPLoopConstruct>( 1642 &ompConstruct->u)}) { 1643 const auto &beginLoopDir{ 1644 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)}; 1645 const auto &beginDir{ 1646 std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 1647 currentDir = beginDir.v; 1648 } else if (const auto *ompSectionsConstruct{ 1649 std::get_if<parser::OpenMPSectionsConstruct>( 1650 &ompConstruct->u)}) { 1651 const auto &beginSectionsDir{ 1652 std::get<parser::OmpBeginSectionsDirective>( 1653 ompSectionsConstruct->t)}; 1654 const auto &beginDir{ 1655 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 1656 currentDir = beginDir.v; 1657 } 1658 1659 if (!parallelDirSet.test(currentDir)) { 1660 context_.Say(source, 1661 "OpenMP constructs enclosed in WORKSHARE construct may consist " 1662 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US); 1663 } 1664 } 1665 } else { 1666 context_.Say(source, 1667 "The structured block in a WORKSHARE construct may consist of only " 1668 "SCALAR or ARRAY assignments, FORALL or WHERE statements, " 1669 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US); 1670 } 1671 } 1672 } 1673 1674 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList( 1675 const parser::OmpClause &clause) { 1676 1677 // Clauses with OmpObjectList as its data member 1678 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate, 1679 parser::OmpClause::Copyin, parser::OmpClause::Firstprivate, 1680 parser::OmpClause::From, parser::OmpClause::Lastprivate, 1681 parser::OmpClause::Link, parser::OmpClause::Private, 1682 parser::OmpClause::Shared, parser::OmpClause::To>; 1683 1684 // Clauses with OmpObjectList in the tuple 1685 using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate, 1686 parser::OmpClause::Map, parser::OmpClause::Reduction>; 1687 1688 // TODO:: Generate the tuples using TableGen. 1689 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate. 1690 return std::visit( 1691 common::visitors{ 1692 [&](const auto &x) -> const parser::OmpObjectList * { 1693 using Ty = std::decay_t<decltype(x)>; 1694 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) { 1695 return &x.v; 1696 } else if constexpr (common::HasMember<Ty, 1697 TupleObjectListClauses>) { 1698 return &(std::get<parser::OmpObjectList>(x.v.t)); 1699 } else { 1700 return nullptr; 1701 } 1702 }, 1703 }, 1704 clause.u); 1705 } 1706 1707 } // namespace Fortran::semantics 1708