initial commit

Author: akuhlens

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

@@ -89,30 +89,31 @@ 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) {
+bool AccStructureChecker::IsInsideDirectiveContext(
+    std::function<bool(llvm::acc::Directive)> pred, bool skipFirst) const {
+  std::size_t contextSize{dirContext_.size()};
+  std::size_t skipFirstOffset{skipFirst ? 1u : 0u};
+  // Short circuit if there are no contexts to check.
+  if (contextSize <= skipFirstOffset) {
     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)) {
+  // Check contexts from innermost to outermost.
+  for (std::size_t i{contextSize - skipFirstOffset}; i > 0u; --i) {
+    if (pred(dirContext_[i - 1].directive)) {
       return true;
     }
   }
   return false;
 }
 
+bool AccStructureChecker::IsInsideComputeConstruct() const {
+  return IsInsideDirectiveContext(IsComputeConstruct, /*skipFirst=*/true);
+}
+
+bool AccStructureChecker::IsInsideLoopConstruct() const {
+  return IsInsideDirectiveContext(IsLoopConstruct);
+}
+
 void AccStructureChecker::CheckNotInComputeConstruct() {
   if (IsInsideComputeConstruct()) {
     context_.Say(GetContext().directiveSource,
@@ -363,10 +364,28 @@ void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {
   const auto &verbatim = std::get<parser::Verbatim>(x.t);
   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);
   SetContextDirectiveSource(verbatim.source);
-  if (loopNestLevel == 0) {
+  if (loopNests.size() == 0) {
     context_.Say(verbatim.source,
           "The CACHE directive must be inside a loop"_err_en_US);
   }
+
+  for (std::size_t i{0}; i < loopNests.size(); i++) {
+    if (const parser::DoConstruct *doConstruct{loopNests[i]}) {
+      if (!doConstruct->GetLoopControl()) {
+        context_
+            .Say(std::get<parser::Statement<parser::NonLabelDoStmt>>(
+                     doConstruct->t)
+                     .source,
+                "DO loop with CACHE directive must have loop control"_err_en_US)
+            .Attach(verbatim.source,
+                "This CACHE directive implies a LOOP directive"_because_en_US);
+      }
+      // Remove the do construct from the loopNests vector after checking so
+      // that if there are multiple cache directives the loop isn't checked
+      // again.
+      loopNests[i] = nullptr;
+    }
+  }
 }
 void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {
   dirContext_.pop_back();
@@ -814,12 +833,19 @@ void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) {
   declareSymbols.clear();
 }
 
-void AccStructureChecker::Enter(const parser::DoConstruct &) {
-  ++loopNestLevel;
+void AccStructureChecker::Enter(const parser::DoConstruct &x) {
+  // If the current context is alread is an loop construct it has already been
+  // checked. Otherwise if there is a cache directive in the loop we will check
+  // to make sure it has a loop control clause.
+  if (IsInsideLoopConstruct()) {
+    loopNests.push_back(nullptr);
+  } else {
+    loopNests.push_back(&x);
+  }
 }
 
-void AccStructureChecker::Leave(const parser::DoConstruct &) {
-  --loopNestLevel;
+void AccStructureChecker::Leave(const parser::DoConstruct &x) {
+  loopNests.pop_back();
 }
 
 llvm::StringRef AccStructureChecker::getDirectiveName(

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

@@ -81,18 +81,31 @@ class AccStructureChecker
 
 private:
   bool CheckAllowedModifier(llvm::acc::Clause clause);
-  bool IsComputeConstruct(llvm::acc::Directive directive) const;
   bool IsInsideComputeConstruct() const;
+  bool IsInsideLoopConstruct() const;
+  bool IsInsideDirectiveContext(std::function<bool(llvm::acc::Directive)> pred,
+      bool skipFirst = false) const;
   void CheckNotInComputeConstruct();
   void CheckMultipleOccurrenceInDeclare(
       const parser::AccObjectList &, llvm::acc::Clause);
   void CheckMultipleOccurrenceInDeclare(
       const parser::AccObjectListWithModifier &, llvm::acc::Clause);
+  static bool IsComputeConstruct(llvm::acc::Directive directive) {
+    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;
+  }
+  static bool IsLoopConstruct(llvm::acc::Directive directive) {
+    return directive == llvm::acc::ACCD_loop;
+  }
   llvm::StringRef getClauseName(llvm::acc::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::acc::Directive directive) override;
 
   llvm::SmallDenseMap<Symbol *, llvm::acc::Clause> declareSymbols;
-  unsigned loopNestLevel = 0;
+  std::vector<const parser::DoConstruct *> loopNests;
 };
 
 } // namespace Fortran::semantics

flang/test/Semantics/OpenACC/acc-cache-validity.f90

@@ -43,4 +43,33 @@ program openacc_cache_validity
   !ERROR: The CACHE directive must be inside a loop
   !$acc cache(a)
 
+
+  !ERROR: DO loop with CACHE directive must have loop control
+  do
+    !BECAUSE: This CACHE directive implies a LOOP directive
+    !$acc cache(a)
+  end do
+
+  !ERROR: DO loop with CACHE directive must have loop control
+  do
+    do i = 1, N
+      !BECAUSE: This CACHE directive implies a LOOP directive
+      !$acc cache(a(i))
+    end do
+  end do
+
+  do i = 1, N
+    !ERROR: DO loop with CACHE directive must have loop control
+    do
+      !BECAUSE: This CACHE directive implies a LOOP directive
+      !$acc cache(a)
+    end do
+  end do
+
+  do i = 1, N
+    !$acc cache(a)
+    do
+    end do
+  end do
+
 end program openacc_cache_validity