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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 #include "check-acc-structure.h" 9 #include "flang/Common/enum-set.h" 10 #include "flang/Parser/parse-tree.h" 11 #include "flang/Semantics/tools.h" 12 13 #define CHECK_SIMPLE_CLAUSE(X, Y) \ 14 void AccStructureChecker::Enter(const parser::AccClause::X &) { \ 15 CheckAllowed(llvm::acc::Clause::Y); \ 16 } 17 18 #define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \ 19 void AccStructureChecker::Enter(const parser::AccClause::X &c) { \ 20 CheckAllowed(llvm::acc::Clause::Y); \ 21 RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \ 22 } 23 24 using ReductionOpsSet = 25 Fortran::common::EnumSet<Fortran::parser::ReductionOperator::Operator, 26 Fortran::parser::ReductionOperator::Operator_enumSize>; 27 28 static ReductionOpsSet reductionIntegerSet{ 29 Fortran::parser::ReductionOperator::Operator::Plus, 30 Fortran::parser::ReductionOperator::Operator::Multiply, 31 Fortran::parser::ReductionOperator::Operator::Max, 32 Fortran::parser::ReductionOperator::Operator::Min, 33 Fortran::parser::ReductionOperator::Operator::Iand, 34 Fortran::parser::ReductionOperator::Operator::Ior, 35 Fortran::parser::ReductionOperator::Operator::Ieor}; 36 37 static ReductionOpsSet reductionRealSet{ 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 43 static ReductionOpsSet reductionComplexSet{ 44 Fortran::parser::ReductionOperator::Operator::Plus, 45 Fortran::parser::ReductionOperator::Operator::Multiply}; 46 47 static ReductionOpsSet reductionLogicalSet{ 48 Fortran::parser::ReductionOperator::Operator::And, 49 Fortran::parser::ReductionOperator::Operator::Or, 50 Fortran::parser::ReductionOperator::Operator::Eqv, 51 Fortran::parser::ReductionOperator::Operator::Neqv}; 52 53 namespace Fortran::semantics { 54 55 static constexpr inline AccClauseSet 56 computeConstructOnlyAllowedAfterDeviceTypeClauses{ 57 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait, 58 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers, 59 llvm::acc::Clause::ACCC_vector_length}; 60 61 static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{ 62 llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse, 63 llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang, 64 llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile, 65 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker}; 66 67 static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{ 68 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait}; 69 70 static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{ 71 llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang, 72 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker, 73 llvm::acc::Clause::ACCC_seq}; 74 75 static constexpr inline AccClauseSet routineMutuallyExclusiveClauses{ 76 llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_worker, 77 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_seq}; 78 79 bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) { 80 if (GetContext().directive == llvm::acc::ACCD_enter_data || 81 GetContext().directive == llvm::acc::ACCD_exit_data) { 82 context_.Say(GetContext().clauseSource, 83 "Modifier is not allowed for the %s clause " 84 "on the %s directive"_err_en_US, 85 parser::ToUpperCaseLetters(getClauseName(clause).str()), 86 ContextDirectiveAsFortran()); 87 return true; 88 } 89 return false; 90 } 91 92 bool AccStructureChecker::IsComputeConstruct( 93 llvm::acc::Directive directive) const { 94 return directive == llvm::acc::ACCD_parallel || 95 directive == llvm::acc::ACCD_parallel_loop || 96 directive == llvm::acc::ACCD_serial || 97 directive == llvm::acc::ACCD_serial_loop || 98 directive == llvm::acc::ACCD_kernels || 99 directive == llvm::acc::ACCD_kernels_loop; 100 } 101 102 bool AccStructureChecker::IsInsideComputeConstruct() const { 103 if (dirContext_.size() <= 1) { 104 return false; 105 } 106 107 // Check all nested context skipping the first one. 108 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) { 109 if (IsComputeConstruct(dirContext_[i - 1].directive)) { 110 return true; 111 } 112 } 113 return false; 114 } 115 116 void AccStructureChecker::CheckNotInComputeConstruct() { 117 if (IsInsideComputeConstruct()) { 118 context_.Say(GetContext().directiveSource, 119 "Directive %s may not be called within a compute region"_err_en_US, 120 ContextDirectiveAsFortran()); 121 } 122 } 123 124 void AccStructureChecker::Enter(const parser::AccClause &x) { 125 SetContextClause(x); 126 } 127 128 void AccStructureChecker::Leave(const parser::AccClauseList &) {} 129 130 void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) { 131 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 132 const auto &endBlockDir{std::get<parser::AccEndBlockDirective>(x.t)}; 133 const auto &beginAccBlockDir{ 134 std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 135 136 CheckMatching(beginAccBlockDir, endBlockDir.v); 137 PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v); 138 } 139 140 void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) { 141 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 142 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 143 const parser::Block &block{std::get<parser::Block>(x.t)}; 144 switch (blockDir.v) { 145 case llvm::acc::Directive::ACCD_kernels: 146 case llvm::acc::Directive::ACCD_parallel: 147 case llvm::acc::Directive::ACCD_serial: 148 // Restriction - line 1004-1005 149 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, 150 computeConstructOnlyAllowedAfterDeviceTypeClauses); 151 // Restriction - line 1001 152 CheckNoBranching(block, GetContext().directive, blockDir.source); 153 break; 154 case llvm::acc::Directive::ACCD_data: 155 // Restriction - 2.6.5 pt 1 156 // Only a warning is emitted here for portability reason. 157 CheckRequireAtLeastOneOf(/*warnInsteadOfError=*/true); 158 // Restriction is not formally in the specification but all compilers emit 159 // an error and it is likely to be omitted from the spec. 160 CheckNoBranching(block, GetContext().directive, blockDir.source); 161 break; 162 case llvm::acc::Directive::ACCD_host_data: 163 // Restriction - line 1746 164 CheckRequireAtLeastOneOf(); 165 break; 166 default: 167 break; 168 } 169 dirContext_.pop_back(); 170 } 171 172 void AccStructureChecker::Enter( 173 const parser::OpenACCStandaloneDeclarativeConstruct &x) { 174 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)}; 175 PushContextAndClauseSets(declarativeDir.source, declarativeDir.v); 176 } 177 178 void AccStructureChecker::Leave( 179 const parser::OpenACCStandaloneDeclarativeConstruct &x) { 180 // Restriction - line 2409 181 CheckAtLeastOneClause(); 182 183 // Restriction - line 2417-2418 - In a Fortran module declaration section, 184 // only create, copyin, device_resident, and link clauses are allowed. 185 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)}; 186 const auto &scope{context_.FindScope(declarativeDir.source)}; 187 const Scope &containingScope{GetProgramUnitContaining(scope)}; 188 if (containingScope.kind() == Scope::Kind::Module) { 189 for (auto cl : GetContext().actualClauses) { 190 if (cl != llvm::acc::Clause::ACCC_create && 191 cl != llvm::acc::Clause::ACCC_copyin && 192 cl != llvm::acc::Clause::ACCC_device_resident && 193 cl != llvm::acc::Clause::ACCC_link) { 194 context_.Say(GetContext().directiveSource, 195 "%s clause is not allowed on the %s directive in module " 196 "declaration " 197 "section"_err_en_US, 198 parser::ToUpperCaseLetters( 199 llvm::acc::getOpenACCClauseName(cl).str()), 200 ContextDirectiveAsFortran()); 201 } 202 } 203 } 204 dirContext_.pop_back(); 205 } 206 207 void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) { 208 const auto &beginCombinedDir{ 209 std::get<parser::AccBeginCombinedDirective>(x.t)}; 210 const auto &combinedDir{ 211 std::get<parser::AccCombinedDirective>(beginCombinedDir.t)}; 212 213 // check matching, End directive is optional 214 if (const auto &endCombinedDir{ 215 std::get<std::optional<parser::AccEndCombinedDirective>>(x.t)}) { 216 CheckMatching<parser::AccCombinedDirective>(combinedDir, endCombinedDir->v); 217 } 218 219 PushContextAndClauseSets(combinedDir.source, combinedDir.v); 220 } 221 222 void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) { 223 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)}; 224 const auto &combinedDir{ 225 std::get<parser::AccCombinedDirective>(beginBlockDir.t)}; 226 auto &doCons{std::get<std::optional<parser::DoConstruct>>(x.t)}; 227 switch (combinedDir.v) { 228 case llvm::acc::Directive::ACCD_kernels_loop: 229 case llvm::acc::Directive::ACCD_parallel_loop: 230 case llvm::acc::Directive::ACCD_serial_loop: 231 // Restriction - line 1004-1005 232 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, 233 computeConstructOnlyAllowedAfterDeviceTypeClauses | 234 loopOnlyAllowedAfterDeviceTypeClauses); 235 if (doCons) { 236 const parser::Block &block{std::get<parser::Block>(doCons->t)}; 237 CheckNoBranching(block, GetContext().directive, beginBlockDir.source); 238 } 239 break; 240 default: 241 break; 242 } 243 dirContext_.pop_back(); 244 } 245 246 void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) { 247 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)}; 248 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)}; 249 PushContextAndClauseSets(loopDir.source, loopDir.v); 250 } 251 252 void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) { 253 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)}; 254 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)}; 255 if (loopDir.v == llvm::acc::Directive::ACCD_loop) { 256 // Restriction - line 1818-1819 257 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, 258 loopOnlyAllowedAfterDeviceTypeClauses); 259 // Restriction - line 1834 260 CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq, 261 {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector, 262 llvm::acc::Clause::ACCC_worker}); 263 } 264 dirContext_.pop_back(); 265 } 266 267 void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) { 268 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)}; 269 PushContextAndClauseSets(standaloneDir.source, standaloneDir.v); 270 } 271 272 void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) { 273 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)}; 274 switch (standaloneDir.v) { 275 case llvm::acc::Directive::ACCD_enter_data: 276 case llvm::acc::Directive::ACCD_exit_data: 277 // Restriction - line 1310-1311 (ENTER DATA) 278 // Restriction - line 1312-1313 (EXIT DATA) 279 CheckRequireAtLeastOneOf(); 280 break; 281 case llvm::acc::Directive::ACCD_set: 282 // Restriction - line 2610 283 CheckRequireAtLeastOneOf(); 284 // Restriction - line 2602 285 CheckNotInComputeConstruct(); 286 break; 287 case llvm::acc::Directive::ACCD_update: 288 // Restriction - line 2636 289 CheckRequireAtLeastOneOf(); 290 // Restriction - line 2669 291 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, 292 updateOnlyAllowedAfterDeviceTypeClauses); 293 break; 294 case llvm::acc::Directive::ACCD_init: 295 case llvm::acc::Directive::ACCD_shutdown: 296 // Restriction - line 2525 (INIT) 297 // Restriction - line 2561 (SHUTDOWN) 298 CheckNotInComputeConstruct(); 299 break; 300 default: 301 break; 302 } 303 dirContext_.pop_back(); 304 } 305 306 void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) { 307 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine); 308 const auto &optName{std::get<std::optional<parser::Name>>(x.t)}; 309 if (!optName) { 310 const auto &verbatim{std::get<parser::Verbatim>(x.t)}; 311 const auto &scope{context_.FindScope(verbatim.source)}; 312 const Scope &containingScope{GetProgramUnitContaining(scope)}; 313 if (containingScope.kind() == Scope::Kind::Module) { 314 context_.Say(GetContext().directiveSource, 315 "ROUTINE directive without name must appear within the specification " 316 "part of a subroutine or function definition, or within an interface " 317 "body for a subroutine or function in an interface block"_err_en_US); 318 } 319 } 320 } 321 void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) { 322 // Restriction - line 2790 323 CheckRequireAtLeastOneOf(); 324 // Restriction - line 2788-2789 325 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, 326 routineOnlyAllowedAfterDeviceTypeClauses); 327 dirContext_.pop_back(); 328 } 329 330 void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) { 331 const auto &verbatim{std::get<parser::Verbatim>(x.t)}; 332 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_wait); 333 } 334 void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &x) { 335 dirContext_.pop_back(); 336 } 337 338 void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) { 339 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic); 340 } 341 void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) { 342 dirContext_.pop_back(); 343 } 344 345 void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) { 346 const parser::AssignmentStmt &assignment{ 347 std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement}; 348 const auto &var{std::get<parser::Variable>(assignment.t)}; 349 const auto &expr{std::get<parser::Expr>(assignment.t)}; 350 const auto *rhs{GetExpr(context_, expr)}; 351 const auto *lhs{GetExpr(context_, var)}; 352 if (lhs && rhs) { 353 if (lhs->Rank() != 0) 354 context_.Say(expr.source, 355 "LHS of atomic update statement must be scalar"_err_en_US); 356 if (rhs->Rank() != 0) 357 context_.Say(var.GetSource(), 358 "RHS of atomic update statement must be scalar"_err_en_US); 359 } 360 } 361 362 void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) { 363 const auto &verbatim = std::get<parser::Verbatim>(x.t); 364 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache); 365 SetContextDirectiveSource(verbatim.source); 366 if (loopNestLevel == 0) { 367 context_.Say(verbatim.source, 368 "The CACHE directive must be inside a loop"_err_en_US); 369 } 370 } 371 void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) { 372 dirContext_.pop_back(); 373 } 374 375 // Clause checkers 376 CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto) 377 CHECK_SIMPLE_CLAUSE(Async, ACCC_async) 378 CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach) 379 CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind) 380 CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture) 381 CHECK_SIMPLE_CLAUSE(Default, ACCC_default) 382 CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async) 383 CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete) 384 CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach) 385 CHECK_SIMPLE_CLAUSE(Device, ACCC_device) 386 CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num) 387 CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize) 388 CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate) 389 CHECK_SIMPLE_CLAUSE(Host, ACCC_host) 390 CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present) 391 CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent) 392 CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create) 393 CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost) 394 CHECK_SIMPLE_CLAUSE(Private, ACCC_private) 395 CHECK_SIMPLE_CLAUSE(Read, ACCC_read) 396 CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device) 397 CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait) 398 CHECK_SIMPLE_CLAUSE(Write, ACCC_write) 399 CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown) 400 401 void AccStructureChecker::CheckMultipleOccurrenceInDeclare( 402 const parser::AccObjectList &list, llvm::acc::Clause clause) { 403 if (GetContext().directive != llvm::acc::Directive::ACCD_declare) 404 return; 405 for (const auto &object : list.v) { 406 common::visit( 407 common::visitors{ 408 [&](const parser::Designator &designator) { 409 if (const auto *name = getDesignatorNameIfDataRef(designator)) { 410 if (declareSymbols.contains(&name->symbol->GetUltimate())) { 411 if (declareSymbols[&name->symbol->GetUltimate()] == clause) { 412 context_.Warn(common::UsageWarning::OpenAccUsage, 413 GetContext().clauseSource, 414 "'%s' in the %s clause is already present in the same clause in this module"_warn_en_US, 415 name->symbol->name(), 416 parser::ToUpperCaseLetters( 417 llvm::acc::getOpenACCClauseName(clause).str())); 418 } else { 419 context_.Say(GetContext().clauseSource, 420 "'%s' in the %s clause is already present in another " 421 "%s clause in this module"_err_en_US, 422 name->symbol->name(), 423 parser::ToUpperCaseLetters( 424 llvm::acc::getOpenACCClauseName(clause).str()), 425 parser::ToUpperCaseLetters( 426 llvm::acc::getOpenACCClauseName( 427 declareSymbols[&name->symbol->GetUltimate()]) 428 .str())); 429 } 430 } 431 declareSymbols.insert({&name->symbol->GetUltimate(), clause}); 432 } 433 }, 434 [&](const parser::Name &name) { 435 // TODO: check common block 436 }}, 437 object.u); 438 } 439 } 440 441 void AccStructureChecker::CheckMultipleOccurrenceInDeclare( 442 const parser::AccObjectListWithModifier &list, llvm::acc::Clause clause) { 443 const auto &objectList = std::get<Fortran::parser::AccObjectList>(list.t); 444 CheckMultipleOccurrenceInDeclare(objectList, clause); 445 } 446 447 void AccStructureChecker::Enter(const parser::AccClause::Create &c) { 448 CheckAllowed(llvm::acc::Clause::ACCC_create); 449 const auto &modifierClause{c.v}; 450 if (const auto &modifier{ 451 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) { 452 if (modifier->v != parser::AccDataModifier::Modifier::Zero) { 453 context_.Say(GetContext().clauseSource, 454 "Only the ZERO modifier is allowed for the %s clause " 455 "on the %s directive"_err_en_US, 456 parser::ToUpperCaseLetters( 457 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create) 458 .str()), 459 ContextDirectiveAsFortran()); 460 } 461 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) { 462 context_.Say(GetContext().clauseSource, 463 "The ZERO modifier is not allowed for the %s clause " 464 "on the %s directive"_err_en_US, 465 parser::ToUpperCaseLetters( 466 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create) 467 .str()), 468 ContextDirectiveAsFortran()); 469 } 470 } 471 CheckMultipleOccurrenceInDeclare( 472 modifierClause, llvm::acc::Clause::ACCC_create); 473 } 474 475 void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) { 476 CheckAllowed(llvm::acc::Clause::ACCC_copyin); 477 const auto &modifierClause{c.v}; 478 if (const auto &modifier{ 479 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) { 480 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) { 481 return; 482 } 483 if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) { 484 context_.Say(GetContext().clauseSource, 485 "Only the READONLY modifier is allowed for the %s clause " 486 "on the %s directive"_err_en_US, 487 parser::ToUpperCaseLetters( 488 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin) 489 .str()), 490 ContextDirectiveAsFortran()); 491 } 492 } 493 CheckMultipleOccurrenceInDeclare( 494 modifierClause, llvm::acc::Clause::ACCC_copyin); 495 } 496 497 void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) { 498 CheckAllowed(llvm::acc::Clause::ACCC_copyout); 499 const auto &modifierClause{c.v}; 500 if (const auto &modifier{ 501 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) { 502 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) { 503 return; 504 } 505 if (modifier->v != parser::AccDataModifier::Modifier::Zero) { 506 context_.Say(GetContext().clauseSource, 507 "Only the ZERO modifier is allowed for the %s clause " 508 "on the %s directive"_err_en_US, 509 parser::ToUpperCaseLetters( 510 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout) 511 .str()), 512 ContextDirectiveAsFortran()); 513 } 514 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) { 515 context_.Say(GetContext().clauseSource, 516 "The ZERO modifier is not allowed for the %s clause " 517 "on the %s directive"_err_en_US, 518 parser::ToUpperCaseLetters( 519 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout) 520 .str()), 521 ContextDirectiveAsFortran()); 522 } 523 } 524 CheckMultipleOccurrenceInDeclare( 525 modifierClause, llvm::acc::Clause::ACCC_copyout); 526 } 527 528 void AccStructureChecker::Enter(const parser::AccClause::DeviceType &d) { 529 CheckAllowed(llvm::acc::Clause::ACCC_device_type); 530 if (GetContext().directive == llvm::acc::Directive::ACCD_set && 531 d.v.v.size() > 1) { 532 context_.Say(GetContext().clauseSource, 533 "The %s clause on the %s directive accepts only one value"_err_en_US, 534 parser::ToUpperCaseLetters( 535 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_device_type) 536 .str()), 537 ContextDirectiveAsFortran()); 538 } 539 ResetCrtGroup(); 540 } 541 542 void AccStructureChecker::Enter(const parser::AccClause::Seq &g) { 543 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_seq; 544 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) { 545 CheckMutuallyExclusivePerGroup(crtClause, 546 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses); 547 } 548 CheckAllowed(crtClause); 549 } 550 551 void AccStructureChecker::Enter(const parser::AccClause::Vector &g) { 552 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_vector; 553 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) { 554 CheckMutuallyExclusivePerGroup(crtClause, 555 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses); 556 } 557 CheckAllowed(crtClause); 558 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) { 559 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type); 560 } 561 } 562 563 void AccStructureChecker::Enter(const parser::AccClause::Worker &g) { 564 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_worker; 565 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) { 566 CheckMutuallyExclusivePerGroup(crtClause, 567 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses); 568 } 569 CheckAllowed(crtClause); 570 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) { 571 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type); 572 } 573 } 574 575 void AccStructureChecker::Enter(const parser::AccClause::Tile &g) { 576 CheckAllowed(llvm::acc::Clause::ACCC_tile); 577 CheckAllowedOncePerGroup( 578 llvm::acc::Clause::ACCC_tile, llvm::acc::Clause::ACCC_device_type); 579 } 580 581 void AccStructureChecker::Enter(const parser::AccClause::Gang &g) { 582 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_gang; 583 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) { 584 CheckMutuallyExclusivePerGroup(crtClause, 585 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses); 586 } 587 CheckAllowed(crtClause); 588 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) { 589 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type); 590 } 591 592 if (g.v) { 593 bool hasNum = false; 594 bool hasDim = false; 595 bool hasStatic = false; 596 const Fortran::parser::AccGangArgList &x = *g.v; 597 for (const Fortran::parser::AccGangArg &gangArg : x.v) { 598 if (std::get_if<Fortran::parser::AccGangArg::Num>(&gangArg.u)) { 599 hasNum = true; 600 } else if (std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) { 601 hasDim = true; 602 } else if (std::get_if<Fortran::parser::AccGangArg::Static>(&gangArg.u)) { 603 hasStatic = true; 604 } 605 } 606 607 if (GetContext().directive == llvm::acc::Directive::ACCD_routine && 608 (hasStatic || hasNum)) { 609 context_.Say(GetContext().clauseSource, 610 "Only the dim argument is allowed on the %s clause on the %s directive"_err_en_US, 611 parser::ToUpperCaseLetters( 612 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_gang) 613 .str()), 614 ContextDirectiveAsFortran()); 615 } 616 617 if (hasDim && hasNum) { 618 context_.Say(GetContext().clauseSource, 619 "The num argument is not allowed when dim is specified"_err_en_US); 620 } 621 } 622 } 623 624 void AccStructureChecker::Enter(const parser::AccClause::NumGangs &n) { 625 CheckAllowed(llvm::acc::Clause::ACCC_num_gangs, 626 /*warnInsteadOfError=*/GetContext().directive == 627 llvm::acc::Directive::ACCD_serial || 628 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop); 629 CheckAllowedOncePerGroup( 630 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_device_type); 631 632 if (n.v.size() > 3) 633 context_.Say(GetContext().clauseSource, 634 "NUM_GANGS clause accepts a maximum of 3 arguments"_err_en_US); 635 } 636 637 void AccStructureChecker::Enter(const parser::AccClause::NumWorkers &n) { 638 CheckAllowed(llvm::acc::Clause::ACCC_num_workers, 639 /*warnInsteadOfError=*/GetContext().directive == 640 llvm::acc::Directive::ACCD_serial || 641 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop); 642 CheckAllowedOncePerGroup( 643 llvm::acc::Clause::ACCC_num_workers, llvm::acc::Clause::ACCC_device_type); 644 } 645 646 void AccStructureChecker::Enter(const parser::AccClause::VectorLength &n) { 647 CheckAllowed(llvm::acc::Clause::ACCC_vector_length, 648 /*warnInsteadOfError=*/GetContext().directive == 649 llvm::acc::Directive::ACCD_serial || 650 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop); 651 CheckAllowedOncePerGroup(llvm::acc::Clause::ACCC_vector_length, 652 llvm::acc::Clause::ACCC_device_type); 653 } 654 655 void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) { 656 CheckAllowed(llvm::acc::Clause::ACCC_reduction); 657 658 // From OpenACC 3.3 659 // At a minimum, the supported data types include Fortran logical as well as 660 // the numerical data types (e.g. integer, real, double precision, complex). 661 // However, for each reduction operator, the supported data types include only 662 // the types permitted as operands to the corresponding operator in the base 663 // language where (1) for max and min, the corresponding operator is less-than 664 // and (2) for other operators, the operands and the result are the same type. 665 // 666 // The following check that the reduction operator is supported with the given 667 // type. 668 const parser::AccObjectListWithReduction &list{reduction.v}; 669 const auto &op{std::get<parser::ReductionOperator>(list.t)}; 670 const auto &objects{std::get<parser::AccObjectList>(list.t)}; 671 672 for (const auto &object : objects.v) { 673 common::visit( 674 common::visitors{ 675 [&](const parser::Designator &designator) { 676 if (const auto *name = getDesignatorNameIfDataRef(designator)) { 677 if (name->symbol) { 678 const auto *type{name->symbol->GetType()}; 679 if (type->IsNumeric(TypeCategory::Integer) && 680 !reductionIntegerSet.test(op.v)) { 681 context_.Say(GetContext().clauseSource, 682 "reduction operator not supported for integer type"_err_en_US); 683 } else if (type->IsNumeric(TypeCategory::Real) && 684 !reductionRealSet.test(op.v)) { 685 context_.Say(GetContext().clauseSource, 686 "reduction operator not supported for real type"_err_en_US); 687 } else if (type->IsNumeric(TypeCategory::Complex) && 688 !reductionComplexSet.test(op.v)) { 689 context_.Say(GetContext().clauseSource, 690 "reduction operator not supported for complex type"_err_en_US); 691 } else if (type->category() == 692 Fortran::semantics::DeclTypeSpec::Category::Logical && 693 !reductionLogicalSet.test(op.v)) { 694 context_.Say(GetContext().clauseSource, 695 "reduction operator not supported for logical type"_err_en_US); 696 } 697 // TODO: check composite type. 698 } 699 } 700 }, 701 [&](const Fortran::parser::Name &name) { 702 // TODO: check common block 703 }}, 704 object.u); 705 } 706 } 707 708 void AccStructureChecker::Enter(const parser::AccClause::Self &x) { 709 CheckAllowed(llvm::acc::Clause::ACCC_self); 710 const std::optional<parser::AccSelfClause> &accSelfClause = x.v; 711 if (GetContext().directive == llvm::acc::Directive::ACCD_update && 712 ((accSelfClause && 713 std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>( 714 (*accSelfClause).u)) || 715 !accSelfClause)) { 716 context_.Say(GetContext().clauseSource, 717 "SELF clause on the %s directive must have a var-list"_err_en_US, 718 ContextDirectiveAsFortran()); 719 } else if (GetContext().directive != llvm::acc::Directive::ACCD_update && 720 accSelfClause && 721 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) { 722 const auto &accObjectList = 723 std::get<parser::AccObjectList>((*accSelfClause).u); 724 if (accObjectList.v.size() != 1) { 725 context_.Say(GetContext().clauseSource, 726 "SELF clause on the %s directive only accepts optional scalar logical" 727 " expression"_err_en_US, 728 ContextDirectiveAsFortran()); 729 } 730 } 731 } 732 733 void AccStructureChecker::Enter(const parser::AccClause::Collapse &x) { 734 CheckAllowed(llvm::acc::Clause::ACCC_collapse); 735 CheckAllowedOncePerGroup( 736 llvm::acc::Clause::ACCC_collapse, llvm::acc::Clause::ACCC_device_type); 737 const parser::AccCollapseArg &accCollapseArg = x.v; 738 const auto &collapseValue{ 739 std::get<parser::ScalarIntConstantExpr>(accCollapseArg.t)}; 740 RequiresConstantPositiveParameter( 741 llvm::acc::Clause::ACCC_collapse, collapseValue); 742 } 743 744 void AccStructureChecker::Enter(const parser::AccClause::Present &x) { 745 CheckAllowed(llvm::acc::Clause::ACCC_present); 746 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_present); 747 } 748 749 void AccStructureChecker::Enter(const parser::AccClause::Copy &x) { 750 CheckAllowed(llvm::acc::Clause::ACCC_copy); 751 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_copy); 752 } 753 754 void AccStructureChecker::Enter(const parser::AccClause::Deviceptr &x) { 755 CheckAllowed(llvm::acc::Clause::ACCC_deviceptr); 756 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_deviceptr); 757 } 758 759 void AccStructureChecker::Enter(const parser::AccClause::DeviceResident &x) { 760 CheckAllowed(llvm::acc::Clause::ACCC_device_resident); 761 CheckMultipleOccurrenceInDeclare( 762 x.v, llvm::acc::Clause::ACCC_device_resident); 763 } 764 765 void AccStructureChecker::Enter(const parser::AccClause::Link &x) { 766 CheckAllowed(llvm::acc::Clause::ACCC_link); 767 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link); 768 } 769 770 void AccStructureChecker::Enter(const parser::AccClause::Shortloop &x) { 771 if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop)) { 772 context_.Warn(common::UsageWarning::OpenAccUsage, GetContext().clauseSource, 773 "Non-standard shortloop clause ignored"_warn_en_US); 774 } 775 } 776 777 void AccStructureChecker::Enter(const parser::AccClause::If &x) { 778 CheckAllowed(llvm::acc::Clause::ACCC_if); 779 if (const auto *expr{GetExpr(x.v)}) { 780 if (auto type{expr->GetType()}) { 781 if (type->category() == TypeCategory::Integer || 782 type->category() == TypeCategory::Logical) { 783 return; // LOGICAL and INTEGER type supported for the if clause. 784 } 785 } 786 } 787 context_.Say( 788 GetContext().clauseSource, "Must have LOGICAL or INTEGER type"_err_en_US); 789 } 790 791 void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) { 792 context_.Warn(common::UsageWarning::OpenAccUsage, x.source, 793 "Misplaced OpenACC end directive"_warn_en_US); 794 } 795 796 void AccStructureChecker::Enter(const parser::Module &) { 797 declareSymbols.clear(); 798 } 799 800 void AccStructureChecker::Enter(const parser::FunctionSubprogram &x) { 801 declareSymbols.clear(); 802 } 803 804 void AccStructureChecker::Enter(const parser::SubroutineSubprogram &) { 805 declareSymbols.clear(); 806 } 807 808 void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) { 809 declareSymbols.clear(); 810 } 811 812 void AccStructureChecker::Enter(const parser::DoConstruct &) { 813 ++loopNestLevel; 814 } 815 816 void AccStructureChecker::Leave(const parser::DoConstruct &) { 817 --loopNestLevel; 818 } 819 820 llvm::StringRef AccStructureChecker::getDirectiveName( 821 llvm::acc::Directive directive) { 822 return llvm::acc::getOpenACCDirectiveName(directive); 823 } 824 825 llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) { 826 return llvm::acc::getOpenACCClauseName(clause); 827 } 828 829 } // namespace Fortran::semantics 830