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

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

Reviewed By: SouraVX

Differential Revision: https://reviews.llvm.org/D92443

diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index c88e7f8..c120f9a 100644 (file)
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -54,6 +54,35 @@ bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) {
   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);
 }
@@ -175,12 +204,16 @@ void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
   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();
@@ -188,6 +221,12 @@ void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
     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;
   }

diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h
index 85f01ba..29d40b9 100644 (file)
--- a/flang/lib/Semantics/check-acc-structure.h
+++ b/flang/lib/Semantics/check-acc-structure.h
@@ -114,6 +114,9 @@ public:
 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;
 };

diff --git a/flang/test/Semantics/acc-clause-validity.f90 b/flang/test/Semantics/acc-clause-validity.f90
index 9931198..1f98d0f 100644 (file)
--- a/flang/test/Semantics/acc-clause-validity.f90
+++ b/flang/test/Semantics/acc-clause-validity.f90
@@ -53,6 +53,195 @@ program openacc_clause_validity
   !$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