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::HasInvalidWorksharingNesting( 131 const parser::CharBlock &source, const OmpDirectiveSet &set) { 132 // set contains all the invalid closely nested directives 133 // for the given directive (`source` here) 134 if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) { 135 context_.Say(source, 136 "A worksharing region may not be closely nested inside a " 137 "worksharing, explicit task, taskloop, critical, ordered, atomic, or " 138 "master region"_err_en_US); 139 return true; 140 } 141 return false; 142 } 143 144 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) { 145 // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check 146 } 147 148 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { 149 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 150 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 151 152 // check matching, End directive is optional 153 if (const auto &endLoopDir{ 154 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) { 155 const auto &endDir{ 156 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)}; 157 158 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir); 159 } 160 161 if (beginDir.v != llvm::omp::Directive::OMPD_do) { 162 PushContextAndClauseSets(beginDir.source, beginDir.v); 163 } else { 164 // 2.7.1 do-clause -> private-clause | 165 // firstprivate-clause | 166 // lastprivate-clause | 167 // linear-clause | 168 // reduction-clause | 169 // schedule-clause | 170 // collapse-clause | 171 // ordered-clause 172 173 // nesting check 174 HasInvalidWorksharingNesting(beginDir.source, 175 {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections, 176 llvm::omp::Directive::OMPD_single, 177 llvm::omp::Directive::OMPD_workshare, 178 llvm::omp::Directive::OMPD_task, 179 llvm::omp::Directive::OMPD_taskloop, 180 llvm::omp::Directive::OMPD_critical, 181 llvm::omp::Directive::OMPD_ordered, 182 llvm::omp::Directive::OMPD_atomic, 183 llvm::omp::Directive::OMPD_master}); 184 PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do); 185 } 186 SetLoopInfo(x); 187 188 if (const auto &doConstruct{ 189 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 190 const auto &doBlock{std::get<parser::Block>(doConstruct->t)}; 191 CheckNoBranching(doBlock, beginDir.v, beginDir.source); 192 } 193 CheckDoWhile(x); 194 CheckLoopItrVariableIsInt(x); 195 CheckCycleConstraints(x); 196 } 197 const parser::Name OmpStructureChecker::GetLoopIndex( 198 const parser::DoConstruct *x) { 199 using Bounds = parser::LoopControl::Bounds; 200 return std::get<Bounds>(x->GetLoopControl()->u).name.thing; 201 } 202 void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { 203 if (const auto &loopConstruct{ 204 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 205 const parser::DoConstruct *loop{&*loopConstruct}; 206 if (loop && loop->IsDoNormal()) { 207 const parser::Name &itrVal{GetLoopIndex(loop)}; 208 SetLoopIv(itrVal.symbol); 209 } 210 } 211 } 212 void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) { 213 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 214 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 215 if (beginDir.v == llvm::omp::Directive::OMPD_do) { 216 if (const auto &doConstruct{ 217 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 218 if (doConstruct.value().IsDoWhile()) { 219 const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>( 220 doConstruct.value().t)}; 221 context_.Say(doStmt.source, 222 "The DO loop cannot be a DO WHILE with DO directive."_err_en_US); 223 } 224 } 225 } 226 } 227 228 void OmpStructureChecker::CheckLoopItrVariableIsInt( 229 const parser::OpenMPLoopConstruct &x) { 230 if (const auto &loopConstruct{ 231 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 232 233 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) { 234 if (loop->IsDoNormal()) { 235 const parser::Name &itrVal{GetLoopIndex(loop)}; 236 if (itrVal.symbol) { 237 const auto *type{itrVal.symbol->GetType()}; 238 if (!type->IsNumeric(TypeCategory::Integer)) { 239 context_.Say(itrVal.source, 240 "The DO loop iteration" 241 " variable must be of the type integer."_err_en_US, 242 itrVal.ToString()); 243 } 244 } 245 } 246 // Get the next DoConstruct if block is not empty. 247 const auto &block{std::get<parser::Block>(loop->t)}; 248 const auto it{block.begin()}; 249 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) 250 : nullptr; 251 } 252 } 253 } 254 255 std::int64_t OmpStructureChecker::GetOrdCollapseLevel( 256 const parser::OpenMPLoopConstruct &x) { 257 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 258 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 259 std::int64_t orderedCollapseLevel{1}; 260 std::int64_t orderedLevel{0}; 261 std::int64_t collapseLevel{0}; 262 263 for (const auto &clause : clauseList.v) { 264 if (const auto *collapseClause{ 265 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) { 266 if (const auto v{GetIntValue(collapseClause->v)}) { 267 collapseLevel = *v; 268 } 269 } 270 if (const auto *orderedClause{ 271 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) { 272 if (const auto v{GetIntValue(orderedClause->v)}) { 273 orderedLevel = *v; 274 } 275 } 276 } 277 if (orderedLevel >= collapseLevel) { 278 orderedCollapseLevel = orderedLevel; 279 } else { 280 orderedCollapseLevel = collapseLevel; 281 } 282 return orderedCollapseLevel; 283 } 284 285 void OmpStructureChecker::CheckCycleConstraints( 286 const parser::OpenMPLoopConstruct &x) { 287 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)}; 288 OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel}; 289 parser::Walk(x, ompCycleChecker); 290 } 291 292 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) { 293 dirContext_.pop_back(); 294 } 295 296 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) { 297 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)}; 298 ResetPartialContext(dir.source); 299 switch (dir.v) { 300 // 2.7.1 end-do -> END DO [nowait-clause] 301 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause] 302 case llvm::omp::Directive::OMPD_do: 303 case llvm::omp::Directive::OMPD_do_simd: 304 SetClauseSets(dir.v); 305 break; 306 default: 307 // no clauses are allowed 308 break; 309 } 310 } 311 312 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { 313 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 314 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)}; 315 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 316 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)}; 317 const parser::Block &block{std::get<parser::Block>(x.t)}; 318 319 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir); 320 321 // TODO: This check needs to be extended while implementing nesting of regions 322 // checks. 323 if (beginDir.v == llvm::omp::Directive::OMPD_single) { 324 HasInvalidWorksharingNesting( 325 beginDir.source, {llvm::omp::Directive::OMPD_do}); 326 } 327 CheckIfDoOrderedClause(beginDir); 328 329 PushContextAndClauseSets(beginDir.source, beginDir.v); 330 CheckNoBranching(block, beginDir.v, beginDir.source); 331 332 switch (beginDir.v) { 333 case llvm::omp::OMPD_workshare: 334 case llvm::omp::OMPD_parallel_workshare: 335 CheckWorkshareBlockStmts(block, beginDir.source); 336 break; 337 default: 338 break; 339 } 340 } 341 342 void OmpStructureChecker::CheckIfDoOrderedClause( 343 const parser::OmpBlockDirective &blkDirective) { 344 if (blkDirective.v == llvm::omp::OMPD_ordered) { 345 if (!FindClause(llvm::omp::Clause::OMPC_ordered)) { 346 context_.Say(blkDirective.source, 347 "The ORDERED clause must be present on the loop" 348 " construct if any ORDERED region ever binds" 349 " to a loop region arising from the loop construct."_err_en_US); 350 } 351 } 352 } 353 354 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) { 355 dirContext_.pop_back(); 356 } 357 358 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) { 359 const auto &beginSectionsDir{ 360 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 361 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)}; 362 const auto &beginDir{ 363 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 364 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)}; 365 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir); 366 367 PushContextAndClauseSets(beginDir.source, beginDir.v); 368 const auto §ionBlocks{std::get<parser::OmpSectionBlocks>(x.t)}; 369 for (const auto &block : sectionBlocks.v) { 370 CheckNoBranching(block, beginDir.v, beginDir.source); 371 } 372 } 373 374 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) { 375 dirContext_.pop_back(); 376 } 377 378 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) { 379 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)}; 380 ResetPartialContext(dir.source); 381 switch (dir.v) { 382 // 2.7.2 end-sections -> END SECTIONS [nowait-clause] 383 case llvm::omp::Directive::OMPD_sections: 384 PushContextAndClauseSets( 385 dir.source, llvm::omp::Directive::OMPD_end_sections); 386 break; 387 default: 388 // no clauses are allowed 389 break; 390 } 391 } 392 393 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) { 394 const auto &dir{std::get<parser::Verbatim>(x.t)}; 395 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd); 396 } 397 398 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) { 399 dirContext_.pop_back(); 400 } 401 402 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { 403 const auto &dir{std::get<parser::Verbatim>(x.t)}; 404 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 405 } 406 407 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &) { 408 dirContext_.pop_back(); 409 } 410 411 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) { 412 const auto &dir{std::get<parser::Verbatim>(x.t)}; 413 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target); 414 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)}; 415 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) { 416 SetClauseSets(llvm::omp::Directive::OMPD_declare_target); 417 } 418 } 419 420 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) { 421 dirContext_.pop_back(); 422 } 423 424 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { 425 const auto &dir{std::get<parser::Verbatim>(x.t)}; 426 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); 427 } 428 429 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) { 430 dirContext_.pop_back(); 431 } 432 433 void OmpStructureChecker::Enter( 434 const parser::OpenMPSimpleStandaloneConstruct &x) { 435 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)}; 436 PushContextAndClauseSets(dir.source, dir.v); 437 } 438 439 void OmpStructureChecker::Leave( 440 const parser::OpenMPSimpleStandaloneConstruct &) { 441 dirContext_.pop_back(); 442 } 443 444 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) { 445 const auto &dir{std::get<parser::Verbatim>(x.t)}; 446 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush); 447 } 448 449 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) { 450 if (FindClause(llvm::omp::Clause::OMPC_acquire) || 451 FindClause(llvm::omp::Clause::OMPC_release) || 452 FindClause(llvm::omp::Clause::OMPC_acq_rel)) { 453 if (const auto &flushList{ 454 std::get<std::optional<parser::OmpObjectList>>(x.t)}) { 455 context_.Say(parser::FindSourceLocation(flushList), 456 "If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items " 457 "must not be specified on the FLUSH directive"_err_en_US); 458 } 459 } 460 dirContext_.pop_back(); 461 } 462 463 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) { 464 const auto &dir{std::get<parser::Verbatim>(x.t)}; 465 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel); 466 } 467 468 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) { 469 dirContext_.pop_back(); 470 } 471 472 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { 473 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)}; 474 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); 475 const auto &block{std::get<parser::Block>(x.t)}; 476 CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); 477 } 478 479 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { 480 dirContext_.pop_back(); 481 } 482 483 void OmpStructureChecker::Enter( 484 const parser::OpenMPCancellationPointConstruct &x) { 485 const auto &dir{std::get<parser::Verbatim>(x.t)}; 486 PushContextAndClauseSets( 487 dir.source, llvm::omp::Directive::OMPD_cancellation_point); 488 } 489 490 void OmpStructureChecker::Leave( 491 const parser::OpenMPCancellationPointConstruct &) { 492 dirContext_.pop_back(); 493 } 494 495 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) { 496 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)}; 497 ResetPartialContext(dir.source); 498 switch (dir.v) { 499 // 2.7.3 end-single-clause -> copyprivate-clause | 500 // nowait-clause 501 case llvm::omp::Directive::OMPD_single: 502 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single); 503 break; 504 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause] 505 case llvm::omp::Directive::OMPD_workshare: 506 PushContextAndClauseSets( 507 dir.source, llvm::omp::Directive::OMPD_end_workshare); 508 break; 509 default: 510 // no clauses are allowed 511 break; 512 } 513 } 514 515 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) { 516 std::visit( 517 common::visitors{ 518 [&](const auto &someAtomicConstruct) { 519 const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)}; 520 PushContextAndClauseSets( 521 dir.source, llvm::omp::Directive::OMPD_atomic); 522 }, 523 }, 524 x.u); 525 } 526 527 void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) { 528 dirContext_.pop_back(); 529 } 530 531 // Clauses 532 // Mainly categorized as 533 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'. 534 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h. 535 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h. 536 537 void OmpStructureChecker::Leave(const parser::OmpClauseList &) { 538 // 2.7 Loop Construct Restriction 539 if (llvm::omp::doSet.test(GetContext().directive)) { 540 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) { 541 // only one schedule clause is allowed 542 const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)}; 543 if (ScheduleModifierHasType(schedClause.v, 544 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 545 if (FindClause(llvm::omp::Clause::OMPC_ordered)) { 546 context_.Say(clause->source, 547 "The NONMONOTONIC modifier cannot be specified " 548 "if an ORDERED clause is specified"_err_en_US); 549 } 550 if (ScheduleModifierHasType(schedClause.v, 551 parser::OmpScheduleModifierType::ModType::Monotonic)) { 552 context_.Say(clause->source, 553 "The MONOTONIC and NONMONOTONIC modifiers " 554 "cannot be both specified"_err_en_US); 555 } 556 } 557 } 558 559 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) { 560 // only one ordered clause is allowed 561 const auto &orderedClause{ 562 std::get<parser::OmpClause::Ordered>(clause->u)}; 563 564 if (orderedClause.v) { 565 CheckNotAllowedIfClause( 566 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear}); 567 568 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) { 569 const auto &collapseClause{ 570 std::get<parser::OmpClause::Collapse>(clause2->u)}; 571 // ordered and collapse both have parameters 572 if (const auto orderedValue{GetIntValue(orderedClause.v)}) { 573 if (const auto collapseValue{GetIntValue(collapseClause.v)}) { 574 if (*orderedValue > 0 && *orderedValue < *collapseValue) { 575 context_.Say(clause->source, 576 "The parameter of the ORDERED clause must be " 577 "greater than or equal to " 578 "the parameter of the COLLAPSE clause"_err_en_US); 579 } 580 } 581 } 582 } 583 } 584 585 // TODO: ordered region binding check (requires nesting implementation) 586 } 587 } // doSet 588 589 // 2.8.1 Simd Construct Restriction 590 if (llvm::omp::simdSet.test(GetContext().directive)) { 591 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) { 592 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) { 593 const auto &simdlenClause{ 594 std::get<parser::OmpClause::Simdlen>(clause->u)}; 595 const auto &safelenClause{ 596 std::get<parser::OmpClause::Safelen>(clause2->u)}; 597 // simdlen and safelen both have parameters 598 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) { 599 if (const auto safelenValue{GetIntValue(safelenClause.v)}) { 600 if (*safelenValue > 0 && *simdlenValue > *safelenValue) { 601 context_.Say(clause->source, 602 "The parameter of the SIMDLEN clause must be less than or " 603 "equal to the parameter of the SAFELEN clause"_err_en_US); 604 } 605 } 606 } 607 } 608 } 609 // TODO: A list-item cannot appear in more than one aligned clause 610 } // SIMD 611 612 // 2.7.3 Single Construct Restriction 613 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) { 614 CheckNotAllowedIfClause( 615 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait}); 616 } 617 618 CheckRequireAtLeastOneOf(); 619 } 620 621 void OmpStructureChecker::Enter(const parser::OmpClause &x) { 622 SetContextClause(x); 623 } 624 625 // Following clauses do not have a separate node in parse-tree.h. 626 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel) 627 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire) 628 CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order) 629 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) 630 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate) 631 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) 632 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin) 633 CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate) 634 CHECK_SIMPLE_CLAUSE(Default, OMPC_default) 635 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) 636 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy) 637 CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach) 638 CHECK_SIMPLE_CLAUSE(Device, OMPC_device) 639 CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) 640 CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) 641 CHECK_SIMPLE_CLAUSE(DynamicAllocators, OMPC_dynamic_allocators) 642 CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) 643 CHECK_SIMPLE_CLAUSE(Final, OMPC_final) 644 CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush) 645 CHECK_SIMPLE_CLAUSE(From, OMPC_from) 646 CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint) 647 CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction) 648 CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) 649 CHECK_SIMPLE_CLAUSE(Match, OMPC_match) 650 CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal) 651 CHECK_SIMPLE_CLAUSE(Order, OMPC_order) 652 CHECK_SIMPLE_CLAUSE(Read, OMPC_read) 653 CHECK_SIMPLE_CLAUSE(ReverseOffload, OMPC_reverse_offload) 654 CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate) 655 CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads) 656 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) 657 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr) 658 CHECK_SIMPLE_CLAUSE(Lastprivate, OMPC_lastprivate) 659 CHECK_SIMPLE_CLAUSE(Link, OMPC_link) 660 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) 661 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) 662 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) 663 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait) 664 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind) 665 CHECK_SIMPLE_CLAUSE(Reduction, OMPC_reduction) 666 CHECK_SIMPLE_CLAUSE(Release, OMPC_release) 667 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) 668 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) 669 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) 670 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes) 671 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction) 672 CHECK_SIMPLE_CLAUSE(To, OMPC_to) 673 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address) 674 CHECK_SIMPLE_CLAUSE(UnifiedSharedMemory, OMPC_unified_shared_memory) 675 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) 676 CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) 677 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) 678 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr) 679 CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators) 680 CHECK_SIMPLE_CLAUSE(Update, OMPC_update) 681 CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr) 682 CHECK_SIMPLE_CLAUSE(Write, OMPC_write) 683 684 CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator) 685 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) 686 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks) 687 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) 688 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads) 689 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority) 690 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit) 691 692 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse) 693 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen) 694 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen) 695 696 // Restrictions specific to each clause are implemented apart from the 697 // generalized restrictions. 698 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) { 699 CheckAllowed(llvm::omp::Clause::OMPC_ordered); 700 // the parameter of ordered clause is optional 701 if (const auto &expr{x.v}) { 702 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr); 703 // 2.8.3 Loop SIMD Construct Restriction 704 if (llvm::omp::doSimdSet.test(GetContext().directive)) { 705 context_.Say(GetContext().clauseSource, 706 "No ORDERED clause with a parameter can be specified " 707 "on the %s directive"_err_en_US, 708 ContextDirectiveAsFortran()); 709 } 710 } 711 } 712 713 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) { 714 CheckAllowed(llvm::omp::Clause::OMPC_shared); 715 CheckIsVarPartOfAnotherVar(x.v); 716 } 717 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { 718 CheckAllowed(llvm::omp::Clause::OMPC_private); 719 CheckIsVarPartOfAnotherVar(x.v); 720 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); 721 } 722 723 void OmpStructureChecker::CheckIsVarPartOfAnotherVar( 724 const parser::OmpObjectList &objList) { 725 for (const auto &ompObject : objList.v) { 726 std::visit( 727 common::visitors{ 728 [&](const parser::Designator &designator) { 729 if (std::get_if<parser::DataRef>(&designator.u)) { 730 if ((parser::Unwrap<parser::StructureComponent>(ompObject)) || 731 (parser::Unwrap<parser::ArrayElement>(ompObject))) { 732 context_.Say(GetContext().clauseSource, 733 "A variable that is part of another variable (as an " 734 "array or structure element)" 735 " cannot appear in a PRIVATE or SHARED clause."_err_en_US); 736 } 737 } 738 }, 739 [&](const parser::Name &name) {}, 740 }, 741 ompObject.u); 742 } 743 } 744 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { 745 CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); 746 CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); 747 } 748 void OmpStructureChecker::CheckIsLoopIvPartOfClause( 749 llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) { 750 for (const auto &ompObject : ompObjectList.v) { 751 if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) { 752 if (name->symbol == GetContext().loopIV) { 753 context_.Say(name->source, 754 "DO iteration variable %s is not allowed in %s clause."_err_en_US, 755 name->ToString(), 756 parser::ToUpperCaseLetters(getClauseName(clause).str())); 757 } 758 } 759 } 760 } 761 // Following clauses have a seperate node in parse-tree.h. 762 // Atomic-clause 763 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read) 764 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write) 765 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update) 766 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture) 767 768 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) { 769 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read, 770 {llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel}); 771 } 772 void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) { 773 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write, 774 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 775 } 776 void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) { 777 CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update, 778 {llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel}); 779 } 780 // OmpAtomic node represents atomic directive without atomic-clause. 781 // atomic-clause - READ,WRITE,UPDATE,CAPTURE. 782 void OmpStructureChecker::Leave(const parser::OmpAtomic &) { 783 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) { 784 context_.Say(clause->source, 785 "Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US); 786 } 787 if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) { 788 context_.Say(clause->source, 789 "Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US); 790 } 791 } 792 // Restrictions specific to each clause are implemented apart from the 793 // generalized restrictions. 794 void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) { 795 CheckAllowed(llvm::omp::Clause::OMPC_aligned); 796 797 if (const auto &expr{ 798 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) { 799 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr); 800 } 801 // 2.8.1 TODO: list-item attribute check 802 } 803 void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) { 804 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap); 805 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory; 806 if (!std::get<std::optional<VariableCategory>>(x.v.t)) { 807 context_.Say(GetContext().clauseSource, 808 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP " 809 "clause"_err_en_US); 810 } 811 } 812 void OmpStructureChecker::Enter(const parser::OmpClause::If &x) { 813 CheckAllowed(llvm::omp::Clause::OMPC_if); 814 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier; 815 static std::unordered_map<dirNameModifier, OmpDirectiveSet> 816 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet}, 817 {dirNameModifier::Target, llvm::omp::targetSet}, 818 {dirNameModifier::TargetEnterData, 819 {llvm::omp::Directive::OMPD_target_enter_data}}, 820 {dirNameModifier::TargetExitData, 821 {llvm::omp::Directive::OMPD_target_exit_data}}, 822 {dirNameModifier::TargetData, 823 {llvm::omp::Directive::OMPD_target_data}}, 824 {dirNameModifier::TargetUpdate, 825 {llvm::omp::Directive::OMPD_target_update}}, 826 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}}, 827 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}}; 828 if (const auto &directiveName{ 829 std::get<std::optional<dirNameModifier>>(x.v.t)}) { 830 auto search{dirNameModifierMap.find(*directiveName)}; 831 if (search == dirNameModifierMap.end() || 832 !search->second.test(GetContext().directive)) { 833 context_ 834 .Say(GetContext().clauseSource, 835 "Unmatched directive name modifier %s on the IF clause"_err_en_US, 836 parser::ToUpperCaseLetters( 837 parser::OmpIfClause::EnumToString(*directiveName))) 838 .Attach( 839 GetContext().directiveSource, "Cannot apply to directive"_en_US); 840 } 841 } 842 } 843 844 void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { 845 CheckAllowed(llvm::omp::Clause::OMPC_linear); 846 847 // 2.7 Loop Construct Restriction 848 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) { 849 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) { 850 context_.Say(GetContext().clauseSource, 851 "A modifier may not be specified in a LINEAR clause " 852 "on the %s directive"_err_en_US, 853 ContextDirectiveAsFortran()); 854 } 855 } 856 } 857 858 void OmpStructureChecker::CheckAllowedMapTypes( 859 const parser::OmpMapType::Type &type, 860 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) { 861 const auto found{std::find( 862 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)}; 863 if (found == std::end(allowedMapTypeList)) { 864 std::string commaSeperatedMapTypes; 865 llvm::interleave( 866 allowedMapTypeList.begin(), allowedMapTypeList.end(), 867 [&](const parser::OmpMapType::Type &mapType) { 868 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters( 869 parser::OmpMapType::EnumToString(mapType))); 870 }, 871 [&] { commaSeperatedMapTypes.append(", "); }); 872 context_.Say(GetContext().clauseSource, 873 "Only the %s map types are permitted " 874 "for MAP clauses on the %s directive"_err_en_US, 875 commaSeperatedMapTypes, ContextDirectiveAsFortran()); 876 } 877 } 878 879 void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) { 880 CheckAllowed(llvm::omp::Clause::OMPC_map); 881 882 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) { 883 using Type = parser::OmpMapType::Type; 884 const Type &type{std::get<Type>(maptype->t)}; 885 switch (GetContext().directive) { 886 case llvm::omp::Directive::OMPD_target: 887 case llvm::omp::Directive::OMPD_target_teams: 888 case llvm::omp::Directive::OMPD_target_teams_distribute: 889 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 890 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 891 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 892 case llvm::omp::Directive::OMPD_target_data: 893 CheckAllowedMapTypes( 894 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc}); 895 break; 896 case llvm::omp::Directive::OMPD_target_enter_data: 897 CheckAllowedMapTypes(type, {Type::To, Type::Alloc}); 898 break; 899 case llvm::omp::Directive::OMPD_target_exit_data: 900 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete}); 901 break; 902 default: 903 break; 904 } 905 } 906 } 907 908 bool OmpStructureChecker::ScheduleModifierHasType( 909 const parser::OmpScheduleClause &x, 910 const parser::OmpScheduleModifierType::ModType &type) { 911 const auto &modifier{ 912 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)}; 913 if (modifier) { 914 const auto &modType1{ 915 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)}; 916 const auto &modType2{ 917 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>( 918 modifier->t)}; 919 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) { 920 return true; 921 } 922 } 923 return false; 924 } 925 void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) { 926 CheckAllowed(llvm::omp::Clause::OMPC_schedule); 927 const parser::OmpScheduleClause &scheduleClause = x.v; 928 929 // 2.7 Loop Construct Restriction 930 if (llvm::omp::doSet.test(GetContext().directive)) { 931 const auto &kind{std::get<1>(scheduleClause.t)}; 932 const auto &chunk{std::get<2>(scheduleClause.t)}; 933 if (chunk) { 934 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime || 935 kind == parser::OmpScheduleClause::ScheduleType::Auto) { 936 context_.Say(GetContext().clauseSource, 937 "When SCHEDULE clause has %s specified, " 938 "it must not have chunk size specified"_err_en_US, 939 parser::ToUpperCaseLetters( 940 parser::OmpScheduleClause::EnumToString(kind))); 941 } 942 if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>( 943 scheduleClause.t)}) { 944 RequiresPositiveParameter( 945 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size"); 946 } 947 } 948 949 if (ScheduleModifierHasType(scheduleClause, 950 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) { 951 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic && 952 kind != parser::OmpScheduleClause::ScheduleType::Guided) { 953 context_.Say(GetContext().clauseSource, 954 "The NONMONOTONIC modifier can only be specified with " 955 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US); 956 } 957 } 958 } 959 } 960 961 void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) { 962 CheckAllowed(llvm::omp::Clause::OMPC_depend); 963 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) { 964 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)}; 965 for (const auto &ele : designators) { 966 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) { 967 CheckDependList(*dataRef); 968 if (const auto *arr{ 969 std::get_if<common::Indirection<parser::ArrayElement>>( 970 &dataRef->u)}) { 971 CheckDependArraySection(*arr, GetLastName(*dataRef)); 972 } 973 } 974 } 975 } 976 } 977 978 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { 979 return llvm::omp::getOpenMPClauseName(clause); 980 } 981 982 llvm::StringRef OmpStructureChecker::getDirectiveName( 983 llvm::omp::Directive directive) { 984 return llvm::omp::getOpenMPDirectiveName(directive); 985 } 986 987 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) { 988 std::visit( 989 common::visitors{ 990 [&](const common::Indirection<parser::ArrayElement> &elem) { 991 // Check if the base element is valid on Depend Clause 992 CheckDependList(elem.value().base); 993 }, 994 [&](const common::Indirection<parser::StructureComponent> &) { 995 context_.Say(GetContext().clauseSource, 996 "A variable that is part of another variable " 997 "(such as an element of a structure) but is not an array " 998 "element or an array section cannot appear in a DEPEND " 999 "clause"_err_en_US); 1000 }, 1001 [&](const common::Indirection<parser::CoindexedNamedObject> &) { 1002 context_.Say(GetContext().clauseSource, 1003 "Coarrays are not supported in DEPEND clause"_err_en_US); 1004 }, 1005 [&](const parser::Name &) { return; }, 1006 }, 1007 d.u); 1008 } 1009 1010 void OmpStructureChecker::CheckDependArraySection( 1011 const common::Indirection<parser::ArrayElement> &arr, 1012 const parser::Name &name) { 1013 for (const auto &subscript : arr.value().subscripts) { 1014 if (const auto *triplet{ 1015 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) { 1016 if (std::get<2>(triplet->t)) { 1017 context_.Say(GetContext().clauseSource, 1018 "Stride should not be specified for array section in DEPEND " 1019 "clause"_err_en_US); 1020 } 1021 const auto &lower{std::get<0>(triplet->t)}; 1022 const auto &upper{std::get<1>(triplet->t)}; 1023 if (lower && upper) { 1024 const auto lval{GetIntValue(lower)}; 1025 const auto uval{GetIntValue(upper)}; 1026 if (lval && uval && *uval < *lval) { 1027 context_.Say(GetContext().clauseSource, 1028 "'%s' in DEPEND clause is a zero size array section"_err_en_US, 1029 name.ToString()); 1030 break; 1031 } 1032 } 1033 } 1034 } 1035 } 1036 1037 void OmpStructureChecker::CheckIntentInPointer( 1038 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { 1039 std::vector<const Symbol *> symbols; 1040 GetSymbolsInObjectList(objectList, symbols); 1041 for (const auto *symbol : symbols) { 1042 if (IsPointer(*symbol) && IsIntentIn(*symbol)) { 1043 context_.Say(GetContext().clauseSource, 1044 "Pointer '%s' with the INTENT(IN) attribute may not appear " 1045 "in a %s clause"_err_en_US, 1046 symbol->name(), 1047 parser::ToUpperCaseLetters(getClauseName(clause).str())); 1048 } 1049 } 1050 } 1051 1052 void OmpStructureChecker::GetSymbolsInObjectList( 1053 const parser::OmpObjectList &objectList, 1054 std::vector<const Symbol *> &symbols) { 1055 for (const auto &ompObject : objectList.v) { 1056 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { 1057 if (const auto *symbol{name->symbol}) { 1058 if (const auto *commonBlockDetails{ 1059 symbol->detailsIf<CommonBlockDetails>()}) { 1060 for (const auto &object : commonBlockDetails->objects()) { 1061 symbols.emplace_back(&object->GetUltimate()); 1062 } 1063 } else { 1064 symbols.emplace_back(&symbol->GetUltimate()); 1065 } 1066 } 1067 } 1068 } 1069 } 1070 1071 void OmpStructureChecker::CheckWorkshareBlockStmts( 1072 const parser::Block &block, parser::CharBlock source) { 1073 OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source}; 1074 1075 for (auto it{block.begin()}; it != block.end(); ++it) { 1076 if (parser::Unwrap<parser::AssignmentStmt>(*it) || 1077 parser::Unwrap<parser::ForallStmt>(*it) || 1078 parser::Unwrap<parser::ForallConstruct>(*it) || 1079 parser::Unwrap<parser::WhereStmt>(*it) || 1080 parser::Unwrap<parser::WhereConstruct>(*it)) { 1081 parser::Walk(*it, ompWorkshareBlockChecker); 1082 } else if (const auto *ompConstruct{ 1083 parser::Unwrap<parser::OpenMPConstruct>(*it)}) { 1084 if (const auto *ompAtomicConstruct{ 1085 std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) { 1086 // Check if assignment statements in the enclosing OpenMP Atomic 1087 // construct are allowed in the Workshare construct 1088 parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker); 1089 } else if (const auto *ompCriticalConstruct{ 1090 std::get_if<parser::OpenMPCriticalConstruct>( 1091 &ompConstruct->u)}) { 1092 // All the restrictions on the Workshare construct apply to the 1093 // statements in the enclosing critical constructs 1094 const auto &criticalBlock{ 1095 std::get<parser::Block>(ompCriticalConstruct->t)}; 1096 CheckWorkshareBlockStmts(criticalBlock, source); 1097 } else { 1098 // Check if OpenMP constructs enclosed in the Workshare construct are 1099 // 'Parallel' constructs 1100 auto currentDir{llvm::omp::Directive::OMPD_unknown}; 1101 const OmpDirectiveSet parallelDirSet{ 1102 llvm::omp::Directive::OMPD_parallel, 1103 llvm::omp::Directive::OMPD_parallel_do, 1104 llvm::omp::Directive::OMPD_parallel_sections, 1105 llvm::omp::Directive::OMPD_parallel_workshare, 1106 llvm::omp::Directive::OMPD_parallel_do_simd}; 1107 1108 if (const auto *ompBlockConstruct{ 1109 std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) { 1110 const auto &beginBlockDir{ 1111 std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)}; 1112 const auto &beginDir{ 1113 std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1114 currentDir = beginDir.v; 1115 } else if (const auto *ompLoopConstruct{ 1116 std::get_if<parser::OpenMPLoopConstruct>( 1117 &ompConstruct->u)}) { 1118 const auto &beginLoopDir{ 1119 std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)}; 1120 const auto &beginDir{ 1121 std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 1122 currentDir = beginDir.v; 1123 } else if (const auto *ompSectionsConstruct{ 1124 std::get_if<parser::OpenMPSectionsConstruct>( 1125 &ompConstruct->u)}) { 1126 const auto &beginSectionsDir{ 1127 std::get<parser::OmpBeginSectionsDirective>( 1128 ompSectionsConstruct->t)}; 1129 const auto &beginDir{ 1130 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 1131 currentDir = beginDir.v; 1132 } 1133 1134 if (!parallelDirSet.test(currentDir)) { 1135 context_.Say(source, 1136 "OpenMP constructs enclosed in WORKSHARE construct may consist " 1137 "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US); 1138 } 1139 } 1140 } else { 1141 context_.Say(source, 1142 "The structured block in a WORKSHARE construct may consist of only " 1143 "SCALAR or ARRAY assignments, FORALL or WHERE statements, " 1144 "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US); 1145 } 1146 } 1147 } 1148 1149 } // namespace Fortran::semantics 1150