[flang][openacc] Enforce restriction on attach and detach variables

[clementval]

Summary

Each var argument to an attach or detach clause must be a
Fortran variable or array with the pointer or allocatable attribute.
This patch enforce this restruction.

[kiranchandramohan]

LGTM. Two nit suggestions/questions.

flang/lib/Semantics/resolve-directives.cpp

866

Nit: Would it be better to say the Argument %s instead of Variable %s since variable again occurs in the message?

874

Nit: Is there a test that hits this path?

[clementval]

Address review comments

[clementval]

flang/lib/Semantics/resolve-directives.cpp

866

Right it's nicer to avoid the double occurrences. Thx.

874

Added one.

flang/lib/Semantics/resolve-directives.cpp

void Post(const parser::AccStandaloneDirective &) {
     GetContext().withinConstruct = true;
   }
 
   bool Pre(const parser::OpenACCCacheConstruct &);
   void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
 
   void Post(const parser::AccDefaultClause &);
 
+  bool Pre(const parser::AccClause::Attach &);
+  bool Pre(const parser::AccClause::Detach &);
+
   bool Pre(const parser::AccClause::Copy &x) {
     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
     return false;
   }
 
   bool Pre(const parser::AccClause::Create &x) {
     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
private:
   Symbol *ResolveName(const parser::Name &);
   Symbol *ResolveAccCommonBlockName(const parser::Name *);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
       const parser::Name &, const Symbol &, Symbol::Flag);
   void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
   void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
+  void EnsureAllocatableOrPointer(
+      const llvm::acc::Clause clause, const parser::AccObjectList &objectList);
 };
 
 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
 public:
   explicit OmpAttributeVisitor(SemanticsContext &context)
       : DirectiveAttributeVisitor(context) {}
 
for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
 
     const auto &block{std::get<parser::Block>(loop->t)};
     const auto it{block.begin()};
     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
   }
   CHECK(level == 0);
 }
 
