[flang][OpenMP] Add Fortran Specific Semantic Checks for Allocate Directive

[Rin]

Summary

This is a work in progress

Some comments about this patch:

There seem to be a few issues with the parser.
Currently for this fortran code:

!$omp allocate(zarray) allocator(omp_const_mem_alloc)
!$omp allocate(z) allocator(omp_large_cap_mem_alloc)
!$omp allocate(a) allocator(omp_default_mem_alloc)
!$omp allocate
   allocate ( zarray(z,t) )

The parse tree looks like this:

| | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | Verbatim
| | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
| | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc'
| | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | Verbatim
| | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'z'
| | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
| | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | Verbatim
| | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'a'
| | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc'
| | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate

Whereas it should look something like this.

| | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate
| | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | | Verbatim
| | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
| | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc'
| | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | | Verbatim
| | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'z'
| | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
| | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDeclarativeAllocate
| | | | Verbatim
| | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'a'
| | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
| | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc'

This is affecting the Semantic checks as the list of OpenMPDeclarativeAllocate will always be empty, since they come before the OpenMPExecutableAllocate.

Test also need to be added.

[Rin]

Remove unnecessary comments

[Rin]

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

274

This functioned is removed and a different one is reused In the General Semantic Checks patch. This should be taken care of after a rebase.

flang/lib/Semantics/resolve-directives.cpp

373

This function is never used, but should be. A place where the ExecutableAllocateNames should be cleared needs to be chosen.

1065

The declarativeList is always empty. My assumption is this happens because the declarative allocate appears before the executable one and so the list remains empty.

1072

Unnecessary comment here that will be removed

flang/include/flang/Semantics/symbol.h

ENUM_CLASS(Flag,
       AccCommonBlock, AccThreadPrivate, AccReduction, AccNone, AccPreDetermined,
       // OpenMP data-sharing attribute
       OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate,
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete,
       // OpenMP data-copying attribute
       OmpCopyIn,
       // OpenMP miscellaneous flags
-      OmpCommonBlock, OmpReduction, OmpAllocate, OmpAllocateDirective,
+      OmpCommonBlock, OmpReduction, OmpAllocate,
+      OmpDeclarativeAllocateDirective, OmpExecutableAllocateDirective,
       OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction,
-      OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined, OmpAligned);
+      OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined,
+      OmpAligned);
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   const Scope &owner() const { return *owner_; }
   const SourceName &name() const { return name_; }
   Attrs &attrs() { return attrs_; }
   const Attrs &attrs() const { return attrs_; }
   Flags &flags() { return flags_; }
   const Flags &flags() const { return flags_; }

flang/include/flang/Semantics/tools.h

inline bool IsPointer(const Symbol &symbol) {
   return symbol.attrs().test(Attr::POINTER);
 }
 inline bool IsAllocatable(const Symbol &symbol) {
   return symbol.attrs().test(Attr::ALLOCATABLE);
 }
 inline bool IsAllocatableOrPointer(const Symbol &symbol) {
   return IsPointer(symbol) || IsAllocatable(symbol);
 }
