flang/lib/Semantics/check-acc-structure.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-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