[flang][openacc] Avoid use of init, shutdown and set in compute construct

[clementval]

Summary

init, shutdown and set directive are not allowed in compute construct.

[SouraVX]

LGTM, Thanks!

flang/lib/Semantics/check-acc-structure.cpp

71

NIT: Period at the end of comment.

[clementval]

Rebase + nit

flang/lib/Semantics/check-acc-structure.h

#include "llvm/Frontend/OpenACC/ACC.cpp.inc"
   void Enter(const parser::AccClause::VectorLength &);
   void Enter(const parser::AccClause::Wait &);
   void Enter(const parser::AccClause::Worker &);
   void Enter(const parser::AccClause::Write &);
 
 private:
 
   bool CheckAllowedModifier(llvm::acc::Clause clause);
+  bool IsComputeConstruct(llvm::acc::Directive directive) const;
+  bool IsInsideComputeConstruct() const;
+  void CheckNotInComputeConstruct();
   llvm::StringRef getClauseName(llvm::acc::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::acc::Directive directive) override;
 };
 
 } // namespace Fortran::semantics
 
 #endif // FORTRAN_SEMANTICS_CHECK_ACC_STRUCTURE_H_

flang/lib/Semantics/check-acc-structure.cpp

context_.Say(GetContext().clauseSource,
         "on the %s directive"_err_en_US,
         parser::ToUpperCaseLetters(getClauseName(clause).str()),
         ContextDirectiveAsFortran());
     return true;
   }
   return false;
 }
 
+bool AccStructureChecker::IsComputeConstruct(
+    llvm::acc::Directive directive) const {
+  return directive == llvm::acc::ACCD_parallel ||
+      directive == llvm::acc::ACCD_parallel_loop ||
+      directive == llvm::acc::ACCD_serial ||
+      directive == llvm::acc::ACCD_serial_loop ||
+      directive == llvm::acc::ACCD_kernels ||
+      directive == llvm::acc::ACCD_kernels_loop;
+}
+
+bool AccStructureChecker::IsInsideComputeConstruct() const {
+  if (dirContext_.size() <= 1)
+    return false;
+
+  // Check all nested context skipping the first one.
+  for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
+    if (IsComputeConstruct(dirContext_[i - 1].directive))
+      return true;
+  }
+  return false;
+}
+
+void AccStructureChecker::CheckNotInComputeConstruct() {
+  if (IsInsideComputeConstruct())
+    context_.Say(GetContext().directiveSource,
+        "Directive %s may not be called within a compute region"_err_en_US,
+        ContextDirectiveAsFortran());
+}
+
 void AccStructureChecker::Enter(const parser::AccClause &x) {
   SetContextClause(x);
 }
 
 void AccStructureChecker::Leave(const parser::AccClauseList &) {}
 
 void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) {
   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) {
   PushContextAndClauseSets(standaloneDir.source, standaloneDir.v);
 }
 
 void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
   switch (standaloneDir.v) {
   case llvm::acc::Directive::ACCD_enter_data:
   case llvm::acc::Directive::ACCD_exit_data:
-  case llvm::acc::Directive::ACCD_set:
     // Restriction - line 1310-1311 (ENTER DATA)
     // Restriction - line 1312-1313 (EXIT DATA)
-    // Restriction - line 2610 (SET)
     CheckRequireAtLeastOneOf();
     break;
+  case llvm::acc::Directive::ACCD_set:
+    // Restriction - line 2610
+    CheckRequireAtLeastOneOf();
+    // Restriction - line 2602
+    CheckNotInComputeConstruct();
+    break;
   case llvm::acc::Directive::ACCD_update:
     // Restriction - line 2636
     CheckRequireAtLeastOneOf();
     // Restriction - line 2669
     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
         updateOnlyAllowedAfterDeviceTypeClauses);
     break;
+  case llvm::acc::Directive::ACCD_init:
+  case llvm::acc::Directive::ACCD_shutdown:
+    // Restriction - line 2525 (INIT)
+    // Restriction - line 2561 (SHUTDOWN)
+    CheckNotInComputeConstruct();
+    break;
   default:
     break;
   }
   dirContext_.pop_back();
 }
 
 void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) {
   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine);

flang/test/Semantics/acc-clause-validity.f90

program openacc_clause_validity
   !$acc init if(.TRUE.)
   !$acc init if(ifCondition)
   !$acc init device_num(1)
   !$acc init device_num(i)
   !$acc init device_type(i)
   !$acc init device_type(2, i, j)
   !$acc init device_num(i) device_type(i, j) if(ifCondition)
 
+  !$acc parallel
+  !ERROR: Directive INIT may not be called within a compute region
+  !$acc init
+  !$acc end parallel
+
+  !$acc serial
+  !ERROR: Directive INIT may not be called within a compute region
+  !$acc init
+  !$acc end serial
+
+  !$acc kernels
+  !ERROR: Directive INIT may not be called within a compute region
+  !$acc init
+  !$acc end kernels
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+  !$acc end parallel
+
+  !$acc serial
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+  !$acc end serial
+
+  !$acc kernels
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+  !$acc end kernels
+
+  !$acc parallel loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+
+  !$acc serial loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+
+  !$acc kernels loop
+  do i = 1, N
+    !ERROR: Directive INIT may not be called within a compute region
+    !$acc init
+    a(i) = 3.14
+  end do
+
+  !$acc parallel
+  !ERROR: Directive SHUTDOWN may not be called within a compute region
+  !$acc shutdown
+  !$acc end parallel
+
+  !$acc serial
+  !ERROR: Directive SHUTDOWN may not be called within a compute region
+  !$acc shutdown
+  !$acc end serial
+
+  !$acc kernels
+  !ERROR: Directive SHUTDOWN may not be called within a compute region
+  !$acc shutdown
+  !$acc end kernels
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+  !$acc end parallel
+
+  !$acc serial
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+  !$acc end serial
+
+  !$acc kernels
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+  !$acc end kernels
+
+  !$acc parallel loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+
+  !$acc serial loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+
+  !$acc kernels loop
+  do i = 1, N
+    !ERROR: Directive SHUTDOWN may not be called within a compute region
+    !$acc shutdown
+    a(i) = 3.14
+  end do
+
+  !$acc parallel
+  !ERROR: Directive SET may not be called within a compute region
+  !$acc set default_async(i)
+  !$acc end parallel
+
+  !$acc serial
+  !ERROR: Directive SET may not be called within a compute region
+  !$acc set default_async(i)
+  !$acc end serial
+
+  !$acc kernels
+  !ERROR: Directive SET may not be called within a compute region
+  !$acc set default_async(i)
+  !$acc end kernels
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+  !$acc end parallel
+
+  !$acc serial
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+  !$acc end serial
+
+  !$acc kernels
+  !$acc loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+  !$acc end kernels
+
+  !$acc parallel loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+
+  !$acc serial loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+
+  !$acc kernels loop
+  do i = 1, N
+    !ERROR: Directive SET may not be called within a compute region
+    !$acc set default_async(i)
+    a(i) = 3.14
+  end do
+
   !ERROR: At least one of DEFAULT_ASYNC, DEVICE_NUM, DEVICE_TYPE clause must appear on the SET directive
   !$acc set
 
   !ERROR: At least one of DEFAULT_ASYNC, DEVICE_NUM, DEVICE_TYPE clause must appear on the SET directive
   !$acc set if(.TRUE.)
 
   !ERROR: At most one DEFAULT_ASYNC clause can appear on the SET directive
   !$acc set default_async(2) default_async(1)