[flang][openacc] Semantic check for cache directive

[clementval]

Summary

Add semantic check for the cache directive. According to section 2.10 from the specification:
A var in a cache directive must be a single array element or a simple subarray.

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

491–501

#just-saying: It will be useful if there is some general guidelines on when to use evaluate::DataRef.

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

665

Can you add one more test with arr(1:5)%s?

[clementval]

flang/lib/Semantics/resolve-directives.cpp

491–501

Sure, maybe adding something in the semantic check documentation would make sense. What do you think?

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

665

I added couple of tests in that sense arr(1:5)%s is not possible since arr and s are member of t at the same level.

[clementval]

Rebase + add couple of test cases

[kiranchandramohan]

LGTM.

flang/lib/Semantics/resolve-directives.cpp

491–501

Yes, that would be great.

[clementval]

flang/lib/Semantics/resolve-directives.cpp

491–501

Ok. Added on my todo list. I'll send this as a separate patch.

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

#include "llvm/Frontend/OpenACC/ACC.cpp.inc"
   void Enter(const parser::OpenACCStandaloneConstruct &);
   void Leave(const parser::OpenACCStandaloneConstruct &);
   void Enter(const parser::OpenACCStandaloneDeclarativeConstruct &);
   void Leave(const parser::OpenACCStandaloneDeclarativeConstruct &);
   void Enter(const parser::OpenACCWaitConstruct &);
   void Leave(const parser::OpenACCWaitConstruct &);
   void Enter(const parser::OpenACCAtomicConstruct &);
   void Leave(const parser::OpenACCAtomicConstruct &);
+  void Enter(const parser::OpenACCCacheConstruct &);
+  void Leave(const parser::OpenACCCacheConstruct &);
 
   // Clauses
   void Leave(const parser::AccClauseList &);
   void Enter(const parser::AccClause &);
 
   void Enter(const parser::AccClause::Auto &);
   void Enter(const parser::AccClause::Async &);
   void Enter(const parser::AccClause::Attach &);

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

 
 void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) {
   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic);
 }
 void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
   dirContext_.pop_back();
 }
 
+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);
+}
+void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {
+  dirContext_.pop_back();
+}
+
 // Clause checkers
 CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(Collapse, ACCC_collapse)
 
 CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto)
 CHECK_SIMPLE_CLAUSE(Async, ACCC_async)
 CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
 CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
 CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)

flang/lib/Semantics/resolve-directives.cpp

public:
   }
 
   bool Pre(const parser::OpenACCStandaloneConstruct &);
   void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
   void Post(const parser::AccStandaloneDirective &) {
     GetContext().withinConstruct = true;
   }
 
+  bool Pre(const parser::OpenACCCacheConstruct &);
+  void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
+
   void Post(const parser::AccDefaultClause &);
 
   bool Pre(const parser::AccClause::Copy &x) {
     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
     return false;
   }
 
private:
   void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
   Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
   Symbol *ResolveAccCommonBlockName(const parser::Name *);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
       const parser::Name &, const Symbol &, Symbol::Flag);
+  void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
 };
 
 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
 public:
   explicit OmpAttributeVisitor(SemanticsContext &context)
       : DirectiveAttributeVisitor(context) {}
 
bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
   PrivatizeAssociatedLoopIndex(x);
   return true;
 }
 
 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
   switch (standaloneDir.v) {
-  case llvm::acc::Directive::ACCD_cache:
   case llvm::acc::Directive::ACCD_enter_data:
   case llvm::acc::Directive::ACCD_exit_data:
   case llvm::acc::Directive::ACCD_init:
   case llvm::acc::Directive::ACCD_set:
   case llvm::acc::Directive::ACCD_shutdown:
   case llvm::acc::Directive::ACCD_update:
     PushContext(standaloneDir.source, standaloneDir.v);
     break;
case llvm::acc::Directive::ACCD_serial_loop:
     break;
   default:
     break;
   }
   ClearDataSharingAttributeObjects();
   return true;
 }
 