+inline bool IsSave(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::SAVE);
+}
 inline bool IsNamedConstant(const Symbol &symbol) {
   return symbol.attrs().test(Attr::PARAMETER);
 }
 inline bool IsOptional(const Symbol &symbol) {
   return symbol.attrs().test(Attr::OPTIONAL);
 }
 inline bool IsIntentIn(const Symbol &symbol) {
   return symbol.attrs().test(Attr::INTENT_IN);

flang/lib/Parser/type-parsers.h

 constexpr Parser<StructureComponent> structureComponent; // R913
 constexpr Parser<AllocateStmt> allocateStmt; // R927
 constexpr Parser<StatVariable> statVariable; // R929
 constexpr Parser<StatOrErrmsg> statOrErrmsg; // R942 & R1165
 constexpr Parser<DefinedOpName> definedOpName; // R1003, R1023, R1414, & R1415
 constexpr Parser<Expr> expr; // R1022
 constexpr Parser<SpecificationExpr> specificationExpr; // R1028
 constexpr Parser<AssignmentStmt> assignmentStmt; // R1032
-constexpr Parser<AllocateStmt> allocateStmt;
 constexpr Parser<PointerAssignmentStmt> pointerAssignmentStmt; // R1033
 constexpr Parser<WhereStmt> whereStmt; // R1041, R1045, R1046
 constexpr Parser<WhereConstruct> whereConstruct; // R1042
 constexpr Parser<WhereBodyConstruct> whereBodyConstruct; // R1044
 constexpr Parser<ForallConstruct> forallConstruct; // R1050
 constexpr Parser<ForallAssignmentStmt> forallAssignmentStmt; // R1053
 constexpr Parser<ForallStmt> forallStmt; // R1055
 constexpr Parser<Selector> selector; // R1105

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

#include "llvm/Frontend/OpenMP/OMP.cpp.inc"
   void Enter(const parser::OmpClause::Final &);
   void Enter(const parser::OmpClause::Firstprivate &);
   void Enter(const parser::OmpClause::From &);
   void Enter(const parser::OmpClause::Grainsize &);
   void Enter(const parser::OmpClause::Lastprivate &);
   void Enter(const parser::OmpClause::NumTasks &);
   void Enter(const parser::OmpClause::NumTeams &);
   void Enter(const parser::OmpClause::NumThreads &);
-  void Enter(const parser::OmpClause::Allocator &);
   void Enter(const parser::OmpClause::Ordered &);
   void Enter(const parser::OmpClause::Priority &);
   void Enter(const parser::OmpClause::Private &);
   void Enter(const parser::OmpClause::Safelen &);
   void Enter(const parser::OmpClause::Shared &);
   void Enter(const parser::OmpClause::Simdlen &);
   void Enter(const parser::OmpClause::ThreadLimit &);
   void Enter(const parser::OmpClause::To &);
#include "llvm/Frontend/OpenMP/OMP.cpp.inc"
   void Enter(const parser::OmpMapClause &);
   void Enter(const parser::OmpProcBindClause &);
   void Enter(const parser::OmpReductionClause &);
   void Enter(const parser::OmpScheduleClause &);
 
   void CheckObjectListStructure(
       const parser::CharBlock &source, const parser::OmpObjectList &objList);
 
+  void CheckRestriction(
+      const parser::CharBlock &source, const parser::OmpObjectList &objList);
+
 private:
   bool HasInvalidWorksharingNesting(
       const parser::CharBlock &, const OmpDirectiveSet &);
 
   // specific clause related
   bool ScheduleModifierHasType(const parser::OmpScheduleClause &,
       const parser::OmpScheduleModifierType::ModType &);
   void CheckAllowedMapTypes(const parser::OmpMapType::Type &,

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

void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
   dirContext_.pop_back();
 }
 
+bool isPredefinedAllocator = true;
 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
+  isPredefinedAllocator = true;
   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);
   CheckObjectListStructure(dir.source, objectList);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+  const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
+  CheckRestriction(dir.source, objectList);
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::CheckObjectListStructure(
     const parser::CharBlock &source, const parser::OmpObjectList &objList) {
 
   for (const auto &ompObject : objList.v) {
     std::visit(
std::visit(
               }
             },
             [&](const parser::Name &name) {},
         },
         ompObject.u);
   }
 }
 
+void OmpStructureChecker::CheckRestriction(
+    const parser::CharBlock &source, const parser::OmpObjectList &objList) {
+  for (const auto &ompObject : objList.v) {
+    std::visit(
+        common::visitors{
+            [&](const parser::Designator &designator) {
+              if (const auto *dataRef{
+                      std::get_if<parser::DataRef>(&designator.u)}) {
+                if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
+                  if (const auto *symbol{name->symbol}) {
+                    const auto *commonBlock{FindCommonBlockContaining(*symbol)};
+                    const auto &scope{context_.FindScope(source)};
+                    const Scope &containingScope{
+                        GetProgramUnitContaining(scope)};
+                    if (!isPredefinedAllocator &&
+                        (IsSave(*symbol) || commonBlock ||
+                            containingScope.kind() == Scope::Kind::Module)) {
+                      context_.Say(source,
+                          "If list items within the ALLCOATE directive have "
+                          "the "
+                          "SAVE attribute, are a common block name, or are "
+                          "declared in the scope of a module, "
+                          "then only predefined memory allocator parameters can be used in the allocator clause."_err_en_US);
+                    }
+                  }
+                }
+              }
+            },
+            [&](const parser::Name &name) {},
+        },
+        ompObject.u);
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
   if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
     SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
   }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
