[flang][acc] Add a semantic check for the validity of nested parallelism

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

@@ -6,6 +6,7 @@
 //
 //===----------------------------------------------------------------------===//
 #include "check-acc-structure.h"
+#include "resolve-names-utils.h"
 #include "flang/Common/enum-set.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/parse-tree.h"
@@ -106,18 +107,25 @@ bool AccStructureChecker::IsComputeConstruct(
       directive == llvm::acc::ACCD_kernels_loop;
 }
 
-bool AccStructureChecker::IsInsideComputeConstruct() const {
-  if (dirContext_.size() <= 1) {
-    return false;
-  }
+bool AccStructureChecker::IsLoopConstruct(
+    llvm::acc::Directive directive) const {
+  return directive == llvm::acc::Directive::ACCD_loop ||
+      directive == llvm::acc::ACCD_parallel_loop ||
+      directive == llvm::acc::ACCD_serial_loop ||
+      directive == llvm::acc::ACCD_kernels_loop;
+}
 
+std::optional<llvm::acc::Directive>
+AccStructureChecker::getParentComputeConstruct() const {
   // 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;
+  for (std::size_t i = dirContext_.size() - 1; i > 0; --i)
+    if (IsComputeConstruct(dirContext_[i - 1].directive))
+      return dirContext_[i - 1].directive;
+  return std::nullopt;
+}
+
+bool AccStructureChecker::IsInsideComputeConstruct() const {
+  return getParentComputeConstruct().has_value();
 }
 
 void AccStructureChecker::CheckNotInComputeConstruct() {
@@ -128,6 +136,14 @@ void AccStructureChecker::CheckNotInComputeConstruct() {
   }
 }
 
+bool AccStructureChecker::IsInsideParallelConstruct() const {
+  if (auto directive = getParentComputeConstruct())
+    if (*directive == llvm::acc::ACCD_parallel ||
+        *directive == llvm::acc::ACCD_parallel_loop)
+      return true;
+  return false;
+}
+
 void AccStructureChecker::Enter(const parser::AccClause &x) {
   SetContextClause(x);
 }
@@ -250,6 +266,85 @@ void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) {
   dirContext_.pop_back();
 }
 
+std::optional<std::int64_t> AccStructureChecker::getGangDimensionSize(
+    DirectiveContext &dirContext) {
+  for (auto it : dirContext.clauseInfo) {
+    const auto *clause{it.second};
+    if (const auto *gangClause{
+            std::get_if<parser::AccClause::Gang>(&clause->u)})
+      if (gangClause->v) {
+        const Fortran::parser::AccGangArgList &x{*gangClause->v};
+        for (const Fortran::parser::AccGangArg &gangArg : x.v)
+          if (const auto *dim{
+                  std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)})
+            if (const auto v{EvaluateInt64(context_, dim->v)})
+              return *v;
+      }
+  }
+  return std::nullopt;
+}
+
+void AccStructureChecker::CheckNotInSameOrSubLevelLoopConstruct() {
+  for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
+    auto &parent{dirContext_[i - 1]};
+    if (IsLoopConstruct(parent.directive)) {
+      for (auto parentClause : parent.actualClauses) {
+        for (auto cl : GetContext().actualClauses) {
+          bool invalid{false};
+          if (parentClause == llvm::acc::Clause::ACCC_gang &&
+              cl == llvm::acc::Clause::ACCC_gang) {
+            if (IsInsideParallelConstruct()) {
+              auto parentDim = getGangDimensionSize(parent);
+              auto currentDim = getGangDimensionSize(GetContext());
+              std::int64_t parentDimNum = 1, currentDimNum = 1;
+              if (parentDim)
+                parentDimNum = *parentDim;
+              if (currentDim)
+                currentDimNum = *currentDim;
+              if (parentDimNum <= currentDimNum) {
+                std::string parentDimStr, currentDimStr;
+                if (parentDim)
+                  parentDimStr = "(dim:" + std::to_string(parentDimNum) + ")";
+                if (currentDim)
+                  currentDimStr = "(dim:" + std::to_string(currentDimNum) + ")";
+                context_.Say(GetContext().clauseSource,
+                    "%s%s clause is not allowed in the region of a loop with the %s%s clause"_err_en_US,
+                    parser::ToUpperCaseLetters(
+                        llvm::acc::getOpenACCClauseName(cl).str()),
+                    currentDimStr,
+                    parser::ToUpperCaseLetters(
+                        llvm::acc::getOpenACCClauseName(parentClause).str()),
+                    parentDimStr);
+                continue;
+              }
+            } else {
+              invalid = true;
+            }
+          } else if (parentClause == llvm::acc::Clause::ACCC_worker &&
+              (cl == llvm::acc::Clause::ACCC_gang ||
+                  cl == llvm::acc::Clause::ACCC_worker)) {
+            invalid = true;
+          } else if (parentClause == llvm::acc::Clause::ACCC_vector &&
+              (cl == llvm::acc::Clause::ACCC_gang ||
+                  cl == llvm::acc::Clause::ACCC_worker ||
+                  cl == llvm::acc::Clause::ACCC_vector)) {
+            invalid = true;
+          }
+          if (invalid)
+            context_.Say(GetContext().clauseSource,
+                "%s clause is not allowed in the region of a loop with the %s clause"_err_en_US,
+                parser::ToUpperCaseLetters(
+                    llvm::acc::getOpenACCClauseName(cl).str()),
+                parser::ToUpperCaseLetters(
+                    llvm::acc::getOpenACCClauseName(parentClause).str()));
+        }
+      }
+    }
+    if (IsComputeConstruct(parent.directive))
+      break;
+  }
+}
+
 void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {
   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
@@ -267,6 +362,8 @@ void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) {
     CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq,
         {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector,
             llvm::acc::Clause::ACCC_worker});
