[flang][openmp] Add General Semantic Checks for Allocate Directive

This patch adds semantic checks for the General Restrictions of the
Allocate Directive.

Since the requires directive is not yet implemented in Flang, the
restriction:
```
allocate directives that appear in a target region must
specify an allocator clause unless a requires directive with the
dynamic_allocators clause is present in the same compilation unit
```
will need to be updated at a later time.

A different patch will be made with the Fortran specific restrictions of
this directive.

I have used the code from https://reviews.llvm.org/D89395 for the
CheckObjectListStructure function.

Co-authored-by: Isaac Perry <isaac.perry@arm.com>

Reviewed By: clementval, kiranchandramohan

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

flang/include/flang/Parser/parse-tree.h

@@ -3805,7 +3805,7 @@ struct OpenMPConstruct {
   UNION_CLASS_BOILERPLATE(OpenMPConstruct);
   std::variant<OpenMPStandaloneConstruct, OpenMPSectionsConstruct,
       OpenMPLoopConstruct, OpenMPBlockConstruct, OpenMPAtomicConstruct,
-      OpenMPExecutableAllocate, OpenMPDeclarativeAllocate,
+      OpenMPDeclarativeAllocate, OpenMPExecutableAllocate,
       OpenMPCriticalConstruct>
       u;
 };

flang/include/flang/Semantics/symbol.h

@@ -507,9 +507,10 @@ public:
       // OpenMP data-copying attribute
       OmpCopyIn, OmpCopyPrivate,
       // OpenMP miscellaneous flags
-      OmpCommonBlock, OmpReduction, OmpAllocate, OmpDeclareSimd,
-      OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction, OmpFlushed,
-      OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined, OmpAligned);
+      OmpCommonBlock, OmpReduction, OmpAligned, OmpAllocate,
+      OmpAllocateDirective, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate,
+      OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone,
+      OmpPreDetermined);
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   const Scope &owner() const { return *owner_; }

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

@@ -462,10 +462,12 @@ void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
 
 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
+  CheckIsVarPartOfAnotherVar(dir.source, objectList);
 }
 
-void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &) {
+void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
   dirContext_.pop_back();
 }
 
@@ -484,7 +486,10 @@ void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
 
 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
+  if (objectList)
+    CheckIsVarPartOfAnotherVar(dir.source, *objectList);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) {
@@ -954,26 +959,37 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
 
 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_shared);
-  CheckIsVarPartOfAnotherVar(x.v);
+  CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_private);
-  CheckIsVarPartOfAnotherVar(x.v);
+  CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
 }
 
 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
-    const parser::OmpObjectList &objList) {
+    const parser::CharBlock &source, const parser::OmpObjectList &objList) {
+
   for (const auto &ompObject : objList.v) {
-    if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
-        (parser::Unwrap<parser::ArrayElement>(ompObject))) {
-      context_.Say(GetContext().clauseSource,
-          "A variable that is part of another variable (as an "
-          "array or structure element)"
-          " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
-    }
+    std::visit(
+        common::visitors{
+            [&](const parser::Designator &designator) {
+              if (std::get_if<parser::DataRef>(&designator.u)) {
+                if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
+                    (parser::Unwrap<parser::ArrayElement>(ompObject))) {
+                  context_.Say(source,
+                      "A variable that is part of another variable (as an "
+                      "array or structure element)"
+                      " cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive."_err_en_US);
+                }
+              }
+            },
+            [&](const parser::Name &name) {},
+        },
+        ompObject.u);
   }
 }
+
 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);

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

@@ -178,7 +178,8 @@ private:
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
-  void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList);
+  void CheckIsVarPartOfAnotherVar(
+      const parser::CharBlock &source, const parser::OmpObjectList &objList);
   void CheckIntentInPointer(
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &);

flang/lib/Semantics/resolve-directives.cpp

@@ -318,6 +318,12 @@ public:
   bool Pre(const parser::OpenMPThreadprivate &);
   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
 
+  bool Pre(const parser::OpenMPDeclarativeAllocate &);
+  void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); }
+
+  bool Pre(const parser::OpenMPExecutableAllocate &);
+  void Post(const parser::OpenMPExecutableAllocate &);
+
   // 2.15.3 Data-Sharing Attribute Clauses
   void Post(const parser::OmpDefaultClause &);
   bool Pre(const parser::OmpClause::Shared &x) {
@@ -479,6 +485,7 @@ private:
       const parser::OpenMPLoopConstruct &);
   void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
 
