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