[flang][openacc] Enforce delcare directive restriction

[clementval]

Summary

Add semantic check for most of the restrictions for the declare directive.

[clementval]

Remove useless code

[sameeranjoshi]

Thanks for the patch.
A few comments below.

I came to know quite a few new things from Flang code base.

• How to check scoping.
• Given an ObjectList or similar representation how to extract symbol and use interfaces from tools.h.

flang/lib/Semantics/resolve-directives.cpp

116–117

Trying to understand- not a blocking review comment.
The Walk should be handled in some tree-visitor files and not here, is my understanding correct?

484

Possibly a bug.
Is this Copyout ?

504

I see in my OACC 3.1 copy create clause as one of them in the list.
Is this missing to add over here with a test below ?

513

Do you need somewhere the index into standard for this?
2414 from 3.1 spec.

514

Are checks from line 2410-2411 and 2412-2413 from OACC 3.1 missing or are handled somewhere else in previous patches ?

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

54–56

Any plans to add these ?
Until then can you add a TODO or remove them?

[clementval]

Rebase + address review comment

[clementval]

Thanks for the review. Did not see it before for some reason. I made some update to the patch.

flang/lib/Semantics/resolve-directives.cpp

116–117

Yeah the Walk is already handled by the Visitor class inherited by the DirectiveAttributeVisitor

484

Good catch!

504

Added it.

514

Those are not yet implemented and will be done in a separate patch.

[kiranktp]

LGTM

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

 
 void AccStructureChecker::Enter(
     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
   const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
   PushContextAndClauseSets(declarativeDir.source, declarativeDir.v);
 }
 
 void AccStructureChecker::Leave(
-    const parser::OpenACCStandaloneDeclarativeConstruct &) {
+    const parser::OpenACCStandaloneDeclarativeConstruct &x) {
   // Restriction - line 2409
   CheckAtLeastOneClause();
+
+  // Restriction - line 2417-2418 - In a Fortran module declaration section,
+  // only create, copyin, device_resident, and link clauses are allowed.
+  const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
+  const auto &scope{context_.FindScope(declarativeDir.source)};
+  const Scope &containingScope{GetProgramUnitContaining(scope)};
+  if (containingScope.kind() == Scope::Kind::Module) {
+    for (auto cl : GetContext().actualClauses) {
+      if (cl != llvm::acc::Clause::ACCC_create &&
+          cl != llvm::acc::Clause::ACCC_copyin &&
+          cl != llvm::acc::Clause::ACCC_device_resident &&
+          cl != llvm::acc::Clause::ACCC_link)
+        context_.Say(GetContext().directiveSource,
+            "%s clause is not allowed on the %s directive in module "
+            "declaration "
+            "section"_err_en_US,
+            parser::ToUpperCaseLetters(
+                llvm::acc::getOpenACCClauseName(cl).str()),
+            ContextDirectiveAsFortran());
+    }
+  }
   dirContext_.pop_back();
 }
 
 void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) {
   const auto &beginCombinedDir{
       std::get<parser::AccBeginCombinedDirective>(x.t)};
   const auto &combinedDir{
       std::get<parser::AccCombinedDirective>(beginCombinedDir.t)};

flang/lib/Semantics/resolve-directives.cpp

 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
 public:
   explicit AccAttributeVisitor(SemanticsContext &context)
       : DirectiveAttributeVisitor(context) {}
 
   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
 
   bool Pre(const parser::OpenACCBlockConstruct &);
   void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
   bool Pre(const parser::OpenACCCombinedConstruct &);
   void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenACCDeclarativeConstruct &);
   void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenACCRoutineConstruct &);
   bool Pre(const parser::AccBindClause &);
+  void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);
 
   void Post(const parser::AccBeginBlockDirective &) {
     GetContext().withinConstruct = true;
   }
 
   bool Pre(const parser::OpenACCLoopConstruct &);
   void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
   void Post(const parser::AccLoopDirective &) {
private:
   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
   Symbol *ResolveName(const parser::Name &);
   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);
+  void DoNotAllowAssumedSizedArray(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) {}
 
PushContext(declDir.source, llvm::acc::Directive::ACCD_declare);
                  std::get_if<parser::OpenACCRoutineConstruct>(&x.u)}) {
     const auto &verbatim{std::get<parser::Verbatim>(routineConstruct->t)};
     PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine);
   }
   ClearDataSharingAttributeObjects();
   return true;
 }
 
