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

[I_Perry]

Summary

This patch adds the 4th Fortran specific semantic check for the OpenMP
allocate directive: "If a list item has the SAVE attribute, is a common
block name, or is declared in the scope of a module, then only predefined
memory allocator parameters can be used in the allocator clause".

Code in this patch was based on code from https://reviews.llvm.org/D93549/new/.

[kiranchandramohan]

flang/test/Semantics/omp-allocate08.f90

33

Can you add a test with a custom allocator?

[I_Perry]

Added custom allocator test in omp-allocate08.f90

[kiranchandramohan]

Thanks @I_Perry for the changes. Do you know why the allocate08 test fails?

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

761

We should not hardcode this number 8.

[I_Perry]

Made change to fix failing test on Phabricator.

[I_Perry]

Added function to check for predefined allocator and allocator value generated enum.

[kiranchandramohan]

The test omp-allocate08.f90 is failing, please check.

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

765

For a predefined allocator, this obtains the integer value corresponding to the allocator. But for a custom allocator a string is obtained now. I believe the GetIntValue can be any random value based on the name of the string. We need to do something different here. (like one of the following)

1. Check whether the Expression contains an int or string before calling GetIntValue.
2. Change the parsing to place the custom allocator's value in Expr

Predefined Allocator
| | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_4'
Custom Allocator
| | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = 'custom_allocator'

[kiranchandramohan]

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

43 ↗

(On Diff #349018)

The following is the list of allocators found from openmp/runtime/src/kmp_global.cpp.

1. There is no omp_custom_allocator.
2. There are a few allocators with value above 100.

omp_allocator_handle_t const omp_null_allocator = NULL;
omp_allocator_handle_t const omp_default_mem_alloc =
    (omp_allocator_handle_t const)1;
omp_allocator_handle_t const omp_large_cap_mem_alloc =
    (omp_allocator_handle_t const)2;
omp_allocator_handle_t const omp_const_mem_alloc =
    (omp_allocator_handle_t const)3;
omp_allocator_handle_t const omp_high_bw_mem_alloc =
    (omp_allocator_handle_t const)4;
omp_allocator_handle_t const omp_low_lat_mem_alloc =
    (omp_allocator_handle_t const)5;
omp_allocator_handle_t const omp_cgroup_mem_alloc =
    (omp_allocator_handle_t const)6;
omp_allocator_handle_t const omp_pteam_mem_alloc =
    (omp_allocator_handle_t const)7;
omp_allocator_handle_t const omp_thread_mem_alloc =
    (omp_allocator_handle_t const)8;
// Preview of target memory support
omp_allocator_handle_t const llvm_omp_target_host_mem_alloc =
    (omp_allocator_handle_t const)100;
omp_allocator_handle_t const llvm_omp_target_shared_mem_alloc =
    (omp_allocator_handle_t const)101;
omp_allocator_handle_t const llvm_omp_target_device_mem_alloc =
    (omp_allocator_handle_t const)102;
omp_allocator_handle_t const kmp_max_mem_alloc =
    (omp_allocator_handle_t const)1024;

[I_Perry]

Removed generated enum as a simpler test for a custom allocator was found.

[kiranchandramohan]

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

259

Nit: Can this be limited to 80 characters per line?

265

What about here? I think common blocks come here? Can you add a test and check?

760

Nit: Add a comment explaining why this code works in identifying predefined allocators.

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

241

Nit:Can this be initialized to a value?

[I_Perry]

Addressed nit comments and added additional test for common block names.

[kiranchandramohan]

LGTM.

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/Semantics/check-omp-structure.h

private:
   void CheckReductionArraySection(const parser::OmpObjectList &ompObjectList);
   void CheckIntentInPointerAndDefinable(
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void CheckArraySection(const parser::ArrayElement &arrayElement,
       const parser::Name &name, const llvm::omp::Clause clause);
   void CheckMultipleAppearanceAcrossContext(
       const parser::OmpObjectList &ompObjectList);
   const parser::OmpObjectList *GetOmpObjectList(const parser::OmpClause &);
+  void CheckPredefinedAllocatorRestriction(const parser::CharBlock &source,
+      const parser::OmpObjectList &ompObjectList);
+  void CheckPredefinedAllocatorRestriction(
+      const parser::CharBlock &source, const parser::Name &name);
+  bool isPredefinedAllocator{false};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

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

OmpDirectiveSet allowedSet{llvm::omp::Directive::OMPD_parallel,
       llvm::omp::Directive::OMPD_distribute_simd};
 
   if (!allowedSet.test(dir)) {
     context_.Say(source,
         "Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region."_err_en_US);
   }
 }
 
+void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
+    const parser::CharBlock &source, const parser::Name &name) {
+  if (const auto *symbol{name.symbol}) {
+    const auto *commonBlock{FindCommonBlockContaining(*symbol)};
+    const auto &scope{context_.FindScope(symbol->name())};
+    const Scope &containingScope{GetProgramUnitContaining(scope)};
+    if (!isPredefinedAllocator &&
+        (IsSave(*symbol) || commonBlock ||
+            containingScope.kind() == Scope::Kind::Module)) {
+      context_.Say(source,
+          "If list items within the ALLOCATE 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);
+    }
+  }
+}
+
+void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
+    const parser::CharBlock &source,
+    const parser::OmpObjectList &ompObjectList) {
+  for (const auto &ompObject : ompObjectList.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)}) {
+                  CheckPredefinedAllocatorRestriction(source, *name);
+                }
+              }
+            },
+            [&](const parser::Name &name) {
+              CheckPredefinedAllocatorRestriction(source, name);
+            },
+        },
+        ompObject.u);
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
   // Simd Construct with Ordered Construct Nesting check
   // We cannot use CurrentDirectiveIsNested() here because
   // PushContextAndClauseSets() has not been called yet, it is
   // called individually for each construct.  Therefore a
   // dirContext_ size `1` means the current construct is nested
   if (dirContext_.size() >= 1) {
     if (GetSIMDNest() > 0) {
void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
   dirContext_.pop_back();
 }
 
 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);
   CheckIsVarPartOfAnotherVar(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)};
