1144 lines · cpp
1//===-- lib/Semantics/check-acc-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-exception6//7//===----------------------------------------------------------------------===//8#include "check-acc-structure.h"9#include "resolve-names-utils.h"10#include "flang/Common/enum-set.h"11#include "flang/Evaluate/tools.h"12#include "flang/Parser/parse-tree.h"13#include "flang/Parser/tools.h"14#include "flang/Semantics/symbol.h"15#include "flang/Semantics/tools.h"16#include "flang/Semantics/type.h"17#include "flang/Support/Fortran.h"18#include "llvm/Support/AtomicOrdering.h"19 20#include <optional>21 22#define CHECK_SIMPLE_CLAUSE(X, Y) \23 void AccStructureChecker::Enter(const parser::AccClause::X &) { \24 CheckAllowed(llvm::acc::Clause::Y); \25 }26 27#define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \28 void AccStructureChecker::Enter(const parser::AccClause::X &c) { \29 CheckAllowed(llvm::acc::Clause::Y); \30 RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \31 }32 33using ReductionOpsSet =34 Fortran::common::EnumSet<Fortran::parser::ReductionOperator::Operator,35 Fortran::parser::ReductionOperator::Operator_enumSize>;36 37static ReductionOpsSet reductionIntegerSet{38 Fortran::parser::ReductionOperator::Operator::Plus,39 Fortran::parser::ReductionOperator::Operator::Multiply,40 Fortran::parser::ReductionOperator::Operator::Max,41 Fortran::parser::ReductionOperator::Operator::Min,42 Fortran::parser::ReductionOperator::Operator::Iand,43 Fortran::parser::ReductionOperator::Operator::Ior,44 Fortran::parser::ReductionOperator::Operator::Ieor};45 46static ReductionOpsSet reductionRealSet{47 Fortran::parser::ReductionOperator::Operator::Plus,48 Fortran::parser::ReductionOperator::Operator::Multiply,49 Fortran::parser::ReductionOperator::Operator::Max,50 Fortran::parser::ReductionOperator::Operator::Min};51 52static ReductionOpsSet reductionComplexSet{53 Fortran::parser::ReductionOperator::Operator::Plus,54 Fortran::parser::ReductionOperator::Operator::Multiply};55 56static ReductionOpsSet reductionLogicalSet{57 Fortran::parser::ReductionOperator::Operator::And,58 Fortran::parser::ReductionOperator::Operator::Or,59 Fortran::parser::ReductionOperator::Operator::Eqv,60 Fortran::parser::ReductionOperator::Operator::Neqv};61 62namespace Fortran::semantics {63 64static constexpr inline AccClauseSet65 computeConstructOnlyAllowedAfterDeviceTypeClauses{66 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait,67 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers,68 llvm::acc::Clause::ACCC_vector_length};69 70static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{71 llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse,72 llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang,73 llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile,74 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};75 76static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{77 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait};78 79static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{80 llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang,81 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker,82 llvm::acc::Clause::ACCC_seq};83 84static constexpr inline AccClauseSet routineMutuallyExclusiveClauses{85 llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_worker,86 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_seq};87 88bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) {89 if (GetContext().directive == llvm::acc::ACCD_enter_data ||90 GetContext().directive == llvm::acc::ACCD_exit_data) {91 context_.Say(GetContext().clauseSource,92 "Modifier is not allowed for the %s clause "93 "on the %s directive"_err_en_US,94 parser::ToUpperCaseLetters(getClauseName(clause).str()),95 ContextDirectiveAsFortran());96 return true;97 }98 return false;99}100 101bool AccStructureChecker::IsComputeConstruct(102 llvm::acc::Directive directive) const {103 return directive == llvm::acc::ACCD_parallel ||104 directive == llvm::acc::ACCD_parallel_loop ||105 directive == llvm::acc::ACCD_serial ||106 directive == llvm::acc::ACCD_serial_loop ||107 directive == llvm::acc::ACCD_kernels ||108 directive == llvm::acc::ACCD_kernels_loop;109}110 111bool AccStructureChecker::IsLoopConstruct(112 llvm::acc::Directive directive) const {113 return directive == llvm::acc::Directive::ACCD_loop ||114 directive == llvm::acc::ACCD_parallel_loop ||115 directive == llvm::acc::ACCD_serial_loop ||116 directive == llvm::acc::ACCD_kernels_loop;117}118 119std::optional<llvm::acc::Directive>120AccStructureChecker::getParentComputeConstruct() const {121 // Check all nested context skipping the first one.122 for (std::size_t i = dirContext_.size() - 1; i > 0; --i)123 if (IsComputeConstruct(dirContext_[i - 1].directive))124 return dirContext_[i - 1].directive;125 return std::nullopt;126}127 128bool AccStructureChecker::IsInsideComputeConstruct() const {129 return getParentComputeConstruct().has_value();130}131 132void AccStructureChecker::CheckNotInComputeConstruct() {133 if (IsInsideComputeConstruct()) {134 context_.Say(GetContext().directiveSource,135 "Directive %s may not be called within a compute region"_err_en_US,136 ContextDirectiveAsFortran());137 }138}139 140bool AccStructureChecker::IsInsideKernelsConstruct() const {141 if (auto directive = getParentComputeConstruct())142 if (*directive == llvm::acc::ACCD_kernels ||143 *directive == llvm::acc::ACCD_kernels_loop)144 return true;145 return false;146}147 148void AccStructureChecker::Enter(const parser::AccClause &x) {149 SetContextClause(x);150}151 152void AccStructureChecker::Leave(const parser::AccClauseList &) {}153 154void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) {155 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};156 const auto &endBlockDir{std::get<parser::AccEndBlockDirective>(x.t)};157 const auto &beginAccBlockDir{158 std::get<parser::AccBlockDirective>(beginBlockDir.t)};159 160 CheckMatching(beginAccBlockDir, endBlockDir.v);161 PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v);162}163 164void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) {165 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};166 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};167 const parser::Block &block{std::get<parser::Block>(x.t)};168 switch (blockDir.v) {169 case llvm::acc::Directive::ACCD_kernels:170 case llvm::acc::Directive::ACCD_parallel:171 case llvm::acc::Directive::ACCD_serial:172 // Restriction - line 1004-1005173 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,174 computeConstructOnlyAllowedAfterDeviceTypeClauses);175 // Restriction - line 1001176 CheckNoBranching(block, GetContext().directive, blockDir.source);177 break;178 case llvm::acc::Directive::ACCD_data:179 // Restriction - 2.6.5 pt 1180 // Only a warning is emitted here for portability reason.181 CheckRequireAtLeastOneOf(/*warnInsteadOfError=*/true);182 // Restriction is not formally in the specification but all compilers emit183 // an error and it is likely to be omitted from the spec.184 CheckNoBranching(block, GetContext().directive, blockDir.source);185 break;186 case llvm::acc::Directive::ACCD_host_data:187 // Restriction - line 1746188 CheckRequireAtLeastOneOf();189 break;190 default:191 break;192 }193 dirContext_.pop_back();194}195 196void AccStructureChecker::Enter(197 const parser::OpenACCStandaloneDeclarativeConstruct &x) {198 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};199 PushContextAndClauseSets(declarativeDir.source, declarativeDir.v);200}201 202void AccStructureChecker::Leave(203 const parser::OpenACCStandaloneDeclarativeConstruct &x) {204 // Restriction - line 2409205 CheckAtLeastOneClause();206 207 // Restriction - line 2417-2418 - In a Fortran module declaration section,208 // only create, copyin, device_resident, and link clauses are allowed.209 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};210 const auto &scope{context_.FindScope(declarativeDir.source)};211 const Scope &containingScope{GetProgramUnitContaining(scope)};212 if (containingScope.kind() == Scope::Kind::Module) {213 for (auto cl : GetContext().actualClauses) {214 if (cl != llvm::acc::Clause::ACCC_create &&215 cl != llvm::acc::Clause::ACCC_copyin &&216 cl != llvm::acc::Clause::ACCC_device_resident &&217 cl != llvm::acc::Clause::ACCC_link) {218 context_.Say(GetContext().directiveSource,219 "%s clause is not allowed on the %s directive in module "220 "declaration "221 "section"_err_en_US,222 parser::ToUpperCaseLetters(223 llvm::acc::getOpenACCClauseName(cl).str()),224 ContextDirectiveAsFortran());225 }226 }227 }228 dirContext_.pop_back();229}230 231void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) {232 const auto &beginCombinedDir{233 std::get<parser::AccBeginCombinedDirective>(x.t)};234 const auto &combinedDir{235 std::get<parser::AccCombinedDirective>(beginCombinedDir.t)};236 237 // check matching, End directive is optional238 if (const auto &endCombinedDir{239 std::get<std::optional<parser::AccEndCombinedDirective>>(x.t)}) {240 CheckMatching<parser::AccCombinedDirective>(combinedDir, endCombinedDir->v);241 }242 243 PushContextAndClauseSets(combinedDir.source, combinedDir.v);244}245 246void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) {247 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};248 const auto &combinedDir{249 std::get<parser::AccCombinedDirective>(beginBlockDir.t)};250 auto &doCons{std::get<std::optional<parser::DoConstruct>>(x.t)};251 switch (combinedDir.v) {252 case llvm::acc::Directive::ACCD_kernels_loop:253 case llvm::acc::Directive::ACCD_parallel_loop:254 case llvm::acc::Directive::ACCD_serial_loop:255 // Restriction - line 1004-1005256 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,257 computeConstructOnlyAllowedAfterDeviceTypeClauses |258 loopOnlyAllowedAfterDeviceTypeClauses);259 if (doCons) {260 const parser::Block &block{std::get<parser::Block>(doCons->t)};261 CheckNoBranching(block, GetContext().directive, beginBlockDir.source);262 }263 break;264 default:265 break;266 }267 dirContext_.pop_back();268}269 270std::optional<std::int64_t> AccStructureChecker::getGangDimensionSize(271 DirectiveContext &dirContext) {272 for (auto it : dirContext.clauseInfo) {273 const auto *clause{it.second};274 if (const auto *gangClause{275 std::get_if<parser::AccClause::Gang>(&clause->u)})276 if (gangClause->v) {277 const Fortran::parser::AccGangArgList &x{*gangClause->v};278 for (const Fortran::parser::AccGangArg &gangArg : x.v)279 if (const auto *dim{280 std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)})281 if (const auto v{EvaluateInt64(context_, dim->v)})282 return *v;283 }284 }285 return std::nullopt;286}287 288void AccStructureChecker::CheckNotInSameOrSubLevelLoopConstruct() {289 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {290 auto &parent{dirContext_[i - 1]};291 if (IsLoopConstruct(parent.directive)) {292 for (auto parentClause : parent.actualClauses) {293 for (auto cl : GetContext().actualClauses) {294 bool invalid{false};295 if (parentClause == llvm::acc::Clause::ACCC_gang &&296 cl == llvm::acc::Clause::ACCC_gang) {297 if (IsInsideKernelsConstruct()) {298 context_.Say(GetContext().clauseSource,299 "Nested GANG loops are not allowed in the region of a KERNELS construct"_err_en_US);300 } else {301 auto parentDim = getGangDimensionSize(parent);302 auto currentDim = getGangDimensionSize(GetContext());303 std::int64_t parentDimNum = 1, currentDimNum = 1;304 if (parentDim)305 parentDimNum = *parentDim;306 if (currentDim)307 currentDimNum = *currentDim;308 if (parentDimNum <= currentDimNum) {309 std::string parentDimStr, currentDimStr;310 if (parentDim)311 parentDimStr = "(dim:" + std::to_string(parentDimNum) + ")";312 if (currentDim)313 currentDimStr = "(dim:" + std::to_string(currentDimNum) + ")";314 context_.Say(GetContext().clauseSource,315 "%s%s clause is not allowed in the region of a loop with the %s%s clause"_err_en_US,316 parser::ToUpperCaseLetters(317 llvm::acc::getOpenACCClauseName(cl).str()),318 currentDimStr,319 parser::ToUpperCaseLetters(320 llvm::acc::getOpenACCClauseName(parentClause).str()),321 parentDimStr);322 continue;323 }324 }325 } else if (parentClause == llvm::acc::Clause::ACCC_worker &&326 (cl == llvm::acc::Clause::ACCC_gang ||327 cl == llvm::acc::Clause::ACCC_worker)) {328 invalid = true;329 } else if (parentClause == llvm::acc::Clause::ACCC_vector &&330 (cl == llvm::acc::Clause::ACCC_gang ||331 cl == llvm::acc::Clause::ACCC_worker ||332 cl == llvm::acc::Clause::ACCC_vector)) {333 invalid = true;334 }335 if (invalid)336 context_.Say(GetContext().clauseSource,337 "%s clause is not allowed in the region of a loop with the %s clause"_err_en_US,338 parser::ToUpperCaseLetters(339 llvm::acc::getOpenACCClauseName(cl).str()),340 parser::ToUpperCaseLetters(341 llvm::acc::getOpenACCClauseName(parentClause).str()));342 }343 }344 }345 if (IsComputeConstruct(parent.directive))346 break;347 }348}349 350void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {351 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};352 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};353 PushContextAndClauseSets(loopDir.source, loopDir.v);354}355 356void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) {357 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};358 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};359 if (loopDir.v == llvm::acc::Directive::ACCD_loop) {360 // Restriction - line 1818-1819361 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,362 loopOnlyAllowedAfterDeviceTypeClauses);363 // Restriction - line 1834364 CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq,365 {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector,366 llvm::acc::Clause::ACCC_worker});367 // Restriction - 2.9.2, 2.9.3, 2.9.4368 CheckNotInSameOrSubLevelLoopConstruct();369 }370 dirContext_.pop_back();371}372 373void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) {374 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};375 PushContextAndClauseSets(standaloneDir.source, standaloneDir.v);376}377 378void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {379 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};380 switch (standaloneDir.v) {381 case llvm::acc::Directive::ACCD_enter_data:382 case llvm::acc::Directive::ACCD_exit_data:383 // Restriction - line 1310-1311 (ENTER DATA)384 // Restriction - line 1312-1313 (EXIT DATA)385 CheckRequireAtLeastOneOf();386 break;387 case llvm::acc::Directive::ACCD_set:388 // Restriction - line 2610389 CheckRequireAtLeastOneOf();390 // Restriction - line 2602391 CheckNotInComputeConstruct();392 break;393 case llvm::acc::Directive::ACCD_update:394 // Restriction - line 2636395 CheckRequireAtLeastOneOf();396 // Restriction - line 2669397 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,398 updateOnlyAllowedAfterDeviceTypeClauses);399 break;400 case llvm::acc::Directive::ACCD_init:401 case llvm::acc::Directive::ACCD_shutdown:402 // Restriction - line 2525 (INIT)403 // Restriction - line 2561 (SHUTDOWN)404 CheckNotInComputeConstruct();405 break;406 default:407 break;408 }409 dirContext_.pop_back();410}411 412void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) {413 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine);414 const auto &optName{std::get<std::optional<parser::Name>>(x.t)};415 if (!optName) {416 const auto &verbatim{std::get<parser::Verbatim>(x.t)};417 const auto &scope{context_.FindScope(verbatim.source)};418 const Scope &containingScope{GetProgramUnitContaining(scope)};419 if (containingScope.kind() == Scope::Kind::Module) {420 context_.Say(GetContext().directiveSource,421 "ROUTINE directive without name must appear within the specification "422 "part of a subroutine or function definition, or within an interface "423 "body for a subroutine or function in an interface block"_err_en_US);424 }425 }426}427void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) {428 // Restriction - line 2790429 CheckRequireAtLeastOneOf();430 // Restriction - line 2788-2789431 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,432 routineOnlyAllowedAfterDeviceTypeClauses);433 dirContext_.pop_back();434}435 436void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) {437 const auto &verbatim{std::get<parser::Verbatim>(x.t)};438 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_wait);439}440void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &x) {441 dirContext_.pop_back();442}443 444void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) {445 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic);446}447void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {448 dirContext_.pop_back();449}450 451void AccStructureChecker::CheckAtomicStmt(452 const parser::AssignmentStmt &assign, const std::string &construct) {453 const auto &var{std::get<parser::Variable>(assign.t)};454 const auto &expr{std::get<parser::Expr>(assign.t)};455 const auto *rhs{GetExpr(context_, expr)};456 const auto *lhs{GetExpr(context_, var)};457 458 if (lhs) {459 if (lhs->Rank() != 0) {460 context_.Say(expr.source,461 "LHS of atomic %s statement must be scalar"_err_en_US, construct);462 }463 // TODO: Check if lhs is intrinsic type.464 }465 if (rhs) {466 if (rhs->Rank() != 0) {467 context_.Say(var.GetSource(),468 "RHS of atomic %s statement must be scalar"_err_en_US, construct);469 }470 // TODO: Check if rhs is intrinsic type.471 }472}473 474static constexpr evaluate::operation::OperatorSet validAccAtomicUpdateOperators{475 evaluate::operation::Operator::Add, evaluate::operation::Operator::Mul,476 evaluate::operation::Operator::Sub, evaluate::operation::Operator::Div,477 evaluate::operation::Operator::And, evaluate::operation::Operator::Or,478 evaluate::operation::Operator::Eqv, evaluate::operation::Operator::Neqv,479 evaluate::operation::Operator::Max, evaluate::operation::Operator::Min};480 481static bool IsValidAtomicUpdateOperation(482 const evaluate::operation::Operator &op) {483 return validAccAtomicUpdateOperators.test(op);484}485 486// Couldn't reproduce this behavior with evaluate::UnwrapConvertedExpr which487// is similar but only works within a single type category.488static SomeExpr GetExprModuloConversion(const SomeExpr &expr) {489 const auto [op, args]{evaluate::GetTopLevelOperation(expr)};490 // Check: if it is a conversion then it must have at least one argument.491 CHECK(((op != evaluate::operation::Operator::Convert &&492 op != evaluate::operation::Operator::Resize) ||493 args.size() >= 1) &&494 "Invalid conversion operation");495 if ((op == evaluate::operation::Operator::Convert ||496 op == evaluate::operation::Operator::Resize) &&497 args.size() >= 1) {498 return args[0];499 }500 return expr;501}502 503void AccStructureChecker::CheckAtomicUpdateStmt(504 const parser::AssignmentStmt &assign, const SomeExpr &updateVar,505 const SomeExpr *captureVar) {506 CheckAtomicStmt(assign, "update");507 const auto &expr{std::get<parser::Expr>(assign.t)};508 const auto *rhs{GetExpr(context_, expr)};509 if (rhs) {510 const auto [op, args]{511 evaluate::GetTopLevelOperation(GetExprModuloConversion(*rhs))};512 if (!IsValidAtomicUpdateOperation(op)) {513 context_.Say(expr.source,514 "Invalid atomic update operation, can only use: *, +, -, *, /, and, or, eqv, neqv, max, min, iand, ior, ieor"_err_en_US);515 } else {516 bool foundUpdateVar{false};517 for (const auto &arg : args) {518 if (updateVar == GetExprModuloConversion(arg)) {519 if (foundUpdateVar) {520 context_.Say(expr.source,521 "The updated variable, %s, cannot appear more than once in the atomic update operation"_err_en_US,522 updateVar.AsFortran());523 } else {524 foundUpdateVar = true;525 }526 } else if (evaluate::IsVarSubexpressionOf(updateVar, arg)) {527 // TODO: Get the source location of arg and point to the individual528 // argument.529 context_.Say(expr.source,530 "Arguments to the atomic update operation cannot reference the updated variable, %s, as a subexpression"_err_en_US,531 updateVar.AsFortran());532 }533 }534 if (!foundUpdateVar) {535 context_.Say(expr.source,536 "The RHS of this atomic update statement must reference the updated variable: %s"_err_en_US,537 updateVar.AsFortran());538 }539 }540 }541}542 543void AccStructureChecker::CheckAtomicWriteStmt(544 const parser::AssignmentStmt &assign, const SomeExpr &updateVar,545 const SomeExpr *captureVar) {546 CheckAtomicStmt(assign, "write");547 const auto &expr{std::get<parser::Expr>(assign.t)};548 const auto *rhs{GetExpr(context_, expr)};549 if (rhs) {550 if (evaluate::IsVarSubexpressionOf(updateVar, *rhs)) {551 context_.Say(expr.source,552 "The RHS of this atomic write statement cannot reference the atomic variable: %s"_err_en_US,553 updateVar.AsFortran());554 }555 }556}557 558void AccStructureChecker::CheckAtomicCaptureStmt(559 const parser::AssignmentStmt &assign, const SomeExpr *updateVar,560 const SomeExpr &captureVar) {561 CheckAtomicStmt(assign, "capture");562}563 564void AccStructureChecker::Enter(const parser::AccAtomicCapture &capture) {565 const Fortran::parser::AssignmentStmt &stmt1{566 std::get<Fortran::parser::AccAtomicCapture::Stmt1>(capture.t)567 .v.statement};568 const Fortran::parser::AssignmentStmt &stmt2{569 std::get<Fortran::parser::AccAtomicCapture::Stmt2>(capture.t)570 .v.statement};571 const auto &var1{std::get<parser::Variable>(stmt1.t)};572 const auto &var2{std::get<parser::Variable>(stmt2.t)};573 const auto *lhs1{GetExpr(context_, var1)};574 const auto *lhs2{GetExpr(context_, var2)};575 if (!lhs1 || !lhs2) {576 // Not enough information to check.577 return;578 }579 if (*lhs1 == *lhs2) {580 context_.Say(std::get<parser::Verbatim>(capture.t).source,581 "The variables assigned in this atomic capture construct must be distinct"_err_en_US);582 return;583 }584 const auto &expr1{std::get<parser::Expr>(stmt1.t)};585 const auto &expr2{std::get<parser::Expr>(stmt2.t)};586 const auto *rhs1{GetExpr(context_, expr1)};587 const auto *rhs2{GetExpr(context_, expr2)};588 if (!rhs1 || !rhs2) {589 return;590 }591 bool stmt1CapturesLhs2{*lhs2 == GetExprModuloConversion(*rhs1)};592 bool stmt2CapturesLhs1{*lhs1 == GetExprModuloConversion(*rhs2)};593 if (stmt1CapturesLhs2 && !stmt2CapturesLhs1) {594 if (*lhs2 == GetExprModuloConversion(*rhs2)) {595 // a = b; b = b: Doesn't fit the spec.596 context_.Say(std::get<parser::Verbatim>(capture.t).source,597 "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);598 // TODO: Add attatchment that a = b seems to be a capture,599 // but b = b is not a valid update or write.600 } else if (evaluate::IsVarSubexpressionOf(*lhs2, *rhs2)) {601 // Take v = x; x = <expr w/ x> as capture; update602 const auto &updateVar{*lhs2};603 const auto &captureVar{*lhs1};604 CheckAtomicCaptureStmt(stmt1, &updateVar, captureVar);605 CheckAtomicUpdateStmt(stmt2, updateVar, &captureVar);606 } else {607 // Take v = x; x = <expr w/o x> as capture; write608 const auto &updateVar{*lhs2};609 const auto &captureVar{*lhs1};610 CheckAtomicCaptureStmt(stmt1, &updateVar, captureVar);611 CheckAtomicWriteStmt(stmt2, updateVar, &captureVar);612 }613 } else if (stmt2CapturesLhs1 && !stmt1CapturesLhs2) {614 if (*lhs1 == GetExprModuloConversion(*rhs1)) {615 // Error a = a; b = a;616 context_.Say(var1.GetSource(),617 "The first assignment in this atomic capture construct doesn't perform a valid update"_err_en_US);618 // Add attatchment that a = a is not considered an update,619 // but b = a seems to be a capture.620 } else {621 // Take x = <expr>; v = x: as update; capture622 const auto &updateVar{*lhs1};623 const auto &captureVar{*lhs2};624 CheckAtomicUpdateStmt(stmt1, updateVar, &captureVar);625 CheckAtomicCaptureStmt(stmt2, &updateVar, captureVar);626 }627 } else if (stmt1CapturesLhs2 && stmt2CapturesLhs1) {628 // x1 = x2; x2 = x1; Doesn't fit the spec.629 context_.Say(std::get<parser::Verbatim>(capture.t).source,630 "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);631 // TODO: Add attatchment that both assignments seem to be captures.632 } else { // !stmt1CapturesLhs2 && !stmt2CapturesLhs1633 // a = <expr != b>; b = <expr != a>; Doesn't fit the spec634 context_.Say(std::get<parser::Verbatim>(capture.t).source,635 "The assignments in this atomic capture construct do not update a variable and capture either its initial or final value"_err_en_US);636 // TODO: Add attatchment that neither assignment seems to be a capture.637 }638}639 640void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) {641 const auto &assign{642 std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};643 const auto &var{std::get<parser::Variable>(assign.t)};644 if (const auto *updateVar{GetExpr(context_, var)}) {645 CheckAtomicUpdateStmt(assign, *updateVar, /*captureVar=*/nullptr);646 }647}648 649void AccStructureChecker::Enter(const parser::AccAtomicWrite &x) {650 const auto &assign{651 std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};652 const auto &var{std::get<parser::Variable>(assign.t)};653 if (const auto *updateVar{GetExpr(context_, var)}) {654 CheckAtomicWriteStmt(assign, *updateVar, /*captureVar=*/nullptr);655 }656}657 658void AccStructureChecker::Enter(const parser::AccAtomicRead &x) {659 const auto &assign{660 std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};661 const auto &var{std::get<parser::Variable>(assign.t)};662 if (const auto *captureVar{GetExpr(context_, var)}) {663 CheckAtomicCaptureStmt(assign, /*updateVar=*/nullptr, *captureVar);664 }665}666 667void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {668 const auto &verbatim = std::get<parser::Verbatim>(x.t);669 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);670 SetContextDirectiveSource(verbatim.source);671 if (loopNestLevel == 0) {672 context_.Say(verbatim.source,673 "The CACHE directive must be inside a loop"_err_en_US);674 }675}676void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {677 dirContext_.pop_back();678}679 680// Clause checkers681CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto)682CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)683CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)684CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)685CHECK_SIMPLE_CLAUSE(Default, ACCC_default)686CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)687CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)688CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)689CHECK_SIMPLE_CLAUSE(Device, ACCC_device)690CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)691CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)692CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)693CHECK_SIMPLE_CLAUSE(Host, ACCC_host)694CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)695CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)696CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)697CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)698CHECK_SIMPLE_CLAUSE(Private, ACCC_private)699CHECK_SIMPLE_CLAUSE(Read, ACCC_read)700CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device)701CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait)702CHECK_SIMPLE_CLAUSE(Write, ACCC_write)703CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)704 705void AccStructureChecker::CheckMultipleOccurrenceInDeclare(706 const parser::AccObjectList &list, llvm::acc::Clause clause) {707 if (GetContext().directive != llvm::acc::Directive::ACCD_declare)708 return;709 for (const auto &object : list.v) {710 common::visit(711 common::visitors{712 [&](const parser::Designator &designator) {713 if (const auto *name =714 parser::GetDesignatorNameIfDataRef(designator)) {715 if (declareSymbols.contains(&name->symbol->GetUltimate())) {716 if (declareSymbols[&name->symbol->GetUltimate()] == clause) {717 context_.Warn(common::UsageWarning::OpenAccUsage,718 GetContext().clauseSource,719 "'%s' in the %s clause is already present in the same clause in this module"_warn_en_US,720 name->symbol->name(),721 parser::ToUpperCaseLetters(722 llvm::acc::getOpenACCClauseName(clause).str()));723 } else {724 context_.Say(GetContext().clauseSource,725 "'%s' in the %s clause is already present in another "726 "%s clause in this module"_err_en_US,727 name->symbol->name(),728 parser::ToUpperCaseLetters(729 llvm::acc::getOpenACCClauseName(clause).str()),730 parser::ToUpperCaseLetters(731 llvm::acc::getOpenACCClauseName(732 declareSymbols[&name->symbol->GetUltimate()])733 .str()));734 }735 }736 declareSymbols.insert({&name->symbol->GetUltimate(), clause});737 }738 },739 [&](const parser::Name &name) {740 // TODO: check common block741 }},742 object.u);743 }744}745 746void AccStructureChecker::CheckMultipleOccurrenceInDeclare(747 const parser::AccObjectListWithModifier &list, llvm::acc::Clause clause) {748 const auto &objectList = std::get<Fortran::parser::AccObjectList>(list.t);749 CheckMultipleOccurrenceInDeclare(objectList, clause);750}751 752void AccStructureChecker::Enter(const parser::AccClause::Async &c) {753 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_async;754 CheckAllowed(crtClause);755 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);756}757 758void AccStructureChecker::Enter(const parser::AccClause::Create &c) {759 CheckAllowed(llvm::acc::Clause::ACCC_create);760 const auto &modifierClause{c.v};761 if (const auto &modifier{762 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {763 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {764 context_.Say(GetContext().clauseSource,765 "Only the ZERO modifier is allowed for the %s clause "766 "on the %s directive"_err_en_US,767 parser::ToUpperCaseLetters(768 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)769 .str()),770 ContextDirectiveAsFortran());771 }772 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {773 context_.Say(GetContext().clauseSource,774 "The ZERO modifier is not allowed for the %s clause "775 "on the %s directive"_err_en_US,776 parser::ToUpperCaseLetters(777 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)778 .str()),779 ContextDirectiveAsFortran());780 }781 }782 CheckMultipleOccurrenceInDeclare(783 modifierClause, llvm::acc::Clause::ACCC_create);784}785 786void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {787 CheckAllowed(llvm::acc::Clause::ACCC_copyin);788 const auto &modifierClause{c.v};789 if (const auto &modifier{790 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {791 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) {792 return;793 }794 if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) {795 context_.Say(GetContext().clauseSource,796 "Only the READONLY modifier is allowed for the %s clause "797 "on the %s directive"_err_en_US,798 parser::ToUpperCaseLetters(799 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin)800 .str()),801 ContextDirectiveAsFortran());802 }803 }804 CheckMultipleOccurrenceInDeclare(805 modifierClause, llvm::acc::Clause::ACCC_copyin);806}807 808void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {809 CheckAllowed(llvm::acc::Clause::ACCC_copyout);810 const auto &modifierClause{c.v};811 if (const auto &modifier{812 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {813 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) {814 return;815 }816 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {817 context_.Say(GetContext().clauseSource,818 "Only the ZERO modifier is allowed for the %s clause "819 "on the %s directive"_err_en_US,820 parser::ToUpperCaseLetters(821 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)822 .str()),823 ContextDirectiveAsFortran());824 }825 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {826 context_.Say(GetContext().clauseSource,827 "The ZERO modifier is not allowed for the %s clause "828 "on the %s directive"_err_en_US,829 parser::ToUpperCaseLetters(830 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)831 .str()),832 ContextDirectiveAsFortran());833 }834 }835 CheckMultipleOccurrenceInDeclare(836 modifierClause, llvm::acc::Clause::ACCC_copyout);837}838 839void AccStructureChecker::Enter(const parser::AccClause::DeviceType &d) {840 CheckAllowed(llvm::acc::Clause::ACCC_device_type);841 if (GetContext().directive == llvm::acc::Directive::ACCD_set &&842 d.v.v.size() > 1) {843 context_.Say(GetContext().clauseSource,844 "The %s clause on the %s directive accepts only one value"_err_en_US,845 parser::ToUpperCaseLetters(846 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_device_type)847 .str()),848 ContextDirectiveAsFortran());849 }850 ResetCrtGroup();851}852 853void AccStructureChecker::Enter(const parser::AccClause::Seq &g) {854 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_seq;855 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {856 CheckMutuallyExclusivePerGroup(crtClause,857 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);858 }859 CheckAllowed(crtClause);860}861 862void AccStructureChecker::Enter(const parser::AccClause::Vector &g) {863 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_vector;864 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {865 CheckMutuallyExclusivePerGroup(crtClause,866 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);867 }868 CheckAllowed(crtClause);869 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {870 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);871 }872}873 874void AccStructureChecker::Enter(const parser::AccClause::Worker &g) {875 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_worker;876 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {877 CheckMutuallyExclusivePerGroup(crtClause,878 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);879 }880 CheckAllowed(crtClause);881 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {882 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);883 }884}885 886void AccStructureChecker::Enter(const parser::AccClause::Tile &g) {887 CheckAllowed(llvm::acc::Clause::ACCC_tile);888 CheckAllowedOncePerGroup(889 llvm::acc::Clause::ACCC_tile, llvm::acc::Clause::ACCC_device_type);890}891 892void AccStructureChecker::Enter(const parser::AccClause::Gang &g) {893 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_gang;894 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {895 CheckMutuallyExclusivePerGroup(crtClause,896 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);897 }898 CheckAllowed(crtClause);899 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {900 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);901 }902 903 if (g.v) {904 bool hasNum = false;905 bool hasDim = false;906 bool hasStatic = false;907 const Fortran::parser::AccGangArgList &x = *g.v;908 for (const Fortran::parser::AccGangArg &gangArg : x.v) {909 if (std::get_if<Fortran::parser::AccGangArg::Num>(&gangArg.u)) {910 hasNum = true;911 } else if (std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) {912 hasDim = true;913 } else if (std::get_if<Fortran::parser::AccGangArg::Static>(&gangArg.u)) {914 hasStatic = true;915 }916 }917 918 if (GetContext().directive == llvm::acc::Directive::ACCD_routine &&919 (hasStatic || hasNum)) {920 context_.Say(GetContext().clauseSource,921 "Only the dim argument is allowed on the %s clause on the %s directive"_err_en_US,922 parser::ToUpperCaseLetters(923 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_gang)924 .str()),925 ContextDirectiveAsFortran());926 }927 928 if (hasDim && hasNum) {929 context_.Say(GetContext().clauseSource,930 "The num argument is not allowed when dim is specified"_err_en_US);931 }932 }933}934 935void AccStructureChecker::Enter(const parser::AccClause::NumGangs &n) {936 CheckAllowed(llvm::acc::Clause::ACCC_num_gangs,937 /*warnInsteadOfError=*/GetContext().directive ==938 llvm::acc::Directive::ACCD_serial ||939 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);940 CheckAllowedOncePerGroup(941 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_device_type);942 943 if (n.v.size() > 3)944 context_.Say(GetContext().clauseSource,945 "NUM_GANGS clause accepts a maximum of 3 arguments"_err_en_US);946}947 948void AccStructureChecker::Enter(const parser::AccClause::NumWorkers &n) {949 CheckAllowed(llvm::acc::Clause::ACCC_num_workers,950 /*warnInsteadOfError=*/GetContext().directive ==951 llvm::acc::Directive::ACCD_serial ||952 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);953 CheckAllowedOncePerGroup(954 llvm::acc::Clause::ACCC_num_workers, llvm::acc::Clause::ACCC_device_type);955}956 957void AccStructureChecker::Enter(const parser::AccClause::VectorLength &n) {958 CheckAllowed(llvm::acc::Clause::ACCC_vector_length,959 /*warnInsteadOfError=*/GetContext().directive ==960 llvm::acc::Directive::ACCD_serial ||961 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);962 CheckAllowedOncePerGroup(llvm::acc::Clause::ACCC_vector_length,963 llvm::acc::Clause::ACCC_device_type);964}965 966void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) {967 CheckAllowed(llvm::acc::Clause::ACCC_reduction);968 969 // From OpenACC 3.3970 // At a minimum, the supported data types include Fortran logical as well as971 // the numerical data types (e.g. integer, real, double precision, complex).972 // However, for each reduction operator, the supported data types include only973 // the types permitted as operands to the corresponding operator in the base974 // language where (1) for max and min, the corresponding operator is less-than975 // and (2) for other operators, the operands and the result are the same type.976 //977 // The following check that the reduction operator is supported with the given978 // type.979 const parser::AccObjectListWithReduction &list{reduction.v};980 const auto &op{std::get<parser::ReductionOperator>(list.t)};981 const auto &objects{std::get<parser::AccObjectList>(list.t)};982 983 for (const auto &object : objects.v) {984 common::visit(985 common::visitors{986 [&](const parser::Designator &designator) {987 if (const auto *name =988 parser::GetDesignatorNameIfDataRef(designator)) {989 if (name->symbol) {990 if (const auto *type{name->symbol->GetType()}) {991 if (type->IsNumeric(TypeCategory::Integer) &&992 !reductionIntegerSet.test(op.v)) {993 context_.Say(GetContext().clauseSource,994 "reduction operator not supported for integer type"_err_en_US);995 } else if (type->IsNumeric(TypeCategory::Real) &&996 !reductionRealSet.test(op.v)) {997 context_.Say(GetContext().clauseSource,998 "reduction operator not supported for real type"_err_en_US);999 } else if (type->IsNumeric(TypeCategory::Complex) &&1000 !reductionComplexSet.test(op.v)) {1001 context_.Say(GetContext().clauseSource,1002 "reduction operator not supported for complex type"_err_en_US);1003 } else if (type->category() ==1004 Fortran::semantics::DeclTypeSpec::Category::1005 Logical &&1006 !reductionLogicalSet.test(op.v)) {1007 context_.Say(GetContext().clauseSource,1008 "reduction operator not supported for logical type"_err_en_US);1009 }1010 }1011 // TODO: check composite type.1012 }1013 }1014 },1015 [&](const Fortran::parser::Name &name) {1016 // TODO: check common block1017 }},1018 object.u);1019 }1020}1021 1022void AccStructureChecker::Enter(const parser::AccClause::Self &x) {1023 CheckAllowed(llvm::acc::Clause::ACCC_self);1024 const std::optional<parser::AccSelfClause> &accSelfClause = x.v;1025 if (GetContext().directive == llvm::acc::Directive::ACCD_update &&1026 ((accSelfClause &&1027 std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>(1028 (*accSelfClause).u)) ||1029 !accSelfClause)) {1030 context_.Say(GetContext().clauseSource,1031 "SELF clause on the %s directive must have a var-list"_err_en_US,1032 ContextDirectiveAsFortran());1033 } else if (GetContext().directive != llvm::acc::Directive::ACCD_update &&1034 accSelfClause &&1035 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {1036 const auto &accObjectList =1037 std::get<parser::AccObjectList>((*accSelfClause).u);1038 if (accObjectList.v.size() != 1) {1039 context_.Say(GetContext().clauseSource,1040 "SELF clause on the %s directive only accepts optional scalar logical"1041 " expression"_err_en_US,1042 ContextDirectiveAsFortran());1043 }1044 }1045}1046 1047void AccStructureChecker::Enter(const parser::AccClause::Collapse &x) {1048 CheckAllowed(llvm::acc::Clause::ACCC_collapse);1049 CheckAllowedOncePerGroup(1050 llvm::acc::Clause::ACCC_collapse, llvm::acc::Clause::ACCC_device_type);1051 const parser::AccCollapseArg &accCollapseArg = x.v;1052 const auto &collapseValue{1053 std::get<parser::ScalarIntConstantExpr>(accCollapseArg.t)};1054 RequiresConstantPositiveParameter(1055 llvm::acc::Clause::ACCC_collapse, collapseValue);1056}1057 1058void AccStructureChecker::Enter(const parser::AccClause::Present &x) {1059 CheckAllowed(llvm::acc::Clause::ACCC_present);1060 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_present);1061}1062 1063void AccStructureChecker::Enter(const parser::AccClause::Copy &x) {1064 CheckAllowed(llvm::acc::Clause::ACCC_copy);1065 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_copy);1066}1067 1068void AccStructureChecker::Enter(const parser::AccClause::Deviceptr &x) {1069 CheckAllowed(llvm::acc::Clause::ACCC_deviceptr);1070 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_deviceptr);1071}1072 1073void AccStructureChecker::Enter(const parser::AccClause::DeviceResident &x) {1074 CheckAllowed(llvm::acc::Clause::ACCC_device_resident);1075 CheckMultipleOccurrenceInDeclare(1076 x.v, llvm::acc::Clause::ACCC_device_resident);1077}1078 1079void AccStructureChecker::Enter(const parser::AccClause::Link &x) {1080 CheckAllowed(llvm::acc::Clause::ACCC_link);1081 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link);1082}1083 1084void AccStructureChecker::Enter(const parser::AccClause::Shortloop &x) {1085 if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop)) {1086 context_.Warn(common::UsageWarning::OpenAccUsage, GetContext().clauseSource,1087 "Non-standard shortloop clause ignored"_warn_en_US);1088 }1089}1090 1091void AccStructureChecker::Enter(const parser::AccClause::If &x) {1092 CheckAllowed(llvm::acc::Clause::ACCC_if);1093 if (const auto *expr{GetExpr(x.v)}) {1094 if (auto type{expr->GetType()}) {1095 if (type->category() == TypeCategory::Integer ||1096 type->category() == TypeCategory::Logical) {1097 return; // LOGICAL and INTEGER type supported for the if clause.1098 }1099 }1100 }1101 context_.Say(1102 GetContext().clauseSource, "Must have LOGICAL or INTEGER type"_err_en_US);1103}1104 1105void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) {1106 context_.Warn(common::UsageWarning::OpenAccUsage, x.source,1107 "Misplaced OpenACC end directive"_warn_en_US);1108}1109 1110void AccStructureChecker::Enter(const parser::Module &) {1111 declareSymbols.clear();1112}1113 1114void AccStructureChecker::Enter(const parser::FunctionSubprogram &x) {1115 declareSymbols.clear();1116}1117 1118void AccStructureChecker::Enter(const parser::SubroutineSubprogram &) {1119 declareSymbols.clear();1120}1121 1122void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) {1123 declareSymbols.clear();1124}1125 1126void AccStructureChecker::Enter(const parser::DoConstruct &) {1127 ++loopNestLevel;1128}1129 1130void AccStructureChecker::Leave(const parser::DoConstruct &) {1131 --loopNestLevel;1132}1133 1134llvm::StringRef AccStructureChecker::getDirectiveName(1135 llvm::acc::Directive directive) {1136 return llvm::acc::getOpenACCDirectiveName(directive);1137}1138 1139llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {1140 return llvm::acc::getOpenACCClauseName(clause);1141}1142 1143} // namespace Fortran::semantics1144