+void AccAttributeVisitor::EnsureAllocatableOrPointer(
+    const llvm::acc::Clause clause, const parser::AccObjectList &objectList) {
+  for (const auto &accObject : objectList.v) {
+    std::visit(
+        common::visitors{
+            [&](const parser::Designator &designator) {
+              const auto &lastName{GetLastName(designator)};
+              if (!IsAllocatableOrPointer(*lastName.symbol))
+                context_.Say(designator.source,
+                    "Variable `%s` on the %s clause must be a variable or "
+                    "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
+                    lastName.symbol->name(),
+                    parser::ToUpperCaseLetters(
+                        llvm::acc::getOpenACCClauseName(clause).str()));
+            },
+            [&](const auto &name) {
+              context_.Say(name.source,
+                  "Variable `%s` on the %s clause must be a variable or "
+                  "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
+                  name.symbol->name(),
+                  parser::ToUpperCaseLetters(
+                      llvm::acc::getOpenACCClauseName(clause).str()));
+            },
+        },
+        accObject.u);
+  }
+}
+
+bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) {
+  // Restriction - line 1708-1709
+  EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v);
+  return true;
+}
+
+bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) {
+  // Restriction - line 1715-1717
+  EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v);
+  return true;
+}
+
 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
   if (!dirContext_.empty()) {
     switch (x.v) {
     case llvm::acc::DefaultValue::ACC_Default_present:
       SetContextDefaultDSA(Symbol::Flag::AccPresent);
       break;
     case llvm::acc::DefaultValue::ACC_Default_none:
       SetContextDefaultDSA(Symbol::Flag::AccNone);

flang/test/Semantics/OpenACC/acc-data.f90

program openacc_data_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
+  real(8), dimension(:), allocatable :: dd
+  real(8), pointer :: p
   logical :: ifCondition = .TRUE.
   type(atype) :: t
   type(atype), dimension(10) :: ta
 
   real(8), dimension(N) :: a, f, g, h
 
   !ERROR: At least one of ATTACH, COPYIN, CREATE clause must appear on the ENTER DATA directive
   !$acc enter data
program openacc_data_validity
   !$acc enter data create(aa) wait(1)
 
   !$acc enter data create(aa) wait(wait1)
 
   !$acc enter data create(aa) wait(wait1, wait2)
 
   !$acc enter data create(aa) wait(wait1) wait(wait2)
 
+  !ERROR: Variable `bb` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
   !$acc enter data attach(bb)
 
   !ERROR: At least one of COPYOUT, DELETE, DETACH clause must appear on the EXIT DATA directive
   !$acc exit data
 
   !ERROR: Modifier is not allowed for the COPYOUT clause on the EXIT DATA directive
   !$acc exit data copyout(zero: i)
 
   !$acc exit data delete(aa)
 
   !$acc exit data delete(aa) finalize
 
   !ERROR: At most one FINALIZE clause can appear on the EXIT DATA directive
   !$acc exit data delete(aa) finalize finalize
 
+  !ERROR: Variable `cc` on the DETACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
   !$acc exit data detach(cc)
 
   !$acc exit data copyout(bb)
 
   !$acc exit data delete(aa) if(.TRUE.)
 
   !$acc exit data delete(aa) if(ifCondition)
 
program openacc_data_validity
   !$acc end data
 
   !$acc data create(aa, bb(:,:)) create(zero: cc(:,:))
   !$acc end data
 
   !$acc data no_create(aa) present(bb, cc)
   !$acc end data
 
-  !$acc data deviceptr(aa) attach(bb, cc)
+  !$acc data deviceptr(aa) attach(dd, p)
   !$acc end data
 
   !$acc data copy(aa, bb) default(none)
   !$acc end data
 
   !$acc data copy(aa, bb) default(present)
   !$acc end data
 

flang/test/Semantics/OpenACC/acc-kernels-loop.f90

program openacc_kernels_loop_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
+  real(8), dimension(:), allocatable :: dd
+  real(8), pointer :: p
   logical :: ifCondition = .TRUE.
   type(atype) :: t
   type(atype), dimension(10) :: ta
 
   real(8), dimension(N) :: a, f, g, h
 
   !$acc kernels loop
   do i = 1, N
do i = 1, N
     a(i) = 3.14
   end do
 
   !$acc kernels loop deviceptr(aa, bb) no_create(cc)
   do i = 1, N
     a(i) = 3.14
   end do
 
-  !$acc kernels loop attach(aa, bb, cc)
+  !ERROR: Variable `aa` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
+  !$acc kernels loop attach(aa, dd, p)
   do i = 1, N
     a(i) = 3.14
   end do
 
   !$acc kernels loop private(aa, bb, cc)
   do i = 1, N
     a(i) = 3.14
   end do

flang/test/Semantics/OpenACC/acc-kernels.f90

program openacc_kernels_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
+  real(8), dimension(:), allocatable :: dd
+  real(8), pointer :: p
   logical :: ifCondition = .TRUE.
   type(atype) :: t
   type(atype), dimension(10) :: ta
   real(8), dimension(N) :: a, f, g, h
 
   !$acc kernels async
   !$acc end kernels
 
program openacc_kernels_validity
   !$acc end kernels
 
   !$acc kernels copyin(readonly: aa, bb) create(zero: cc)
   !$acc end kernels
 
   !$acc kernels deviceptr(aa, bb) no_create(cc)
   !$acc end kernels
 
-  !$acc kernels attach(aa, bb, cc)
+  !ERROR: Variable `aa` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
+  !$acc kernels attach(dd, p, aa)
   !$acc end kernels
 
   !ERROR: PRIVATE clause is not allowed on the KERNELS directive
   !$acc kernels private(aa, bb, cc)
   !$acc end kernels
 
   !$acc kernels default(none)
   !$acc end kernels

flang/test/Semantics/OpenACC/acc-parallel.f90

program openacc_parallel_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
+  real(8), dimension(:), allocatable :: dd
+  real(8), pointer :: p
   logical :: ifCondition = .TRUE.
   real(8), dimension(N) :: a, f, g, h
 
   !$acc parallel device_type(*) num_gangs(2)
   !$acc loop
   do i = 1, N
     a(i) = 3.14
   end do
program openacc_parallel_validity
   !$acc end parallel
 
   !$acc parallel copyin(readonly: aa, bb) create(zero: cc)
   !$acc end parallel
 
   !$acc parallel deviceptr(aa, bb) no_create(cc)
   !$acc end parallel
 
-  !$acc parallel attach(aa, bb, cc)
+  !ERROR: Variable `cc` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
+  !$acc parallel attach(dd, p, cc)
   !$acc end parallel
 
   !$acc parallel private(aa) firstprivate(bb, cc)
   !$acc end parallel
 
   !$acc parallel default(none)
   !$acc end parallel
 

flang/test/Semantics/OpenACC/acc-serial.f90

program openacc_serial_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   integer :: async1
   integer :: wait1, wait2
   real :: reduction_r
   logical :: reduction_l
   real(8), dimension(N, N) :: aa, bb, cc
+  real(8), dimension(:), allocatable :: dd
+  real(8), pointer :: p
   logical :: ifCondition = .TRUE.
   type(atype) :: t
   type(atype), dimension(10) :: ta
 
   real(8), dimension(N) :: a, f, g, h
 
   !$acc serial
   !ERROR: Directive SET may not be called within a compute region
program openacc_serial_validity
   !$acc end serial
 
   !$acc serial copyin(readonly: aa, bb) create(zero: cc)
   !$acc end serial
 
   !$acc serial deviceptr(aa, bb) no_create(cc)
   !$acc end serial
 
-  !$acc serial attach(aa, bb, cc)
+  !ERROR: Variable `aa` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
+  !$acc serial attach(aa, dd, p)
   !$acc end serial
 
   !$acc serial firstprivate(bb, cc)
   !$acc end serial
 
   !$acc serial private(aa)
   !$acc end serial