+  isPredefinedAllocator = true;
   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)
+    CheckObjectListStructure(dir.source, *objectList);
 }
 
-void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) {
+void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
+  const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
+  if (objectList)
+    CheckRestriction(dir.source, *objectList);
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::Enter(
     const parser::OpenMPSimpleStandaloneConstruct &x) {
   const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
   PushContextAndClauseSets(dir.source, dir.v);
 }

 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
 
-CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator)
+// CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator)
 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
 
 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
void OmpStructureChecker::Enter(const parser::OmpAlignedClause &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_aligned);
 
   if (const auto &expr{
           std::get<std::optional<parser::ScalarIntConstantExpr>>(x.t)}) {
     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
   }
   // 2.8.1 TODO: list-item attribute check
 }
+
+void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
+  CheckAllowed(llvm::omp::Clause::OMPC_allocator);
+  const auto allocatorValue{GetIntValue(x.v)};
+  if (*allocatorValue > 8)
+    isPredefinedAllocator = false;
+  RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
+}
+
 void OmpStructureChecker::Enter(const parser::OmpDefaultmapClause &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
   using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
   if (!std::get<std::optional<VariableCategory>>(x.t)) {
     context_.Say(GetContext().clauseSource,
         "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
         "clause"_err_en_US);
   }

flang/lib/Semantics/resolve-directives.cpp

 #include "resolve-names-utils.h"
 #include "flang/Common/idioms.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
+#include "flang/Semantics/tools.h"
 #include <list>
 #include <map>
 
 namespace Fortran::semantics {
 
 template <typename T> class DirectiveAttributeVisitor {
 public:
   explicit DirectiveAttributeVisitor(SemanticsContext &context)
public:
   bool Pre(const parser::SpecificationPart &x) {
     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
     return true;
   }
 
   bool Pre(const parser::OpenMPBlockConstruct &);
   void Post(const parser::OpenMPBlockConstruct &);
 
+  bool Pre(const parser::ExecutionPartConstruct &);
+
   void Post(const parser::OmpBeginBlockDirective &) {
     GetContext().withinConstruct = true;
   }
 
   bool Pre(const parser::OpenMPLoopConstruct &);
   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
   void Post(const parser::OmpBeginLoopDirective &) {
     GetContext().withinConstruct = true;
public:
   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 &);
 
+  bool Pre(const parser::AllocateObject &);
+
   // 2.15.3 Data-Sharing Attribute Clauses
   void Post(const parser::OmpDefaultClause &);
   bool Pre(const parser::OmpClause::Shared &x) {
     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
     return false;
   }
   bool Pre(const parser::OmpClause::Allocator &x) {
     hasAllocator = true;
static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
       Symbol::Flag::OmpReduction};
 
   static constexpr Symbol::Flags ompFlagsRequireMark{
       Symbol::Flag::OmpThreadprivate};
 
   static constexpr Symbol::Flags dataCopyingAttributeFlags{
       Symbol::Flag::OmpCopyIn};
 
+  std::vector<const parser::Name *> allocateList_; // on one directive
   std::vector<const parser::Name *> allocateNames_; // on one directive
+  std::vector<const parser::Name *>
+      executableAllocateNames_; // on one directive
   SymbolSet privateDataSharingAttributeObjects_; // on one directive
   bool inTarget = false;
   bool hasAllocator = false;
+  bool executable = false;
 
   void AddAllocateName(const parser::Name *&object) {
     allocateNames_.push_back(object);
   }
   void ClearAllocateNames() { allocateNames_.clear(); }
 
+  void AddExecutableAllocateName(const parser::Name *&object) {
+    executableAllocateNames_.push_back(object);
+  }
+  void ClearExecutableAllocateNames() { executableAllocateNames_.clear(); }
+
+  void AddAllocateListName(const parser::Name *object) {
+    allocateList_.push_back(object);
+  }
+  void ClearAllocateListNames() { allocateList_.clear(); }
+
   void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
     privateDataSharingAttributeObjects_.insert(object);
   }
   void ClearPrivateDataSharingAttributeObjects() {
     privateDataSharingAttributeObjects_.clear();
   }
 
   // Predetermined DSA rules
context_.Say(name.source,
         "'%s' appears in more than one data-sharing clause "
         "on the same OpenACC directive"_err_en_US,
         name.ToString());
   } else {
     AddDataSharingAttributeObject(*target);
   }
 }
 