+static const parser::AccObjectList &GetAccObjectList(
+    const parser::AccClause &clause) {
+  if (const auto *copyClause =
+          std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {
+    return copyClause->v;
+  } else if (const auto *createClause =
+                 std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {
+    const Fortran::parser::AccObjectListWithModifier &listWithModifier =
+        createClause->v;
+    const Fortran::parser::AccObjectList &accObjectList =
+        std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
+    return accObjectList;
+  } else if (const auto *copyinClause =
+                 std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {
+    const Fortran::parser::AccObjectListWithModifier &listWithModifier =
+        copyinClause->v;
+    const Fortran::parser::AccObjectList &accObjectList =
+        std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
+    return accObjectList;
+  } else if (const auto *copyoutClause =
+                 std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) {
+    const Fortran::parser::AccObjectListWithModifier &listWithModifier =
+        copyoutClause->v;
+    const Fortran::parser::AccObjectList &accObjectList =
+        std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
+    return accObjectList;
+  } else if (const auto *presentClause =
+                 std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) {
+    return presentClause->v;
+  } else if (const auto *deviceptrClause =
+                 std::get_if<Fortran::parser::AccClause::Deviceptr>(
+                     &clause.u)) {
+    return deviceptrClause->v;
+  } else if (const auto *deviceResidentClause =
+                 std::get_if<Fortran::parser::AccClause::DeviceResident>(
+                     &clause.u)) {
+    return deviceResidentClause->v;
+  } else if (const auto *linkClause =
+                 std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {
+    return linkClause->v;
+  } else {
+    llvm_unreachable("Clause without object list!");
+  }
+}
+
+void AccAttributeVisitor::Post(
+    const parser::OpenACCStandaloneDeclarativeConstruct &x) {
+  const auto &clauseList = std::get<parser::AccClauseList>(x.t);
+  for (const auto &clause : clauseList.v) {
+    // Restriction - line 2414
+    DoNotAllowAssumedSizedArray(GetAccObjectList(clause));
+  }
+}
+
 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
   const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
     PushContext(loopDir.source, loopDir.v);
   }
   ClearDataSharingAttributeObjects();
std::visit(
                       llvm::acc::getOpenACCDirectiveName(GetContext().directive)
                           .str()));
             },
         },
         accObject.u);
   }
 }
 
+void AccAttributeVisitor::DoNotAllowAssumedSizedArray(
+    const parser::AccObjectList &objectList) {
+  for (const auto &accObject : objectList.v) {
+    std::visit(
+        common::visitors{
+            [&](const parser::Designator &designator) {
+              const auto &name{GetLastName(designator)};
+              if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol))
+                context_.Say(designator.source,
+                    "Assumed-size dummy arrays may not appear on the %s "
+                    "directive"_err_en_US,
+                    parser::ToUpperCaseLetters(
+                        llvm::acc::getOpenACCDirectiveName(
+                            GetContext().directive)
+                            .str()));
+            },
+            [&](const auto &name) {
+
+            },
+        },
+        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 =

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 Serial
 !   2.5.3 Kernels
 !   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
program openacc_clause_validity
   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)
   !$acc init device_num(1)
   !$acc init device_num(i)
   !$acc init device_type(i)

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

+! RUN: %S/test_errors.sh %s %t %f18 -fopenacc
+
+! Check OpenACC clause validity for the following construct and directive:
+!   2.13 Declare
+
+module openacc_declare_validity
+
+  implicit none
+
+  real(8), dimension(10) :: aa, bb, ab, cc
+
+  !ERROR: At least one clause is required on the DECLARE directive
+  !$acc declare
+
+  !$acc declare create(aa, bb)
+
+  !$acc declare link(ab)
+
+  !$acc declare device_resident(cc)
+
+  !ERROR: COPYOUT clause is not allowed on the DECLARE directive in module declaration section
+  !$acc declare copyout(ab)
+
+  !ERROR: COPY clause is not allowed on the DECLARE directive in module declaration section
+  !$acc declare copy(ab)
+
+  !ERROR: PRESENT clause is not allowed on the DECLARE directive in module declaration section
+  !$acc declare present(ab)
+
+  !ERROR: DEVICEPTR clause is not allowed on the DECLARE directive in module declaration section
+  !$acc declare deviceptr(ab)
+
+contains
+
+  subroutine sub1(cc, dd)
+    real(8) :: cc(:)
+    real(8) :: dd(:)
+    !$acc declare present(cc, dd)
+  end subroutine sub1
+
+  function fct1(ee, ff, gg, hh, ii)
+    integer :: fct1
+    real(8), intent(in) :: ee(:)
+    !$acc declare copyin(readonly: ee)
+    real(8) :: ff(:), hh(:), ii(:,:)
+    !$acc declare link(hh) device_resident(ii)
+    real(8), intent(out) :: gg(:)
+    !$acc declare copy(ff) copyout(gg)
+  end function fct1
+
+  subroutine sub2(cc)
+    real(8), dimension(*) :: cc
+    !ERROR: Assumed-size dummy arrays may not appear on the DECLARE directive
+    !$acc declare present(cc)
+  end subroutine sub2
+
+end module openacc_declare_validity