793 lines · cpp
1//===-- lib/Semantics/check-omp-loop.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-exception6//7//===----------------------------------------------------------------------===//8//9// Semantic checks for constructs and clauses related to loops.10//11//===----------------------------------------------------------------------===//12 13#include "check-omp-structure.h"14 15#include "check-directive-structure.h"16 17#include "flang/Common/idioms.h"18#include "flang/Common/visit.h"19#include "flang/Parser/char-block.h"20#include "flang/Parser/openmp-utils.h"21#include "flang/Parser/parse-tree-visitor.h"22#include "flang/Parser/parse-tree.h"23#include "flang/Parser/tools.h"24#include "flang/Semantics/openmp-modifiers.h"25#include "flang/Semantics/openmp-utils.h"26#include "flang/Semantics/semantics.h"27#include "flang/Semantics/symbol.h"28#include "flang/Semantics/tools.h"29#include "flang/Semantics/type.h"30 31#include "llvm/Frontend/OpenMP/OMP.h"32 33#include <cstdint>34#include <map>35#include <optional>36#include <string>37#include <tuple>38#include <variant>39 40namespace {41using namespace Fortran;42 43class AssociatedLoopChecker {44public:45 AssociatedLoopChecker(46 semantics::SemanticsContext &context, std::int64_t level)47 : context_{context}, level_{level} {}48 49 template <typename T> bool Pre(const T &) { return true; }50 template <typename T> void Post(const T &) {}51 52 bool Pre(const parser::DoConstruct &dc) {53 level_--;54 const auto &doStmt{55 std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};56 const auto &constructName{57 std::get<std::optional<parser::Name>>(doStmt.statement.t)};58 if (constructName) {59 constructNamesAndLevels_.emplace(60 constructName.value().ToString(), level_);61 }62 if (level_ >= 0) {63 if (dc.IsDoWhile()) {64 context_.Say(doStmt.source,65 "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);66 }67 if (!dc.GetLoopControl()) {68 context_.Say(doStmt.source,69 "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);70 }71 }72 return true;73 }74 75 void Post(const parser::DoConstruct &dc) { level_++; }76 77 bool Pre(const parser::CycleStmt &cyclestmt) {78 std::map<std::string, std::int64_t>::iterator it;79 bool err{false};80 if (cyclestmt.v) {81 it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());82 err = (it != constructNamesAndLevels_.end() && it->second > 0);83 } else { // If there is no label then use the level of the last enclosing DO84 err = level_ > 0;85 }86 if (err) {87 context_.Say(*source_,88 "CYCLE statement to non-innermost associated loop of an OpenMP DO "89 "construct"_err_en_US);90 }91 return true;92 }93 94 bool Pre(const parser::ExitStmt &exitStmt) {95 std::map<std::string, std::int64_t>::iterator it;96 bool err{false};97 if (exitStmt.v) {98 it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());99 err = (it != constructNamesAndLevels_.end() && it->second >= 0);100 } else { // If there is no label then use the level of the last enclosing DO101 err = level_ >= 0;102 }103 if (err) {104 context_.Say(*source_,105 "EXIT statement terminates associated loop of an OpenMP DO "106 "construct"_err_en_US);107 }108 return true;109 }110 111 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {112 source_ = &actionstmt.source;113 return true;114 }115 116private:117 semantics::SemanticsContext &context_;118 const parser::CharBlock *source_;119 std::int64_t level_;120 std::map<std::string, std::int64_t> constructNamesAndLevels_;121};122} // namespace123 124namespace Fortran::semantics {125 126using namespace Fortran::semantics::omp;127 128void OmpStructureChecker::HasInvalidDistributeNesting(129 const parser::OpenMPLoopConstruct &x) {130 const parser::OmpDirectiveName &beginName{x.BeginDir().DirName()};131 if (llvm::omp::topDistributeSet.test(beginName.v)) {132 // `distribute` region has to be nested133 if (CurrentDirectiveIsNested()) {134 // `distribute` region has to be strictly nested inside `teams`135 if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {136 context_.Say(beginName.source,137 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "138 "region."_err_en_US);139 }140 } else {141 // If not lexically nested (orphaned), issue a warning.142 context_.Say(beginName.source,143 "`DISTRIBUTE` must be dynamically enclosed in a `TEAMS` "144 "region."_warn_en_US);145 }146 }147}148void OmpStructureChecker::HasInvalidLoopBinding(149 const parser::OpenMPLoopConstruct &x) {150 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};151 const parser::OmpDirectiveName &beginName{beginSpec.DirName()};152 153 auto teamsBindingChecker = [&](parser::MessageFixedText msg) {154 for (const auto &clause : beginSpec.Clauses().v) {155 if (const auto *bindClause{156 std::get_if<parser::OmpClause::Bind>(&clause.u)}) {157 if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {158 context_.Say(beginName.source, msg);159 }160 }161 }162 };163 164 if (llvm::omp::Directive::OMPD_loop == beginName.v &&165 CurrentDirectiveIsNested() &&166 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {167 teamsBindingChecker(168 "`BIND(TEAMS)` must be specified since the `LOOP` region is "169 "strictly nested inside a `TEAMS` region."_err_en_US);170 }171 172 if (OmpDirectiveSet{173 llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}174 .test(beginName.v)) {175 teamsBindingChecker(176 "`BIND(TEAMS)` must be specified since the `LOOP` directive is "177 "combined with a `TEAMS` construct."_err_en_US);178 }179}180 181void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {182 // Check the following:183 // The only OpenMP constructs that can be encountered during execution of184 // a simd region are the `atomic` construct, the `loop` construct, the `simd`185 // construct and the `ordered` construct with the `simd` clause.186 187 // Check if the parent context has the SIMD clause188 // Please note that we use GetContext() instead of GetContextParent()189 // because PushContextAndClauseSets() has not been called on the190 // current context yet.191 // TODO: Check for declare simd regions.192 bool eligibleSIMD{false};193 common::visit(194 common::visitors{195 // Allow `!$OMP ORDERED SIMD`196 [&](const parser::OmpBlockConstruct &c) {197 const parser::OmpDirectiveSpecification &beginSpec{c.BeginDir()};198 if (beginSpec.DirId() == llvm::omp::Directive::OMPD_ordered) {199 for (const auto &clause : beginSpec.Clauses().v) {200 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {201 eligibleSIMD = true;202 break;203 }204 }205 }206 },207 [&](const parser::OpenMPStandaloneConstruct &c) {208 if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(209 &c.u)}) {210 llvm::omp::Directive dirId{ssc->v.DirId()};211 if (dirId == llvm::omp::Directive::OMPD_ordered) {212 for (const parser::OmpClause &x : ssc->v.Clauses().v) {213 if (x.Id() == llvm::omp::Clause::OMPC_simd) {214 eligibleSIMD = true;215 break;216 }217 }218 } else if (dirId == llvm::omp::Directive::OMPD_scan) {219 eligibleSIMD = true;220 }221 }222 },223 // Allowing SIMD and loop construct224 [&](const parser::OpenMPLoopConstruct &c) {225 const auto &beginName{c.BeginDir().DirName()};226 if (beginName.v == llvm::omp::Directive::OMPD_simd ||227 beginName.v == llvm::omp::Directive::OMPD_do_simd ||228 beginName.v == llvm::omp::Directive::OMPD_loop) {229 eligibleSIMD = true;230 }231 },232 [&](const parser::OpenMPAtomicConstruct &c) {233 // Allow `!$OMP ATOMIC`234 eligibleSIMD = true;235 },236 [&](const auto &c) {},237 },238 c.u);239 if (!eligibleSIMD) {240 context_.Say(parser::omp::GetOmpDirectiveName(c).source,241 "The only OpenMP constructs that can be encountered during execution "242 "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "243 "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "244 "construct with the `SIMD` clause."_err_en_US);245 }246}247 248static bool IsLoopTransforming(llvm::omp::Directive dir) {249 switch (dir) {250 // TODO case llvm::omp::Directive::OMPD_flatten:251 case llvm::omp::Directive::OMPD_fuse:252 case llvm::omp::Directive::OMPD_interchange:253 case llvm::omp::Directive::OMPD_nothing:254 case llvm::omp::Directive::OMPD_reverse:255 // TODO case llvm::omp::Directive::OMPD_split:256 case llvm::omp::Directive::OMPD_stripe:257 case llvm::omp::Directive::OMPD_tile:258 case llvm::omp::Directive::OMPD_unroll:259 return true;260 default:261 return false;262 }263}264 265void OmpStructureChecker::CheckNestedBlock(const parser::OpenMPLoopConstruct &x,266 const parser::Block &body, size_t &nestedCount) {267 for (auto &stmt : body) {268 if (auto *dir{parser::Unwrap<parser::CompilerDirective>(stmt)}) {269 context_.Say(dir->source,270 "Compiler directives are not allowed inside OpenMP loop constructs"_warn_en_US);271 } else if (parser::Unwrap<parser::DoConstruct>(stmt)) {272 ++nestedCount;273 } else if (auto *omp{parser::Unwrap<parser::OpenMPLoopConstruct>(stmt)}) {274 if (!IsLoopTransforming(omp->BeginDir().DirName().v)) {275 context_.Say(omp->source,276 "Only loop-transforming OpenMP constructs are allowed inside OpenMP loop constructs"_err_en_US);277 }278 ++nestedCount;279 } else if (auto *block{parser::Unwrap<parser::BlockConstruct>(stmt)}) {280 CheckNestedBlock(x, std::get<parser::Block>(block->t), nestedCount);281 } else {282 parser::CharBlock source{parser::GetSource(stmt).value_or(x.source)};283 context_.Say(source,284 "OpenMP loop construct can only contain DO loops or loop-nest-generating OpenMP constructs"_err_en_US);285 }286 }287}288 289void OmpStructureChecker::CheckNestedConstruct(290 const parser::OpenMPLoopConstruct &x) {291 size_t nestedCount{0};292 293 auto &body{std::get<parser::Block>(x.t)};294 if (body.empty()) {295 context_.Say(x.source,296 "OpenMP loop construct should contain a DO-loop or a loop-nest-generating OpenMP construct"_err_en_US);297 } else {298 CheckNestedBlock(x, body, nestedCount);299 }300}301 302void OmpStructureChecker::CheckFullUnroll(303 const parser::OpenMPLoopConstruct &x) {304 // If the nested construct is a full unroll, then this construct is invalid305 // since it won't contain a loop.306 if (const parser::OpenMPLoopConstruct *nested{x.GetNestedConstruct()}) {307 auto &nestedSpec{nested->BeginDir()};308 if (nestedSpec.DirName().v == llvm::omp::Directive::OMPD_unroll) {309 bool isPartial{310 llvm::any_of(nestedSpec.Clauses().v, [](const parser::OmpClause &c) {311 return c.Id() == llvm::omp::Clause::OMPC_partial;312 })};313 if (!isPartial) {314 context_.Say(x.source,315 "OpenMP loop construct cannot apply to a fully unrolled loop"_err_en_US);316 }317 }318 }319}320 321void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {322 loopStack_.push_back(&x);323 324 const parser::OmpDirectiveName &beginName{x.BeginDir().DirName()};325 PushContextAndClauseSets(beginName.source, beginName.v);326 327 // Check matching, end directive is optional328 if (auto &endSpec{x.EndDir()}) {329 CheckMatching<parser::OmpDirectiveName>(beginName, endSpec->DirName());330 331 AddEndDirectiveClauses(endSpec->Clauses());332 }333 334 if (llvm::omp::allSimdSet.test(GetContext().directive)) {335 EnterDirectiveNest(SIMDNest);336 }337 338 if (CurrentDirectiveIsNested() &&339 llvm::omp::topTeamsSet.test(GetContext().directive) &&340 GetContextParent().directive == llvm::omp::Directive::OMPD_target &&341 !GetDirectiveNest(TargetBlockOnlyTeams)) {342 context_.Say(GetContextParent().directiveSource,343 "TARGET construct with nested TEAMS region contains statements or "344 "directives outside of the TEAMS construct"_err_en_US);345 }346 347 // Combined target loop constructs are target device constructs. Keep track of348 // whether any such construct has been visited to later check that REQUIRES349 // directives for target-related options don't appear after them.350 if (llvm::omp::allTargetSet.test(beginName.v)) {351 deviceConstructFound_ = true;352 }353 354 if (beginName.v == llvm::omp::Directive::OMPD_do) {355 // 2.7.1 do-clause -> private-clause |356 // firstprivate-clause |357 // lastprivate-clause |358 // linear-clause |359 // reduction-clause |360 // schedule-clause |361 // collapse-clause |362 // ordered-clause363 364 // nesting check365 HasInvalidWorksharingNesting(366 beginName.source, llvm::omp::nestedWorkshareErrSet);367 }368 SetLoopInfo(x);369 370 for (auto &construct : std::get<parser::Block>(x.t)) {371 if (const auto *doConstruct{parser::omp::GetDoConstruct(construct)}) {372 const auto &doBlock{std::get<parser::Block>(doConstruct->t)};373 CheckNoBranching(doBlock, beginName.v, beginName.source);374 }375 }376 CheckLoopItrVariableIsInt(x);377 CheckNestedConstruct(x);378 CheckFullUnroll(x);379 CheckAssociatedLoopConstraints(x);380 HasInvalidDistributeNesting(x);381 HasInvalidLoopBinding(x);382 if (CurrentDirectiveIsNested() &&383 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {384 HasInvalidTeamsNesting(beginName.v, beginName.source);385 }386 if (beginName.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd ||387 beginName.v == llvm::omp::Directive::OMPD_distribute_simd) {388 CheckDistLinear(x);389 }390 if (beginName.v == llvm::omp::Directive::OMPD_fuse) {391 CheckLooprangeBounds(x);392 } else {393 CheckNestedFuse(x);394 }395}396 397const parser::Name OmpStructureChecker::GetLoopIndex(398 const parser::DoConstruct *x) {399 using Bounds = parser::LoopControl::Bounds;400 return std::get<Bounds>(x->GetLoopControl()->u).name.thing;401}402 403void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {404 if (const auto *loop{x.GetNestedLoop()}) {405 if (loop->IsDoNormal()) {406 const parser::Name &itrVal{GetLoopIndex(loop)};407 SetLoopIv(itrVal.symbol);408 }409 }410}411 412void OmpStructureChecker::CheckLoopItrVariableIsInt(413 const parser::OpenMPLoopConstruct &x) {414 for (auto &construct : std::get<parser::Block>(x.t)) {415 for (const parser::DoConstruct *loop{416 parser::omp::GetDoConstruct(construct)};417 loop;) {418 if (loop->IsDoNormal()) {419 const parser::Name &itrVal{GetLoopIndex(loop)};420 if (itrVal.symbol) {421 const auto *type{itrVal.symbol->GetType()};422 if (!type->IsNumeric(TypeCategory::Integer)) {423 context_.Say(itrVal.source,424 "The DO loop iteration"425 " variable must be of the type integer."_err_en_US,426 itrVal.ToString());427 }428 }429 }430 // Get the next DoConstruct if block is not empty.431 const auto &block{std::get<parser::Block>(loop->t)};432 const auto it{block.begin()};433 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)434 : nullptr;435 }436 }437}438 439std::int64_t OmpStructureChecker::GetOrdCollapseLevel(440 const parser::OpenMPLoopConstruct &x) {441 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};442 std::int64_t orderedCollapseLevel{1};443 std::int64_t orderedLevel{1};444 std::int64_t collapseLevel{1};445 446 for (const auto &clause : beginSpec.Clauses().v) {447 if (const auto *collapseClause{448 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {449 if (const auto v{GetIntValue(collapseClause->v)}) {450 collapseLevel = *v;451 }452 }453 if (const auto *orderedClause{454 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {455 if (const auto v{GetIntValue(orderedClause->v)}) {456 orderedLevel = *v;457 }458 }459 }460 if (orderedLevel >= collapseLevel) {461 orderedCollapseLevel = orderedLevel;462 } else {463 orderedCollapseLevel = collapseLevel;464 }465 return orderedCollapseLevel;466}467 468void OmpStructureChecker::CheckAssociatedLoopConstraints(469 const parser::OpenMPLoopConstruct &x) {470 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};471 AssociatedLoopChecker checker{context_, ordCollapseLevel};472 parser::Walk(x, checker);473}474 475void OmpStructureChecker::CheckDistLinear(476 const parser::OpenMPLoopConstruct &x) {477 const parser::OmpClauseList &clauses{x.BeginDir().Clauses()};478 479 SymbolSourceMap indexVars;480 481 // Collect symbols of all the variables from linear clauses482 for (auto &clause : clauses.v) {483 if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {484 auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};485 GetSymbolsInObjectList(objects, indexVars);486 }487 }488 489 if (!indexVars.empty()) {490 // Get collapse level, if given, to find which loops are "associated."491 std::int64_t collapseVal{GetOrdCollapseLevel(x)};492 // Include the top loop if no collapse is specified493 if (collapseVal == 0) {494 collapseVal = 1;495 }496 497 // Match the loop index variables with the collected symbols from linear498 // clauses.499 for (auto &construct : std::get<parser::Block>(x.t)) {500 std::int64_t curCollapseVal{collapseVal};501 for (const parser::DoConstruct *loop{502 parser::omp::GetDoConstruct(construct)};503 loop;) {504 if (loop->IsDoNormal()) {505 const parser::Name &itrVal{GetLoopIndex(loop)};506 if (itrVal.symbol) {507 // Remove the symbol from the collected set508 indexVars.erase(&itrVal.symbol->GetUltimate());509 }510 curCollapseVal--;511 if (curCollapseVal == 0) {512 break;513 }514 }515 // Get the next DoConstruct if block is not empty.516 const auto &block{std::get<parser::Block>(loop->t)};517 const auto it{block.begin()};518 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)519 : nullptr;520 }521 }522 523 // Show error for the remaining variables524 for (auto &[symbol, source] : indexVars) {525 const Symbol &root{GetAssociationRoot(*symbol)};526 context_.Say(source,527 "Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,528 root.name());529 }530 }531}532 533void OmpStructureChecker::CheckLooprangeBounds(534 const parser::OpenMPLoopConstruct &x) {535 const parser::OmpClauseList &clauseList{x.BeginDir().Clauses()};536 if (clauseList.v.empty()) {537 return;538 }539 for (auto &clause : clauseList.v) {540 if (const auto *lrClause{541 std::get_if<parser::OmpClause::Looprange>(&clause.u)}) {542 auto first{GetIntValue(std::get<0>((lrClause->v).t))};543 auto count{GetIntValue(std::get<1>((lrClause->v).t))};544 if (!first || !count) {545 return;546 }547 auto &loopConsList{std::get<parser::Block>(x.t)};548 if (*first > 0 && *count > 0 &&549 loopConsList.size() < (unsigned)(*first + *count - 1)) {550 context_.Say(clause.source,551 "The loop range indicated in the %s clause must not be out of the bounds of the Loop Sequence following the construct."_err_en_US,552 parser::ToUpperCaseLetters(clause.source.ToString()));553 }554 return;555 }556 }557}558 559void OmpStructureChecker::CheckNestedFuse(560 const parser::OpenMPLoopConstruct &x) {561 auto &loopConsList{std::get<parser::Block>(x.t)};562 if (loopConsList.empty()) {563 return;564 }565 const auto *ompConstruct{parser::omp::GetOmpLoop(loopConsList.front())};566 if (!ompConstruct) {567 return;568 }569 const parser::OmpClauseList &clauseList{ompConstruct->BeginDir().Clauses()};570 if (clauseList.v.empty()) {571 return;572 }573 for (auto &clause : clauseList.v) {574 if (const auto *lrClause{575 std::get_if<parser::OmpClause::Looprange>(&clause.u)}) {576 auto count{GetIntValue(std::get<1>((lrClause->v).t))};577 if (!count) {578 return;579 }580 auto &nestedLoopConsList{std::get<parser::Block>(ompConstruct->t)};581 if (nestedLoopConsList.size() > (unsigned)(*count)) {582 context_.Say(x.BeginDir().DirName().source,583 "The loop sequence following the %s construct must be fully fused first."_err_en_US,584 parser::ToUpperCaseLetters(585 x.BeginDir().DirName().source.ToString()));586 }587 return;588 }589 }590}591 592void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {593 const parser::OmpClauseList &clauseList{x.BeginDir().Clauses()};594 595 // A few semantic checks for InScan reduction are performed below as SCAN596 // constructs inside LOOP may add the relevant information. Scan reduction is597 // supported only in loop constructs, so same checks are not applicable to598 // other directives.599 using ReductionModifier = parser::OmpReductionModifier;600 for (const auto &clause : clauseList.v) {601 if (const auto *reductionClause{602 std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {603 auto &modifiers{OmpGetModifiers(reductionClause->v)};604 auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};605 if (maybeModifier &&606 maybeModifier->v == ReductionModifier::Value::Inscan) {607 const auto &objectList{608 std::get<parser::OmpObjectList>(reductionClause->v.t)};609 auto checkReductionSymbolInScan = [&](const parser::Name *name) {610 if (auto &symbol = name->symbol) {611 if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&612 !symbol->test(Symbol::Flag::OmpExclusiveScan)) {613 context_.Say(name->source,614 "List item %s must appear in EXCLUSIVE or "615 "INCLUSIVE clause of an "616 "enclosed SCAN directive"_err_en_US,617 name->ToString());618 }619 }620 };621 for (const auto &ompObj : objectList.v) {622 common::visit(623 common::visitors{624 [&](const parser::Designator &designator) {625 if (const auto *name{626 parser::GetDesignatorNameIfDataRef(designator)}) {627 checkReductionSymbolInScan(name);628 }629 },630 [&](const parser::Name &name) {631 checkReductionSymbolInScan(&name);632 },633 [&](const parser::OmpObject::Invalid &invalid) {},634 },635 ompObj.u);636 }637 }638 }639 }640 if (llvm::omp::allSimdSet.test(GetContext().directive)) {641 ExitDirectiveNest(SIMDNest);642 }643 dirContext_.pop_back();644 645 assert(!loopStack_.empty() && "Expecting non-empty loop stack");646#ifndef NDEBUG647 const LoopConstruct &top{loopStack_.back()};648 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};649 assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");650#endif651 loopStack_.pop_back();652}653 654void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {655 const parser::OmpDirectiveName &dir{x.DirName()};656 ResetPartialContext(dir.source);657 switch (dir.v) {658 // 2.7.1 end-do -> END DO [nowait-clause]659 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]660 case llvm::omp::Directive::OMPD_do:661 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);662 break;663 case llvm::omp::Directive::OMPD_do_simd:664 PushContextAndClauseSets(665 dir.source, llvm::omp::Directive::OMPD_end_do_simd);666 break;667 default:668 // no clauses are allowed669 break;670 }671}672 673void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {674 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||675 (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {676 dirContext_.pop_back();677 }678}679 680void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {681 CheckAllowedClause(llvm::omp::Clause::OMPC_linear);682 unsigned version{context_.langOptions().OpenMPVersion};683 llvm::omp::Directive dir{GetContext().directive};684 parser::CharBlock clauseSource{GetContext().clauseSource};685 const parser::OmpLinearModifier *linearMod{nullptr};686 687 SymbolSourceMap symbols;688 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};689 CheckCrayPointee(objects, "LINEAR", false);690 GetSymbolsInObjectList(objects, symbols);691 692 auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {693 if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {694 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};695 context_.Say(source,696 "The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,697 symbol->name(), desc.name.str());698 }699 }};700 701 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {702 auto &modifiers{OmpGetModifiers(x.v)};703 linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);704 if (linearMod) {705 // 2.7 Loop Construct Restriction706 if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {707 context_.Say(clauseSource,708 "A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,709 ContextDirectiveAsFortran());710 return;711 }712 713 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};714 for (auto &[symbol, source] : symbols) {715 if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {716 CheckIntegerNoRef(symbol, source);717 } else {718 if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&719 !IsPolymorphic(*symbol)) {720 context_.Say(source,721 "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,722 symbol->name(), desc.name.str());723 }724 }725 if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||726 linearMod->v == parser::OmpLinearModifier::Value::Uval) {727 if (!IsDummy(*symbol) || IsValue(*symbol)) {728 context_.Say(source,729 "If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,730 desc.name.str(), symbol->name());731 }732 }733 } // for (symbol, source)734 735 if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {736 context_.Say(OmpGetModifierSource(modifiers, linearMod),737 "The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,738 ThisVersion(version));739 }740 }741 }742 743 // OpenMP 5.2: Ordered clause restriction744 if (const auto *clause{745 FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {746 const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};747 if (orderedClause.v) {748 return;749 }750 }751 752 // OpenMP 5.2: Linear clause Restrictions753 for (auto &[symbol, source] : symbols) {754 if (!linearMod) {755 // Already checked this with the modifier present.756 CheckIntegerNoRef(symbol, source);757 }758 if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {759 context_.Say(source,760 "The list item `%s` must be a dummy argument"_err_en_US,761 symbol->name());762 }763 if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {764 context_.Say(source,765 "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,766 symbol->name());767 }768 if (FindCommonBlockContaining(*symbol)) {769 context_.Say(source,770 "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,771 symbol->name());772 }773 }774}775 776void OmpStructureChecker::Enter(const parser::DoConstruct &x) {777 Base::Enter(x);778 loopStack_.push_back(&x);779}780 781void OmpStructureChecker::Leave(const parser::DoConstruct &x) {782 assert(!loopStack_.empty() && "Expecting non-empty loop stack");783#ifndef NDEBUG784 const LoopConstruct &top = loopStack_.back();785 auto *doc{std::get_if<const parser::DoConstruct *>(&top)};786 assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");787#endif788 loopStack_.pop_back();789 Base::Leave(x);790}791 792} // namespace Fortran::semantics793