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 bool OmpStructureChecker::IsDataRefTypeParamInquiry( 1135 const parser::DataRef *dataRef) { 1136 bool dataRefIsTypeParamInquiry{false}; 1137 if (const auto *structComp{ 1138 parser::Unwrap<parser::StructureComponent>(dataRef)}) { 1139 if (const auto *compSymbol{structComp->component.symbol}) { 1140 if (const auto *compSymbolMiscDetails{ 1141 std::get_if<MiscDetails>(&compSymbol->details())}) { 1142 const auto detailsKind = compSymbolMiscDetails->kind(); 1143 dataRefIsTypeParamInquiry = 1144 (detailsKind == MiscDetails::Kind::KindParamInquiry || 1145 detailsKind == MiscDetails::Kind::LenParamInquiry); 1146 } else if (compSymbol->has<TypeParamDetails>()) { 1147 dataRefIsTypeParamInquiry = true; 1148 } 1149 } 1150 } 1151 return dataRefIsTypeParamInquiry; 1152 } 1153 1154 void OmpStructureChecker::CheckIsVarPartOfAnotherVar( 1155 const parser::CharBlock &source, const parser::OmpObjectList &objList) { 1156 1157 for (const auto &ompObject : objList.v) { 1158 std::visit( 1159 common::visitors{ 1160 [&](const parser::Designator &designator) { 1161 if (const auto *dataRef{ 1162 std::get_if<parser::DataRef>(&designator.u)}) { 1163 if (IsDataRefTypeParamInquiry(dataRef)) { 1164 context_.Say(source, 1165 "A type parameter inquiry cannot appear in an ALLOCATE directive"_err_en_US); 1166 } else if (parser::Unwrap<parser::StructureComponent>( 1167 ompObject) || 1168 parser::Unwrap<parser::ArrayElement>(ompObject)) { 1169 context_.Say(source, 1170 "A variable that is part of another variable (as an " 1171 "array or structure element)" 1172 " cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive."_err_en_US); 1173 } 1174 } 1175 }, 1176 [&](const parser::Name &name) {}, 1177 }, 1178 ompObject.u); 1179 } 1180 } 1181 1182 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { 1183 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); 1184 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); 1185 1186 SymbolSourceMap currSymbols; 1187 GetSymbolsInObjectList(x.v, currSymbols); 1188 1189 DirectivesClauseTriple dirClauseTriple; 1190 // Check firstprivate variables in worksharing constructs 1191 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 1192 std::make_pair( 1193 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1194 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 1195 std::make_pair( 1196 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1197 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single, 1198 std::make_pair( 1199 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1200 // Check firstprivate variables in distribute construct 1201 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 1202 std::make_pair( 1203 llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet)); 1204 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute, 1205 std::make_pair(llvm::omp::Directive::OMPD_target_teams, 1206 llvm::omp::privateReductionSet)); 1207 // Check firstprivate variables in task and taskloop constructs 1208 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task, 1209 std::make_pair(llvm::omp::Directive::OMPD_parallel, 1210 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 1211 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop, 1212 std::make_pair(llvm::omp::Directive::OMPD_parallel, 1213 OmpClauseSet{llvm::omp::Clause::OMPC_reduction})); 1214 1215 CheckPrivateSymbolsInOuterCxt( 1216 currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate); 1217 } 1218 1219 void OmpStructureChecker::CheckIsLoopIvPartOfClause( 1220 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) { 1221 for (const auto &ompObject : ompObjectList.v) { 1222 if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) { 1223 if (name->symbol == GetContext().loopIV) { 1224 context_.Say(name->source, 1225 "DO iteration variable %s is not allowed in %s clause."_err_en_US, 1226 name->ToString(), 1227 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1228 } 1229 } 1230 } 1231 } 1232 // Following clauses have a seperate node in parse-tree.h. 1233 // Atomic-clause 1234 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read) 1235 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write) 1236 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update) 1237 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture) 1238 1239 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) { 1240 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read, 1241 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel}); 1242 } 1243 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) { 1244 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write, 1245 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 1246 } 1247 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) { 1248 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update, 1249 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 1250 } 1251 // OmpAtomic node represents atomic directive without atomic-clause. 1252 // atomic-clause - READ,WRITE,UPDATE,CAPTURE. 1253 void OmpStructureChecker::Leave(const parser::OmpAtomic &) { 1254 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) { 1255 context_.Say(clause->source, 1256 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US); 1257 } 1258 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) { 1259 context_.Say(clause->source, 1260 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US); 1261 } 1262 } 1263 // Restrictions specific to each clause are implemented apart from the 1264 // generalized restrictions. 1265 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) { 1266 CheckAllowed(llvm::omp::Clause::OMPC_aligned); 1267 1268 if (const auto &expr{ 1269 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) { 1270 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr); 1271 } 1272 // 2.8.1 TODO: list-item attribute check 1273 } 1274 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) { 1275 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap); 1276 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory; 1277 if (!std::get<std::optional<VariableCategory>>(x.v.t)) { 1278 context_.Say(GetContext().clauseSource, 1279 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP " 1280 "clause"_err_en_US); 1281 } 1282 } 1283 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) { 1284 CheckAllowed(llvm::omp::Clause::OMPC_if); 1285 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier; 1286 static std::unordered_map<dirNameModifier, OmpDirectiveSet> 1287 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet}, 1288 {dirNameModifier::Target, llvm::omp::targetSet}, 1289 {dirNameModifier::TargetEnterData, 1290 {llvm::omp::Directive::OMPD_target_enter_data}}, 1291 {dirNameModifier::TargetExitData, 1292 {llvm::omp::Directive::OMPD_target_exit_data}}, 1293 {dirNameModifier::TargetData, 1294 {llvm::omp::Directive::OMPD_target_data}}, 1295 {dirNameModifier::TargetUpdate, 1296 {llvm::omp::Directive::OMPD_target_update}}, 1297 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}}, 1298 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}}; 1299 if (const auto &directiveName{ 1300 std::get<std::optional<dirNameModifier>>(x.v.t)}) { 1301 auto search{dirNameModifierMap.find(*directiveName)}; 1302 if (search == dirNameModifierMap.end() || 1303 !search->second.test(GetContext().directive)) { 1304 context_ 1305 .Say(GetContext().clauseSource, 1306 "Unmatched directive name modifier %s on the IF clause"_err_en_US, 1307 parser::ToUpperCaseLetters( 1308 parser::OmpIfClause::EnumToString(*directiveName))) 1309 .Attach( 1310 GetContext().directiveSource, "Cannot apply to directive"_en_US); 1311 } 1312 } 1313 } 1314 1315 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { 1316 CheckAllowed(llvm::omp::Clause::OMPC_linear); 1317 1318 // 2.7 Loop Construct Restriction 1319 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) { 1320 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) { 1321 context_.Say(GetContext().clauseSource, 1322 "A modifier may not be specified in a LINEAR clause " 1323 "on the %s directive"_err_en_US, 1324 ContextDirectiveAsFortran()); 1325 } 1326 } 1327 } 1328 1329 void OmpStructureChecker::CheckAllowedMapTypes( 1330 const parser::OmpMapType::Type &type, 1331 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) { 1332 const auto found{std::find( 1333 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)}; 1334 if (found == std::end(allowedMapTypeList)) { 1335 std::string commaSeperatedMapTypes; 1336 llvm::interleave( 1337 allowedMapTypeList.begin(), allowedMapTypeList.end(), 1338 [&](const parser::OmpMapType::Type &mapType) { 1339 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters( 1340 parser::OmpMapType::EnumToString(mapType))); 1341 }, 1342 [&] { commaSeperatedMapTypes.append(", "); }); 1343 context_.Say(GetContext().clauseSource, 1344 "Only the %s map types are permitted " 1345 "for MAP clauses on the %s directive"_err_en_US, 1346 commaSeperatedMapTypes, ContextDirectiveAsFortran()); 1347 } 1348 } 1349 1350 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) { 1351 CheckAllowed(llvm::omp::Clause::OMPC_map); 1352 1353 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) { 1354 using Type = parser::OmpMapType::Type; 1355 const Type &type{std::get<Type>(maptype->t)}; 1356 switch (GetContext().directive) { 1357 case llvm::omp::Directive::OMPD_target: 1358 case llvm::omp::Directive::OMPD_target_teams: 1359 case llvm::omp::Directive::OMPD_target_teams_distribute: 1360 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 1361 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 1362 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 1363 case llvm::omp::Directive::OMPD_target_data: 1364 CheckAllowedMapTypes( 1365 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc}); 1366 break; 1367 case llvm::omp::Directive::OMPD_target_enter_data: 1368 CheckAllowedMapTypes(type, {Type::To, Type::Alloc}); 1369 break; 1370 case llvm::omp::Directive::OMPD_target_exit_data: 1371 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete}); 1372 break; 1373 default: 1374 break; 1375 } 1376 } 1377 } 1378 1379 bool OmpStructureChecker::ScheduleModifierHasType( 1380 const parser::OmpScheduleClause &x, 1381 const parser::OmpScheduleModifierType::ModType &type) { 1382 const auto &modifier{ 1383 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)}; 1384 if (modifier) { 1385 const auto &modType1{ 1386 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)}; 1387 const auto &modType2{ 1388 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>( 1389 modifier->t)}; 1390 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) { 1391 return true; 1392 } 1393 } 1394 return false; 1395 } 1396 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) { 1397 CheckAllowed(llvm::omp::Clause::OMPC_schedule); 1398 const parser::OmpScheduleClause &scheduleClause = x.v; 1399 1400 // 2.7 Loop Construct Restriction 1401 if (llvm::omp::doSet.test(GetContext().directive)) { 1402 const auto &kind{std::get<1>(scheduleClause.t)}; 1403 const auto &chunk{std::get<2>(scheduleClause.t)}; 1404 if (chunk) { 1405 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime || 1406 kind == parser::OmpScheduleClause::ScheduleType::Auto) { 1407 context_.Say(GetContext().clauseSource, 1408 "When SCHEDULE clause has %s specified, " 1409 "it must not have chunk size specified"_err_en_US, 1410 parser::ToUpperCaseLetters( 1411 parser::OmpScheduleClause::EnumToString(kind))); 1412 } 1413 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>( 1414 scheduleClause.t)}) { 1415 RequiresPositiveParameter( 1416 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size"); 1417 } 1418 } 1419 1420 if (ScheduleModifierHasType(scheduleClause, 1421 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 1422 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic && 1423 kind != parser::OmpScheduleClause::ScheduleType::Guided) { 1424 context_.Say(GetContext().clauseSource, 1425 "The NONMONOTONIC modifier can only be specified with " 1426 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US); 1427 } 1428 } 1429 } 1430 } 1431 1432 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) { 1433 CheckAllowed(llvm::omp::Clause::OMPC_depend); 1434 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) { 1435 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)}; 1436 for (const auto &ele : designators) { 1437 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) { 1438 CheckDependList(*dataRef); 1439 if (const auto *arr{ 1440 std::get_if<common::Indirection<parser::ArrayElement>>( 1441 &dataRef->u)}) { 1442 CheckArraySection(arr->value(), GetLastName(*dataRef), 1443 llvm::omp::Clause::OMPC_depend); 1444 } 1445 } 1446 } 1447 } 1448 } 1449 1450 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) { 1451 CheckAllowed(llvm::omp::Clause::OMPC_copyprivate); 1452 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate); 1453 } 1454 1455 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) { 1456 CheckAllowed(llvm::omp::Clause::OMPC_lastprivate); 1457 1458 DirectivesClauseTriple dirClauseTriple; 1459 SymbolSourceMap currSymbols; 1460 GetSymbolsInObjectList(x.v, currSymbols); 1461 CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x)); 1462 1463 // Check lastprivate variables in worksharing constructs 1464 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do, 1465 std::make_pair( 1466 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1467 dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections, 1468 std::make_pair( 1469 llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet)); 1470 1471 CheckPrivateSymbolsInOuterCxt( 1472 currSymbols, dirClauseTriple, GetClauseKindForParserClass(x)); 1473 } 1474 1475 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { 1476 return llvm::omp::getOpenMPClauseName(clause); 1477 } 1478 1479 llvm::StringRef OmpStructureChecker::getDirectiveName( 1480 llvm::omp::Directive directive) { 1481 return llvm::omp::getOpenMPDirectiveName(directive); 1482 } 1483 1484 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) { 1485 std::visit( 1486 common::visitors{ 1487 [&](const common::Indirection<parser::ArrayElement> &elem) { 1488 // Check if the base element is valid on Depend Clause 1489 CheckDependList(elem.value().base); 1490 }, 1491 [&](const common::Indirection<parser::StructureComponent> &) { 1492 context_.Say(GetContext().clauseSource, 1493 "A variable that is part of another variable " 1494 "(such as an element of a structure) but is not an array " 1495 "element or an array section cannot appear in a DEPEND " 1496 "clause"_err_en_US); 1497 }, 1498 [&](const common::Indirection<parser::CoindexedNamedObject> &) { 1499 context_.Say(GetContext().clauseSource, 1500 "Coarrays are not supported in DEPEND clause"_err_en_US); 1501 }, 1502 [&](const parser::Name &) { return; }, 1503 }, 1504 d.u); 1505 } 1506 1507 // Called from both Reduction and Depend clause. 1508 void OmpStructureChecker::CheckArraySection( 1509 const parser::ArrayElement &arrayElement, const parser::Name &name, 1510 const llvm::omp::Clause clause) { 1511 if (!arrayElement.subscripts.empty()) { 1512 for (const auto &subscript : arrayElement.subscripts) { 1513 if (const auto *triplet{ 1514 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) { 1515 if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) { 1516 const auto &lower{std::get<0>(triplet->t)}; 1517 const auto &upper{std::get<1>(triplet->t)}; 1518 if (lower && upper) { 1519 const auto lval{GetIntValue(lower)}; 1520 const auto uval{GetIntValue(upper)}; 1521 if (lval && uval && *uval < *lval) { 1522 context_.Say(GetContext().clauseSource, 1523 "'%s' in %s clause" 1524 " is a zero size array section"_err_en_US, 1525 name.ToString(), 1526 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1527 break; 1528 } else if (std::get<2>(triplet->t)) { 1529 const auto &strideExpr{std::get<2>(triplet->t)}; 1530 if (strideExpr) { 1531 if (clause == llvm::omp::Clause::OMPC_depend) { 1532 context_.Say(GetContext().clauseSource, 1533 "Stride should not be specified for array section in " 1534 "DEPEND " 1535 "clause"_err_en_US); 1536 } 1537 const auto stride{GetIntValue(strideExpr)}; 1538 if ((stride && stride != 1)) { 1539 context_.Say(GetContext().clauseSource, 1540 "A list item that appears in a REDUCTION clause" 1541 " should have a contiguous storage array section."_err_en_US, 1542 ContextDirectiveAsFortran()); 1543 break; 1544 } 1545 } 1546 } 1547 } 1548 } 1549 } 1550 } 1551 } 1552 } 1553 1554 void OmpStructureChecker::CheckIntentInPointer( 1555 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 1556 SymbolSourceMap symbols; 1557 GetSymbolsInObjectList(objectList, symbols); 1558 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 1559 const auto *symbol{it->first}; 1560 const auto source{it->second}; 1561 if (IsPointer(*symbol) && IsIntentIn(*symbol)) { 1562 context_.Say(source, 1563 "Pointer '%s' with the INTENT(IN) attribute may not appear " 1564 "in a %s clause"_err_en_US, 1565 symbol->name(), 1566 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1567 } 1568 } 1569 } 1570 1571 void OmpStructureChecker::GetSymbolsInObjectList( 1572 const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) { 1573 for (const auto &ompObject : objectList.v) { 1574 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1575 if (const auto *symbol{name->symbol}) { 1576 if (const auto *commonBlockDetails{ 1577 symbol->detailsIf<CommonBlockDetails>()}) { 1578 for (const auto &object : commonBlockDetails->objects()) { 1579 symbols.emplace(&object->GetUltimate(), name->source); 1580 } 1581 } else { 1582 symbols.emplace(&symbol->GetUltimate(), name->source); 1583 } 1584 } 1585 } 1586 } 1587 } 1588 1589 void OmpStructureChecker::CheckDefinableObjects( 1590 SymbolSourceMap &symbols, const llvm::omp::Clause clause) { 1591 for (auto it{symbols.begin()}; it != symbols.end(); ++it) { 1592 const auto *symbol{it->first}; 1593 const auto source{it->second}; 1594 if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) { 1595 context_ 1596 .Say(source, 1597 "Variable '%s' on the %s clause is not definable"_err_en_US, 1598 symbol->name(), 1599 parser::ToUpperCaseLetters(getClauseName(clause).str())) 1600 .Attach(source, std::move(*msg), symbol->name()); 1601 } 1602 } 1603 } 1604 1605 void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt( 1606 SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple, 1607 const llvm::omp::Clause currClause) { 1608 SymbolSourceMap enclosingSymbols; 1609 auto range{dirClauseTriple.equal_range(GetContext().directive)}; 1610 for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) { 1611 auto enclosingDir{dirIter->second.first}; 1612 auto enclosingClauseSet{dirIter->second.second}; 1613 if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) { 1614 for (auto it{enclosingContext->clauseInfo.begin()}; 1615 it != enclosingContext->clauseInfo.end(); ++it) { 1616 if (enclosingClauseSet.test(it->first)) { 1617 if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) { 1618 GetSymbolsInObjectList(*ompObjectList, enclosingSymbols); 1619 } 1620 } 1621 } 1622 1623 // Check if the symbols in current context are private in outer context 1624 for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) { 1625 const auto *symbol{iter->first}; 1626 const auto source{iter->second}; 1627 if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) { 1628 context_.Say(source, 1629 "%s variable '%s' is PRIVATE in outer context"_err_en_US, 1630 parser::ToUpperCaseLetters(getClauseName(currClause).str()), 1631 symbol->name()); 1632 } 1633 } 1634 } 1635 } 1636 } 1637 1638 void OmpStructureChecker::CheckWorkshareBlockStmts( 1639 const parser::Block &block, parser::CharBlock source) { 1640 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source}; 1641 1642 for (auto it{block.begin()}; it != block.end(); ++it) { 1643 if (parser::Unwrap<parser::AssignmentStmt>(*it) || 1644 parser::Unwrap<parser::ForallStmt>(*it) || 1645 parser::Unwrap<parser::ForallConstruct>(*it) || 1646 parser::Unwrap<parser::WhereStmt>(*it) || 1647 parser::Unwrap<parser::WhereConstruct>(*it)) { 1648 parser::Walk(*it, ompWorkshareBlockChecker); 1649 } else if (const auto *ompConstruct{ 1650 parser::Unwrap<parser::OpenMPConstruct>(*it)}) { 1651 if (const auto *ompAtomicConstruct{ 1652 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) { 1653 // Check if assignment statements in the enclosing OpenMP Atomic 1654 // construct are allowed in the Workshare construct 1655 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker); 1656 } else if (const auto *ompCriticalConstruct{ 1657 std::get_if<parser::OpenMPCriticalConstruct>( 1658 &ompConstruct->u)}) { 1659 // All the restrictions on the Workshare construct apply to the 1660 // statements in the enclosing critical constructs 1661 const auto &criticalBlock{ 1662 std::get<parser::Block>(ompCriticalConstruct->t)}; 1663 CheckWorkshareBlockStmts(criticalBlock, source); 1664 } else { 1665 // Check if OpenMP constructs enclosed in the Workshare construct are 1666 // 'Parallel' constructs 1667 auto currentDir{llvm::omp::Directive::OMPD_unknown}; 1668 const OmpDirectiveSet parallelDirSet{ 1669 llvm::omp::Directive::OMPD_parallel, 1670 llvm::omp::Directive::OMPD_parallel_do, 1671 llvm::omp::Directive::OMPD_parallel_sections, 1672 llvm::omp::Directive::OMPD_parallel_workshare, 1673 llvm::omp::Directive::OMPD_parallel_do_simd}; 1674 1675 if (const auto *ompBlockConstruct{ 1676 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) { 1677 const auto &beginBlockDir{ 1678 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)}; 1679 const auto &beginDir{ 1680 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1681 currentDir = beginDir.v; 1682 } else if (const auto *ompLoopConstruct{ 1683 std::get_if<parser::OpenMPLoopConstruct>( 1684 &ompConstruct->u)}) { 1685 const auto &beginLoopDir{ 1686 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)}; 1687 const auto &beginDir{ 1688 std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 1689 currentDir = beginDir.v; 1690 } else if (const auto *ompSectionsConstruct{ 1691 std::get_if<parser::OpenMPSectionsConstruct>( 1692 &ompConstruct->u)}) { 1693 const auto &beginSectionsDir{ 1694 std::get<parser::OmpBeginSectionsDirective>( 1695 ompSectionsConstruct->t)}; 1696 const auto &beginDir{ 1697 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 1698 currentDir = beginDir.v; 1699 } 1700 1701 if (!parallelDirSet.test(currentDir)) { 1702 context_.Say(source, 1703 "OpenMP constructs enclosed in WORKSHARE construct may consist " 1704 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US); 1705 } 1706 } 1707 } else { 1708 context_.Say(source, 1709 "The structured block in a WORKSHARE construct may consist of only " 1710 "SCALAR or ARRAY assignments, FORALL or WHERE statements, " 1711 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US); 1712 } 1713 } 1714 } 1715 1716 const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList( 1717 const parser::OmpClause &clause) { 1718 1719 // Clauses with OmpObjectList as its data member 1720 using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate, 1721 parser::OmpClause::Copyin, parser::OmpClause::Firstprivate, 1722 parser::OmpClause::From, parser::OmpClause::Lastprivate, 1723 parser::OmpClause::Link, parser::OmpClause::Private, 1724 parser::OmpClause::Shared, parser::OmpClause::To>; 1725 1726 // Clauses with OmpObjectList in the tuple 1727 using TupleObjectListClauses = std::tuple<parser::OmpClause::Allocate, 1728 parser::OmpClause::Map, parser::OmpClause::Reduction>; 1729 1730 // TODO:: Generate the tuples using TableGen. 1731 // Handle other constructs with OmpObjectList such as OpenMPThreadprivate. 1732 return std::visit( 1733 common::visitors{ 1734 [&](const auto &x) -> const parser::OmpObjectList * { 1735 using Ty = std::decay_t<decltype(x)>; 1736 if constexpr (common::HasMember<Ty, MemberObjectListClauses>) { 1737 return &x.v; 1738 } else if constexpr (common::HasMember<Ty, 1739 TupleObjectListClauses>) { 1740 return &(std::get<parser::OmpObjectList>(x.v.t)); 1741 } else { 1742 return nullptr; 1743 } 1744 }, 1745 }, 1746 clause.u); 1747 } 1748 1749 } // namespace Fortran::semantics 1750