+  bool IsNestedInDirective(llvm::omp::Directive directive);
   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
@@ -487,6 +494,7 @@ private:
   void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
   void ResolveOmpName(const parser::Name &, Symbol::Flag);
   Symbol *ResolveName(const parser::Name *);
+  Symbol *ResolveOmpObjectScope(const parser::Name *);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
@@ -1287,6 +1295,21 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
   return true;
 }
 
+bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
+  PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
+  const auto &list{std::get<parser::OmpObjectList>(x.t)};
+  ResolveOmpObjectList(list, Symbol::Flag::OmpAllocateDirective);
+  return false;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
+  PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
+  const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
+  if (list)
+    ResolveOmpObjectList(*list, Symbol::Flag::OmpAllocateDirective);
+  return true;
+}
+
 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
   if (!dirContext_.empty()) {
     switch (x.v) {
@@ -1306,6 +1329,36 @@ void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
   }
 }
 
+bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) {
+  if (dirContext_.size() >= 1) {
+    for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
+      if (dirContext_[i - 1].directive == directive)
+        return true;
+    }
+  }
+  return false;
+}
+
+void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
+  bool hasAllocator = false;
+  // TODO: Investigate whether searching the clause list can be done with
+  // parser::Unwrap instead of the following loop
+  const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
+  for (const auto &clause : clauseList.v) {
+    if (std::get_if<parser::OmpClause::Allocator>(&clause.u))
+      hasAllocator = true;
+  }
+
+  if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator)
+    // TODO: expand this check to exclude the case when a requires
+    //       directive with the dynamic_allocators clause is present
+    //       in the same compilation unit (OMP5.0 2.11.3).
+    context_.Say(x.source,
+        "ALLOCATE directives that appear in a TARGET region "
+        "must specify an allocator clause"_err_en_US);
+  PopContext();
+}
+
 // For OpenMP constructs, check all the data-refs within the constructs
 // and adjust the symbol for each Name if necessary
 void OmpAttributeVisitor::Post(const parser::Name &name) {
@@ -1375,6 +1428,31 @@ Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
   return nullptr;
 }
 