+  CheckPredefinedAllocatorRestriction(dir.source, objectList);
   dirContext_.pop_back();
 }
 
+void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
+  CheckAllowed(llvm::omp::Clause::OMPC_allocator);
+  // Note: Predefined allocators are stored in ScalarExpr as numbers
+  //   whereas custom allocators are stored as strings, so if the ScalarExpr
+  //   actually has an int value, then it must be a predefined allocator
+  isPredefinedAllocator = GetIntValue(x.v).has_value();
+  RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
+}
+
 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)
     CheckIsVarPartOfAnotherVar(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)
+    CheckPredefinedAllocatorRestriction(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(UseDeviceAddr, OMPC_use_device_addr)
 CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
 CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
 
-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)

flang/test/Semantics/omp-allocate08.f90

+! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp
+! OpenMP Version 5.0
+! 2.11.3 allocate Directive
+! If list items within the ALLOCATE 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
+
+module AllocateModule
+  INTEGER :: z
+end module
+
+subroutine allocate()
+use omp_lib
+use AllocateModule
+  integer, SAVE :: x
+  integer :: w
+  COMMON /CommonName/ y
+
+  integer(kind=omp_allocator_handle_kind) :: custom_allocator
+  integer(kind=omp_memspace_handle_kind) :: memspace
+  type(omp_alloctrait), dimension(1) :: trait
+  memspace = omp_default_mem_space
+  trait(1)%key = fallback
+  trait(1)%value = default_mem_fb
+  custom_allocator = omp_init_allocator(memspace, 1, trait)
+
+  !$omp allocate(x) allocator(omp_default_mem_alloc)
+  !$omp allocate(y) allocator(omp_default_mem_alloc)
+  !$omp allocate(z) allocator(omp_default_mem_alloc)
+
+  !$omp allocate(x)
+  !$omp allocate(y)
+  !$omp allocate(z)
+
+  !$omp allocate(w) allocator(custom_allocator)
+
+  !ERROR: If list items within the ALLOCATE 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
+  !$omp allocate(x) allocator(custom_allocator)
+  !ERROR: If list items within the ALLOCATE 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
+  !$omp allocate(y) allocator(custom_allocator)
+  !ERROR: If list items within the ALLOCATE 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
+  !$omp allocate(z) allocator(custom_allocator)
+end subroutine allocate