+    // Restriction - 2.9.2, 2.9.3, 2.9.4
+    CheckNotInSameOrSubLevelLoopConstruct();
   }
   dirContext_.pop_back();
 }

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

@@ -98,8 +98,14 @@ class AccStructureChecker
 
   bool CheckAllowedModifier(llvm::acc::Clause clause);
   bool IsComputeConstruct(llvm::acc::Directive directive) const;
+  bool IsLoopConstruct(llvm::acc::Directive directive) const;
+  std::optional<llvm::acc::Directive> getParentComputeConstruct() const;
   bool IsInsideComputeConstruct() const;
+  bool IsInsideParallelConstruct() const;
   void CheckNotInComputeConstruct();
+  std::optional<std::int64_t> getGangDimensionSize(
+      DirectiveContext &dirContext);
+  void CheckNotInSameOrSubLevelLoopConstruct();
   void CheckMultipleOccurrenceInDeclare(
       const parser::AccObjectList &, llvm::acc::Clause);
   void CheckMultipleOccurrenceInDeclare(

flang/test/Semantics/OpenACC/acc-loop.f90

@@ -13,7 +13,7 @@ program openacc_loop_validity
     integer :: n
   end type atype
 
-  integer :: i, j, k, b, gang_size, vector_size, worker_size
+  integer :: i, j, k, l, m, b, gang_size, vector_size, worker_size
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
@@ -259,6 +259,98 @@ program openacc_loop_validity
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !$acc loop gang
+  do i = 1, n
+    !$acc loop worker
+    do j = 1, n
+      !ERROR: GANG clause is not allowed in the region of a loop with the WORKER clause
+      !ERROR: GANG clause is not allowed in the region of a loop with the GANG clause
+      !$acc loop gang vector
+      do k = 1, i
+      end do
+    end do
+  end do
+  !$acc end parallel
+
+  !$acc parallel loop vector
+  do  i = 1, n
+    !ERROR: GANG clause is not allowed in the region of a loop with the VECTOR clause
+    !$acc loop gang
+    do j = 1, n
+      !ERROR: WORKER clause is not allowed in the region of a loop with the VECTOR clause
+      !$acc loop worker
+      do k = 1, i
+        !ERROR: VECTOR clause is not allowed in the region of a loop with the VECTOR clause
+        !$acc loop vector
+        do l = 1, 1
+        end do
+      end do
+    end do
+  end do
+  !$acc end parallel loop
+
+  !$acc kernels
+  do  i = 1, n
+    !$acc loop gang worker
+    do j = 1, n
+      !ERROR: WORKER clause is not allowed in the region of a loop with the WORKER clause
+      !$acc loop worker vector
+      do k = 1, i
+      end do
+    end do
+  end do
+  !$acc end kernels
+
+  !$acc parallel
+  !$acc loop gang(dim:1)
+  do i = 1, n
+    !ERROR: GANG(dim:1) clause is not allowed in the region of a loop with the GANG(dim:1) clause
+    !$acc loop gang(dim:1)
+    do j = 1, n
+      !ERROR: GANG(dim:2) clause is not allowed in the region of a loop with the GANG(dim:1) clause
+      !$acc loop gang(dim:2)
+      do k = 1, i
+        !ERROR: GANG(dim:3) clause is not allowed in the region of a loop with the GANG(dim:2) clause
+        !ERROR: GANG(dim:3) clause is not allowed in the region of a loop with the GANG(dim:1) clause
+        !$acc loop gang(dim:3)
+        do l = 1, 1
+          !ERROR: GANG(dim:3) clause is not allowed in the region of a loop with the GANG(dim:3) clause
+          !ERROR: GANG(dim:3) clause is not allowed in the region of a loop with the GANG(dim:2) clause
+          !ERROR: GANG(dim:3) clause is not allowed in the region of a loop with the GANG(dim:1) clause
+          !$acc loop gang(dim:3)
+          do m = 1, 1
+          end do
+        end do
+      end do
+    end do
+  end do
+  !$acc end parallel
+
+  !$acc parallel loop gang(dim:3)
+  do i = 1, n
+    !$acc loop gang(dim:2)
+    do j = 1, n
+      !$acc loop gang(dim:1) worker vector
+      do k = 1, i
+      end do
+    end do
+  end do
+  !$acc end parallel loop
+
+  !$acc kernels loop gang(dim:3)
+  do i = 1, n
+    !ERROR: GANG clause is not allowed in the region of a loop with the GANG clause
+    !$acc loop gang(dim:2)
+    do j = 1, n
+      !ERROR: GANG clause is not allowed in the region of a loop with the GANG clause
+      !$acc loop gang(dim:1) worker vector
+      do k = 1, i
+      end do
+    end do
+  end do
+  !$acc end kernels loop
+
   !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the PARALLEL directive
   !$acc parallel device_type(*) if(.TRUE.)
   !$acc loop