[flang][openacc] Enforce restriction on declare directive

Enforce the following restriction specified in 2.13
A var may appear at most once in all the clauses of declare directives for a
function, subroutine, program, or module.

Reviewed By: razvanlupusoru

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

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

@@ -342,27 +342,22 @@ CHECK_SIMPLE_CLAUSE(Async, ACCC_async)
 CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
 CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
 CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)
-CHECK_SIMPLE_CLAUSE(Copy, ACCC_copy)
 CHECK_SIMPLE_CLAUSE(Default, ACCC_default)
 CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)
 CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)
 CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)
 CHECK_SIMPLE_CLAUSE(Device, ACCC_device)
 CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)
-CHECK_SIMPLE_CLAUSE(Deviceptr, ACCC_deviceptr)
-CHECK_SIMPLE_CLAUSE(DeviceResident, ACCC_device_resident)
 CHECK_SIMPLE_CLAUSE(DeviceType, ACCC_device_type)
 CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)
 CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)
 CHECK_SIMPLE_CLAUSE(Host, ACCC_host)
 CHECK_SIMPLE_CLAUSE(If, ACCC_if)
 CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)
 CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)
-CHECK_SIMPLE_CLAUSE(Link, ACCC_link)
 CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)
 CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)
 CHECK_SIMPLE_CLAUSE(NumWorkers, ACCC_num_workers)
-CHECK_SIMPLE_CLAUSE(Present, ACCC_present)
 CHECK_SIMPLE_CLAUSE(Private, ACCC_private)
 CHECK_SIMPLE_CLAUSE(Read, ACCC_read)
 CHECK_SIMPLE_CLAUSE(Seq, ACCC_seq)
@@ -375,6 +370,39 @@ CHECK_SIMPLE_CLAUSE(Worker, ACCC_worker)
 CHECK_SIMPLE_CLAUSE(Write, ACCC_write)
 CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)
 
+void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
+    const parser::AccObjectList &list, llvm::acc::Clause clause) {
+  if (GetContext().directive != llvm::acc::Directive::ACCD_declare)
+    return;
+  for (const auto &object : list.v) {
+    std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::parser::Designator &designator) {
+              if (const auto *name = getDesignatorNameIfDataRef(designator)) {
+                if (declareSymbols.contains(&name->symbol->GetUltimate())) {
+                  context_.Say(GetContext().clauseSource,
+                      "'%s' in the %s clause is already present in another "
+                      "clause in this module"_err_en_US,
+                      name->symbol->name(),
+                      parser::ToUpperCaseLetters(
+                          llvm::acc::getOpenACCClauseName(clause).str()));
+                }
+                declareSymbols.insert(&name->symbol->GetUltimate());
+              }
+            },
+            [&](const Fortran::parser::Name &name) {
+              // TODO: check common block
+            }},
+        object.u);
+  }
+}
+
+void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
+    const parser::AccObjectListWithModifier &list, llvm::acc::Clause clause) {
+  const auto &objectList = std::get<Fortran::parser::AccObjectList>(list.t);
+  CheckMultipleOccurrenceInDeclare(objectList, clause);
+}
+
 void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
   CheckAllowed(llvm::acc::Clause::ACCC_create);
   const auto &modifierClause{c.v};
@@ -399,6 +427,8 @@ void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
           ContextDirectiveAsFortran());
     }
   }
+  CheckMultipleOccurrenceInDeclare(
+      modifierClause, llvm::acc::Clause::ACCC_create);
 }
 
 void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
@@ -419,6 +449,8 @@ void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
           ContextDirectiveAsFortran());
     }
   }
+  CheckMultipleOccurrenceInDeclare(
+      modifierClause, llvm::acc::Clause::ACCC_copyin);
 }
 
 void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
@@ -448,6 +480,8 @@ void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
           ContextDirectiveAsFortran());
     }
   }
+  CheckMultipleOccurrenceInDeclare(
+      modifierClause, llvm::acc::Clause::ACCC_copyout);
 }
 
 void AccStructureChecker::Enter(const parser::AccClause::Gang &g) {
@@ -563,13 +597,55 @@ void AccStructureChecker::Enter(const parser::AccClause::Collapse &x) {
       llvm::acc::Clause::ACCC_collapse, collapseValue);
 }
 
-llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
-  return llvm::acc::getOpenACCClauseName(clause);
+void AccStructureChecker::Enter(const parser::AccClause::Present &x) {
+  CheckAllowed(llvm::acc::Clause::ACCC_present);
+  CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_present);
+}
+
+void AccStructureChecker::Enter(const parser::AccClause::Copy &x) {
+  CheckAllowed(llvm::acc::Clause::ACCC_copy);
+  CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_copy);
+}
+
+void AccStructureChecker::Enter(const parser::AccClause::Deviceptr &x) {
+  CheckAllowed(llvm::acc::Clause::ACCC_deviceptr);
+  CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_deviceptr);
+}
+
+void AccStructureChecker::Enter(const parser::AccClause::DeviceResident &x) {
+  CheckAllowed(llvm::acc::Clause::ACCC_device_resident);
+  CheckMultipleOccurrenceInDeclare(
+      x.v, llvm::acc::Clause::ACCC_device_resident);
+}
+
+void AccStructureChecker::Enter(const parser::AccClause::Link &x) {
+  CheckAllowed(llvm::acc::Clause::ACCC_link);
+  CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link);
+}
+
+void AccStructureChecker::Enter(const parser::Module &) {
+  declareSymbols.clear();
+}
+
+void AccStructureChecker::Enter(const parser::FunctionSubprogram &x) {
+  declareSymbols.clear();
+}
+
+void AccStructureChecker::Enter(const parser::SubroutineSubprogram &) {
+  declareSymbols.clear();
+}
+
+void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) {
+  declareSymbols.clear();
 }
 
 llvm::StringRef AccStructureChecker::getDirectiveName(
     llvm::acc::Directive directive) {
   return llvm::acc::getOpenACCDirectiveName(directive);
 }
 
+llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
+  return llvm::acc::getOpenACCClauseName(clause);
+}
+
 } // namespace Fortran::semantics

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

@@ -18,6 +18,7 @@
 #include "flang/Common/enum-set.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/semantics.h"
+#include "llvm/ADT/DenseSet.h"
 #include "llvm/Frontend/OpenACC/ACC.h.inc"
 
 using AccDirectiveSet = Fortran::common::EnumSet<llvm::acc::Directive,
@@ -66,6 +67,11 @@ class AccStructureChecker
   void Leave(const parser::AccClauseList &);
   void Enter(const parser::AccClause &);
 
+  void Enter(const parser::Module &);
+  void Enter(const parser::SubroutineSubprogram &);
+  void Enter(const parser::FunctionSubprogram &);
+  void Enter(const parser::SeparateModuleSubprogram &);
+
 #define GEN_FLANG_CLAUSE_CHECK_ENTER
 #include "llvm/Frontend/OpenACC/ACC.inc"
 
@@ -74,8 +80,14 @@ class AccStructureChecker
   bool IsComputeConstruct(llvm::acc::Directive directive) const;
   bool IsInsideComputeConstruct() const;
   void CheckNotInComputeConstruct();
+  void CheckMultipleOccurrenceInDeclare(
+      const parser::AccObjectList &, llvm::acc::Clause);
+  void CheckMultipleOccurrenceInDeclare(
+      const parser::AccObjectListWithModifier &, llvm::acc::Clause);
   llvm::StringRef getClauseName(llvm::acc::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::acc::Directive directive) override;
+
+  llvm::SmallDenseSet<Symbol *> declareSymbols;
 };
 
 } // namespace Fortran::semantics

flang/lib/Semantics/semantics.cpp

@@ -166,8 +166,6 @@ using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
     MiscChecker, NamelistChecker, NullifyChecker, PurityChecker,
     ReturnStmtChecker, SelectRankConstructChecker, SelectTypeChecker,
     StopChecker>;
-using StatementSemanticsPass3 =
-    SemanticsVisitor<AccStructureChecker, OmpStructureChecker, CUDAChecker>;
 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {
@@ -178,10 +176,14 @@ static bool PerformStatementSemantics(
   StatementSemanticsPass1{context}.Walk(program);
   StatementSemanticsPass2 pass2{context};
   pass2.Walk(program);
-  if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC) ||
-      context.languageFeatures().IsEnabled(common::LanguageFeature::OpenMP) ||
-      context.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) {
-    StatementSemanticsPass3{context}.Walk(program);
+  if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) {
+    SemanticsVisitor<AccStructureChecker>{context}.Walk(program);
+  }
+  if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenMP)) {
+    SemanticsVisitor<OmpStructureChecker>{context}.Walk(program);
+  }
+  if (context.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) {
+    SemanticsVisitor<CUDAChecker>{context}.Walk(program);
   }
   if (!context.AnyFatalError()) {
     pass2.CompileDataInitializationsIntoInitializers();

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

@@ -7,38 +7,43 @@ module openacc_declare_validity
 
   implicit none
 
-  real(8), dimension(10) :: aa, bb, ab, cc
+  real(8), dimension(10) :: aa, bb, ab, ac, ad, ae, af, cc, dd
 
   !ERROR: At least one clause is required on the DECLARE directive
   !$acc declare
 
   !$acc declare create(aa, bb)
 
+  !ERROR: 'aa' in the CREATE clause is already present in another clause in this module
+  !$acc declare create(aa)
+
   !$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)
+  !$acc declare copyout(ac)
 
   !ERROR: COPY clause is not allowed on the DECLARE directive in module declaration section
-  !$acc declare copy(ab)
+  !$acc declare copy(af)
 
   !ERROR: PRESENT clause is not allowed on the DECLARE directive in module declaration section
-  !$acc declare present(ab)
+  !$acc declare present(ad)
 
   !ERROR: DEVICEPTR clause is not allowed on the DECLARE directive in module declaration section
-  !$acc declare deviceptr(ab)
+  !$acc declare deviceptr(ae)
 
   !ERROR: The ZERO modifier is not allowed for the CREATE clause on the DECLARE directive
-  !$acc declare create(zero: aa)
+  !$acc declare create(zero: dd)
 
 contains
 
   subroutine sub1(cc, dd)
     real(8) :: cc(:)
     real(8) :: dd(:)
     !$acc declare present(cc, dd)
+    !ERROR: 'cc' in the CREATE clause is already present in another clause in this module
+    !$acc declare create(cc)
   end subroutine sub1
 
   function fct1(ee, ff, gg, hh, ii)