[flang] [openmp] Add Fortran specific semantic checks for OpenMP Allocate directive.

[I_Perry]

Summary

This patch adds Fortran specific semantic checks for the OpenMP allocate
directive.

Due to an issue in the parser (described in https://reviews.llvm.org/D93549/new/)
the checks: "List items specified in an allocate directive that is
associated with an allocate statement must be variables that are allocated
by the allocate statement" and "Multiple directives can only be associated
with an allocate statement if list items are specified on each allocate directive"
cannot be implemented yet.

I have used code written as part of https://reviews.llvm.org/D93549/new/
as a basis for the implementations of these checks.

[kiranchandramohan]

A few comments.

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

1136

Nit: Use braced initialization.

1163–1173

Can you make the type parameter inquiry check the first check and the other one the second and remove (!IsDataRefTypeParamInquiry(dataRef)) from the current first check?

flang/lib/Semantics/resolve-directives.cpp

1491–1492

Nit: Is this clang-formatted?

flang/test/Semantics/omp-allocate06.f90

15–16

The line 15 omp allocate should come before line 11. The line 12 allocate is an executable statement, which makes the line 15 openmp allocate directive an executable allocate.

flang/test/Semantics/omp-allocate07.f90

24

Can you add a test which has allocate directive having an array's kind?

[I_Perry]

Addressed comments.

[I_Perry]

flang/lib/Semantics/resolve-directives.cpp

1491–1492

I've just edited then formatted this code with clang-format and this is the result. Could there possibly be a clang-format version issue if this shouldn't be the case?

[kiranchandramohan]

LGTM.

flang/include/flang/Semantics/symbol.h

ENUM_CLASS(Flag,
       // OpenMP data-sharing attribute
       OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate,
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete,
       // OpenMP data-copying attribute
       OmpCopyIn, OmpCopyPrivate,
       // OpenMP miscellaneous flags
       OmpCommonBlock, OmpReduction, OmpAligned, OmpAllocate,
-      OmpAllocateDirective, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate,
-      OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone,
-      OmpPreDetermined);
+      OmpDeclarativeAllocateDirective, OmpExecutableAllocateDirective,
+      OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction,
+      OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined);
   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/lib/Semantics/check-omp-structure.h

private:
   void CheckAllowedMapTypes(const parser::OmpMapType::Type &,
       const std::list<parser::OmpMapType::Type> &);
   llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
 
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
+  bool IsDataRefTypeParamInquiry(const parser::DataRef *dataRef);
   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 &);
   void CheckDefinableObjects(SymbolSourceMap &, const llvm::omp::Clause);
   void CheckPrivateSymbolsInOuterCxt(
       SymbolSourceMap &, DirectivesClauseTriple &, const llvm::omp::Clause);

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

void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
   CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_private);
   CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v);
   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
 }
 
+bool OmpStructureChecker::IsDataRefTypeParamInquiry(
+    const parser::DataRef *dataRef) {
+  bool dataRefIsTypeParamInquiry{false};
+  if (const auto *structComp{
+          parser::Unwrap<parser::StructureComponent>(dataRef)}) {
+    if (const auto *compSymbol{structComp->component.symbol}) {
+      if (const auto *compSymbolMiscDetails{
+              std::get_if<MiscDetails>(&compSymbol->details())}) {
+        const auto detailsKind = compSymbolMiscDetails->kind();
+        dataRefIsTypeParamInquiry =
+            (detailsKind == MiscDetails::Kind::KindParamInquiry ||
+                detailsKind == MiscDetails::Kind::LenParamInquiry);
+      } else if (compSymbol->has<TypeParamDetails>()) {
+        dataRefIsTypeParamInquiry = true;
+      }
+    }
+  }
+  return dataRefIsTypeParamInquiry;
+}
+
 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
     const parser::CharBlock &source, const parser::OmpObjectList &objList) {
 
   for (const auto &ompObject : objList.v) {
     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))) {
+              if (const auto *dataRef{
+                      std::get_if<parser::DataRef>(&designator.u)}) {
+                if (IsDataRefTypeParamInquiry(dataRef)) {
+                  context_.Say(source,
+                      "A type parameter inquiry cannot appear in an ALLOCATE directive"_err_en_US);
+                } else 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);
   }
 }
 

flang/lib/Semantics/resolve-directives.cpp

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::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);
+    ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
   return true;
 }
 
 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
   if (!dirContext_.empty()) {
     switch (x.v) {
     case parser::OmpDefaultClause::Type::Private:
       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
std::visit(
                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
                     CheckPrivateDSAObject(*name, *symbol, ompFlag);
                   }
 
                   if (ompFlag == Symbol::Flag::OmpAllocate) {
                     AddAllocateName(name);
                   }
                 }
-                if (ompFlag == Symbol::Flag::OmpAllocateDirective &&
+                if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
+                    IsAllocatable(*symbol)) {
+                  context_.Say(designator.source,
+                      "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 ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
+                        ompFlag ==
+                            Symbol::Flag::OmpExecutableAllocateDirective) &&
                     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-allocate06.f90

+! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive 
+! List items specified in the allocate directive must not have the ALLOCATABLE attribute unless the directive is associated with an
+! allocate statement.
+
+subroutine allocate()
+use omp_lib
+  integer :: a, b, x
+  real, dimension (:,:), allocatable :: darray
+
+  !ERROR: List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement
+  !$omp allocate(darray) allocator(omp_default_mem_alloc)
+
+  !$omp allocate(darray) allocator(omp_default_mem_alloc)
+    allocate(darray(a, b))
+
+end subroutine allocate

flang/test/Semantics/omp-allocate07.f90

+! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive 
+! A type parameter inquiry cannot appear in an allocate directive.
+
+subroutine allocate()
+use omp_lib
+  type my_type(kind_param, len_param)
+    INTEGER, KIND :: kind_param
+    INTEGER, LEN :: len_param
+    INTEGER :: array(10)
+  end type
+
+  type(my_type(2, 4)) :: my_var
+  INTEGER(KIND=4) :: x
+  CHARACTER(LEN=32) :: w
+  INTEGER, DIMENSION(:), ALLOCATABLE :: y
+  
+  !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive
+  !$omp allocate(x%KIND)
+  
+  !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive
+  !$omp allocate(w%LEN)
+
+  !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive
+  !$omp allocate(y%KIND)
+  
+  !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive
+  !$omp allocate(my_var%kind_param)
+ 
+  !ERROR: A type parameter inquiry cannot appear in an ALLOCATE directive
+  !$omp allocate(my_var%len_param)
+
+end subroutine allocate
+