+bool OmpAttributeVisitor::Pre(const parser::ExecutionPartConstruct &x) {
+  executable = true;
+  return true;
+}
+
 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
   inTarget = false;
   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
   switch (beginDir.v) {
   case llvm::omp::Directive::OMPD_target: {
     PushContext(beginDir.source, beginDir.v);
     inTarget = true;
bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
   const auto &list{std::get<parser::OmpObjectList>(x.t)};
   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
   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);
+  ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective);
   return false;
 }
 
+bool OmpAttributeVisitor::Pre(const parser::AllocateObject &x) {
+  const auto &name{std::get<parser::Name>(x.u)};
+  AddAllocateListName(&name);
+  return true;
+}
+
 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
   hasAllocator = false;
   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
   const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
+  const auto &declarativeList{
+      std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+          x.t)};
+  if (declarativeList && !list) {
+    context_.Say(x.source,
+        "Multiple directives can only be associated with an allocate statement"
+        " if list items are specified on each allocate directive"_err_en_US);
+  }
   if (list)
-    ResolveOmpObjectList(*list, Symbol::Flag::OmpAllocateDirective);
+    ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
+  /*const auto
+   * &list{std::get<parser::AllocateStmt<parser::Allocation<parser::AllocateObject>>>(x.t)};*/
   return true;
 }
 
 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
   if (!dirContext_.empty()) {
     switch (x.v) {
     case parser::OmpDefaultClause::Type::Private:
       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);

 void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
   if (inTarget && !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);
+
+  bool allocated;
+  for (const auto *allocName : allocateList_) {
+    allocated = false;
+    for (const auto *allocExecName : executableAllocateNames_) {
+      if (allocName->source == allocExecName->source) {
+        allocated = true;
+      }
+    }
+    if (!allocated) {
+      context_.Say(allocName->source,
+          "List items specified in an ALLOCATE directive that is associated "
+          "with "
+          "an allocate statement must be variables that are allocated by the "
+          "allocate statement. The ALLOCATE directive requires "
+          "that '%s' must be allocated by the allocate statement."_err_en_US,
+          allocName->ToString());
+    }
+  }
+
+  executable = false;
   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) {
   auto *symbol{name.symbol};
   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
std::visit(
                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
                     CheckObjectInNamelist(*name, *symbol, ompFlag);
                   }
 
                   if (ompFlag == Symbol::Flag::OmpAllocate) {
                     AddAllocateName(name);
                   }
                 }
+                if (ompFlag == Symbol::Flag::OmpExecutableAllocateDirective ||
+                    ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective) {
+                  AddExecutableAllocateName(name);
+                }
+                const auto *commonBlock{FindCommonBlockContaining(*symbol)};
+                if (IsAllocatable(*symbol) && !executable) {
+                  context_.Say(designator.source, // 2.15.3
+                      "List items specified in the allocate directive must "
+                      "not have the ALLOCATABLE attribute unless the directive "
+                      "is associated with an allocate statement"_err_en_US);
+                }
                 if (ResolveOmpObjectScope(name) == nullptr &&
-                    ompFlag == Symbol::Flag::OmpAllocateDirective) {
+                    (ompFlag == Symbol::Flag::OmpExecutableAllocateDirective ||
+                        ompFlag ==
+                            Symbol::Flag::OmpDeclarativeAllocateDirective)) {
                   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
               if (AnalyzeExpr(context_, designator)) {