+static bool IsLastNameArray(const parser::Designator &designator) {
+  const auto &name{GetLastName(designator)};
+  const evaluate::DataRef dataRef{*(name.symbol)};
+  return std::visit(
+      common::visitors{
+          [](const evaluate::SymbolRef &ref) { return ref->Rank() > 0; },
+          [](const evaluate::ArrayRef &aref) {
+            return aref.base().IsSymbol() ||
+                aref.base().GetComponent().base().Rank() == 0;
+          },
+          [](const auto &) { return false; },
+      },
+      dataRef.u);
+}
+
+void AccAttributeVisitor::AllowOnlyArrayAndSubArray(
+    const parser::AccObjectList &objectList) {
+  for (const auto &accObject : objectList.v) {
+    std::visit(
+        common::visitors{
+            [&](const parser::Designator &designator) {
+              if (!IsLastNameArray(designator))
+                context_.Say(designator.source,
+                    "Only array element or subarray are allowed in %s directive"_err_en_US,
+                    parser::ToUpperCaseLetters(
+                        llvm::acc::getOpenACCDirectiveName(
+                            GetContext().directive)
+                            .str()));
+            },
+            [&](const auto &name) {
+              context_.Say(name.source,
+                  "Only array element or subarray are allowed in %s directive"_err_en_US,
+                  parser::ToUpperCaseLetters(
+                      llvm::acc::getOpenACCDirectiveName(GetContext().directive)
+                          .str()));
+            },
+        },
+        accObject.u);
+  }
+}
+
+bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
+  const auto &verbatim{std::get<parser::Verbatim>(x.t)};
+  PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
+  ClearDataSharingAttributeObjects();
+
+  const auto &objectListWithModifier =
+      std::get<parser::AccObjectListWithModifier>(x.t);
+  const auto &objectList =
+      std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);
+
+  // 2.10 Cache directive restriction: A var in a cache directive must be a
+  // single array element or a simple subarray.
+  AllowOnlyArrayAndSubArray(objectList);
+
+  return true;
+}
+
 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
     const parser::AccClauseList &x) {
   std::int64_t collapseLevel{0};
   for (const auto &clause : x.v) {
     if (const auto *collapseClause{
             std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
         collapseLevel = *v;

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

 ! RUN: %S/test_errors.sh %s %t %f18 -fopenacc
 
 ! Check OpenACC clause validity for the following construct and directive:
 !   2.6.5 Data
 !   2.5.1 Parallel
 !   2.5.2 Kernels
 !   2.5.3 Serial
 !   2.9 Loop
 !   2.12 Atomic
 !   2.13 Declare
 !   2.14.3 Set
 !   2.14.4 Update
 !   2.15.1 Routine
+!   2.10 Cache
 !   2.11 Parallel Loop
 !   2.11 Kernels Loop
 !   2.11 Serial Loop
 !   2.14.3 Set
 !   2.16.13 Wait
 
 program openacc_clause_validity
 
   implicit none
 
+  type atype
+    real(8), dimension(10) :: arr
+    real(8) :: s
+  end type atype
+
   integer :: i, j, b, gang_size, vector_size, worker_size
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
   logical :: ifCondition = .TRUE.
+  type(atype) :: t
+  type(atype), dimension(10) :: ta
 
   !ERROR: At least one clause is required on the DECLARE directive
   !$acc declare
   real(8), dimension(N) :: a, f, g, h
 
   !$acc init
   !$acc init if(.TRUE.)
   !$acc init if(ifCondition)
program openacc_clause_validity
   i = c(i)
   !$acc end atomic
 
   !$acc atomic capture
   c(i) = i
   i = i + 1
   !$acc end atomic
   !$acc end parallel
+  t%arr(i) = 2.0
+
+  !$acc cache(a(i))
+  !$acc cache(a(1:2,3:4))
+  !$acc cache(a)
+  !$acc cache(readonly: a, aa)
+  !$acc cache(readonly: a(i), aa(i, i))
+  !$acc cache(t%arr)
+  !$acc cache(ta(1:2)%arr)
+  !$acc cache(ta(1:2)%arr(1:4))
+
+  !ERROR: Only array element or subarray are allowed in CACHE directive
+  !$acc cache(ta(1:2)%s)
+
+  !ERROR: Only array element or subarray are allowed in CACHE directive
+  !$acc cache(i)
+
+  !ERROR: Only array element or subarray are allowed in CACHE directive
+  !$acc cache(t%s)
+
+  !ERROR: Only array element or subarray are allowed in CACHE directive
+  !$acc cache(/i/)
 
  contains
 
    subroutine sub1(a)
      real :: a(:)
      !ERROR: At least one of GANG, SEQ, VECTOR, WORKER clause must appear on the ROUTINE directive
      !$acc routine
    end subroutine sub1
 
    subroutine sub2(a)
      real :: a(:)
      !ERROR: Clause NOHOST is not allowed after clause DEVICE_TYPE on the ROUTINE directive
      !$acc routine seq device_type(*) nohost
    end subroutine sub2
 
 end program openacc_clause_validity