+// Use this function over ResolveOmpName when an omp object's scope needs
+// resolving, it's symbol flag isn't important and a simple check for resolution
+// failure is desired. Using ResolveOmpName means needing to work with the
+// context to check for failure, whereas here a pointer comparison is all that's
+// needed.
+Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) {
+
+  // TODO: Investigate whether the following block can be replaced by, or
+  // included in, the ResolveOmpName function
+  if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source)
+                      : nullptr}) {
+    name->symbol = prev;
+    return nullptr;
+  }
+
+  // TODO: Investigate whether the following block can be replaced by, or
+  // included in, the ResolveOmpName function
+  if (auto *ompSymbol{
+          name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
+    name->symbol = ompSymbol;
+    return ompSymbol;
+  }
+  return nullptr;
+}
+
 void OmpAttributeVisitor::ResolveOmpObjectList(
     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
   for (const auto &ompObject : ompObjectList.v) {
@@ -1404,6 +1482,12 @@ void OmpAttributeVisitor::ResolveOmpObject(
                     AddAllocateName(name);
                   }
                 }
+                if (ompFlag == Symbol::Flag::OmpAllocateDirective &&
+                    ResolveOmpObjectScope(name) == nullptr) {
+                  context_.Say(designator.source, // 2.15.3
+                      "List items must be declared in the same scoping unit "
+                      "in which the ALLOCATE directive appears"_err_en_US);
+                }
               }
             } else {
               // Array sections to be changed to substrings as needed

flang/test/Semantics/omp-allocate01.f90

@@ -0,0 +1,24 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! The allocate directive must appear in the same scope as the declarations of
+! each of its list items and must follow all such declarations.
+
+subroutine allocate()
+use omp_lib
+  integer :: x
+  contains
+    subroutine sema()
+    integer :: a, b
+    real, dimension (:,:), allocatable :: darray
+
+    !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
+    !$omp allocate(x)
+        print *, a
+
+    !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
+    !$omp allocate(x) allocator(omp_default_mem_alloc)
+      allocate ( darray(a, b) )
+    end subroutine sema
+
+end subroutine allocate

flang/test/Semantics/omp-allocate02.f90

@@ -0,0 +1,24 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! At most one allocator clause can appear on the allocate directive.
+
+subroutine allocate()
+use omp_lib
+  integer :: x, y
+  integer :: a, b
+  real, dimension (:,:), allocatable :: darray
+
+  !$omp allocate(x, y) allocator(omp_default_mem_alloc)
+
+  !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive
+  !$omp allocate(x, y) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
+
+  !$omp allocate(x) allocator(omp_default_mem_alloc)
+      allocate ( darray(a, b) )
+
+  !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive
+  !$omp allocate(x) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
+      allocate ( darray(a, b) )
+
+end subroutine allocate

flang/test/Semantics/omp-allocate03.f90

@@ -0,0 +1,24 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! A variable that is part of another variable (as an array or
+! structure element) cannot appear in an allocate directive.
+subroutine allocate()
+use omp_lib
+
+  type my_type
+    integer :: array(10)
+  end type my_type
+  type(my_type) :: my_var
+  real, dimension (:,:), allocatable :: darray
+  integer :: a, b
+
+  !!ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in an ALLOCATE directive
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
+  !$omp allocate(my_var%array)
+
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
+  !$omp allocate(darray, my_var%array) allocator(omp_default_mem_alloc)
+    allocate ( darray(a, b) )
+
+end subroutine allocate

flang/test/Semantics/omp-allocate04.f90

@@ -0,0 +1,14 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! Only the allocator clause is allowed on the allocate directive
+subroutine allocate()
+use omp_lib
+
+  integer :: x, y
+
+  !$omp allocate(x) allocator(omp_default_mem_alloc)
+
+  !ERROR: PRIVATE clause is not allowed on the ALLOCATE directive
+  !$omp allocate(y) private(y)
+end subroutine allocate

flang/test/Semantics/omp-allocate05.f90

@@ -0,0 +1,24 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! allocate directives that appear in a target region must specify an allocator
+! clause unless a requires directive with the dynamic_allocators clause is present
+! in the same compilation unit.
+
+subroutine allocate()
+use omp_lib
+  integer :: a, b
+  real, dimension (:,:), allocatable :: darray
+
+  !$omp target
+      !$omp allocate allocator(omp_default_mem_alloc)
+          allocate ( darray(a, b) )
+  !$omp end target
+
+  !$omp target
+      !ERROR: ALLOCATE directives that appear in a TARGET region must specify an allocator clause
+      !$omp allocate
+          allocate ( darray(a, b) )
+  !$omp end target
+
+end subroutine allocate

flang/test/Semantics/omp-parallel-private01.f90

@@ -10,7 +10,7 @@ program omp_parallel_private
 
   type(my_type) :: my_var
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel private(my_var%array)
   do i = 1, 10
     c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-private02.f90

@@ -10,7 +10,7 @@ program omp_parallel_private
     array(i) = i
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel private(array(i))
   do i = 1, 10
     c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-private03.f90

@@ -17,7 +17,7 @@ program omp_parallel_private
     arr(i) = 0.0
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel private(arr(i),intx)
   do i = 1, 10
     c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-private04.f90

@@ -17,7 +17,7 @@ program omp_parallel_private
     arr(i) = 0.0
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel private(arr,intx,my_var%array(1))
   do i = 1, 10
     c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-shared01.f90

@@ -10,7 +10,7 @@ program omp_parallel_shared
 
   type(my_type) :: my_var
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel shared(my_var%array)
   do i = 1, 10
     c(i) = a(i) + b(i) +  k

flang/test/Semantics/omp-parallel-shared02.f90

@@ -10,7 +10,7 @@ program omp_parallel_shared
     array(i) = i
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel shared(array(i))
   do i = 1, 10
     c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-shared03.f90

@@ -17,7 +17,7 @@ program omp_parallel_shared
     arr(i) = 0.0
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel shared(arr(i),intx)
   do i = 1, 10
      c(i) = a(i) + b(i) + k

flang/test/Semantics/omp-parallel-shared04.f90

@@ -17,7 +17,7 @@ program omp_parallel_shared
     arr(i) = 0.0
   end do
 
-  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause.
+  !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive.
   !$omp parallel shared(arr,intx,my_var%array(1))
   do i = 1, 10
     c(i) = a(i) + b(i) + k

llvm/include/llvm/Frontend/OpenMP/OMP.td

@@ -1490,7 +1490,7 @@ def OMP_TargetTeamsDistributeSimd :
   ];
 }
 def OMP_Allocate : Directive<"allocate"> {
-  let allowedClauses = [
+  let allowedOnceClauses = [
     VersionedClause<OMPC_Allocator>
   ];
 }