As mentioned in the blurb for the previous patch, an "attach" operation
for a Fortran pointer with an array descriptor must copy that array
descriptor to the target.  This patch arranges for that to be so.

OK?

Julian

ChangeLog

        gcc/fortran/
        * trans-openmp.c (gfc_trans_omp_clauses): Copy array descriptor to
        target for attach clauses when appropriate.

        libgomp/
        * testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90: New test.
---
 gcc/fortran/trans-openmp.c                    | 40 ++++++++++++++-
 .../attach-descriptor-1.f90                   | 51 +++++++++++++++++++
 2 files changed, 89 insertions(+), 2 deletions(-)
 create mode 100644 
libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 02c40fdc660..909a86795e0 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2573,8 +2573,44 @@ gfc_trans_omp_clauses (stmtblock_t *block, 
gfc_omp_clauses *clauses,
                        }
                    }
                  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
-                     && n->u.map_op != OMP_MAP_ATTACH
-                     && n->u.map_op != OMP_MAP_DETACH)
+                     && (n->u.map_op == OMP_MAP_ATTACH
+                         || n->u.map_op == OMP_MAP_DETACH))
+                   {
+                     tree type = TREE_TYPE (decl);
+                     tree data = gfc_conv_descriptor_data_get (decl);
+                     if (present)
+                       data = gfc_build_cond_assign_expr (block, present,
+                                                          data,
+                                                          null_pointer_node);
+                     tree ptr
+                       = fold_convert (build_pointer_type (char_type_node),
+                                       data);
+                     ptr = build_fold_indirect_ref (ptr);
+                     /* Standalone attach clauses used with arrays with
+                        descriptors must copy the descriptor to the target,
+                        else they won't have anything to perform the
+                        attachment onto (see OpenACC 2.6, "2.6.3. Data
+                        Structures with Pointers").  */
+                     OMP_CLAUSE_DECL (node) = ptr;
+                     node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+                     OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
+                     OMP_CLAUSE_DECL (node2) = decl;
+                     OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
+                     node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+                     if (n->u.map_op == OMP_MAP_ATTACH)
+                       {
+                         OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH);
+                         n->u.map_op = OMP_MAP_ALLOC;
+                       }
+                     else  /* OMP_MAP_DETACH.  */
+                       {
+                         OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_DETACH);
+                         n->u.map_op = OMP_MAP_RELEASE;
+                       }
+                     OMP_CLAUSE_DECL (node3) = data;
+                     OMP_CLAUSE_SIZE (node3) = size_int (0);
+                   }
+                 else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
                    {
                      tree type = TREE_TYPE (decl);
                      tree ptr = gfc_conv_descriptor_data_get (decl);
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90 
b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90
new file mode 100644
index 00000000000..2dd1a6fa5b6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90
@@ -0,0 +1,51 @@
+program att
+  use openacc
+  implicit none
+  type t
+    integer :: arr1(10)
+    integer, allocatable :: arr2(:)
+  end type t
+  integer :: i
+  type(t) :: myvar
+  integer, target :: tarr(10)
+  integer, pointer :: myptr(:)
+
+  allocate(myvar%arr2(10))
+
+  do i=1,10
+    myvar%arr1(i) = 0
+    myvar%arr2(i) = 0
+    tarr(i) = 0
+  end do
+
+  call acc_copyin(myvar)
+  call acc_copyin(myvar%arr2)
+  call acc_copyin(tarr)
+
+  myptr => tarr
+
+  !$acc enter data attach(myvar%arr2, myptr)
+
+  ! FIXME: This warning is emitted on the wrong line number.
+  ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target 
openacc_nvidia_accel_selected } 36 }
+  !$acc serial present(myvar%arr2)
+  do i=1,10
+    myvar%arr1(i) = i
+    myvar%arr2(i) = i
+  end do
+  myptr(3) = 99
+  !$acc end serial
+
+  !$acc exit data detach(myvar%arr2, myptr)
+
+  call acc_copyout(myvar%arr2)
+  call acc_copyout(myvar)
+  call acc_copyout(tarr)
+
+  do i=1,10
+    if (myvar%arr1(i) .ne. i) stop 1
+    if (myvar%arr2(i) .ne. i) stop 2
+  end do
+  if (tarr(3) .ne. 99) stop 3
+
+end program att
-- 
2.23.0

Reply via email to