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