
gcc/cp/ChangeLog: PR fortran/96668 * cp-gimplify.c (cxx_omp_finish_clause): Add bool openacc arg. * cp-tree.h (cxx_omp_finish_clause): Likewise * semantics.c (handle_omp_for_class_iterator): Update call. gcc/fortran/ChangeLog: PR fortran/96668 * trans.h (gfc_omp_finish_clause): Add bool openacc arg. * trans-openmp.c (gfc_omp_finish_clause): Ditto. Use GOMP_MAP_ALWAYS_POINTER with PSET for pointers. (gfc_trans_omp_clauses): Like the latter and also if the always modifier is used. gcc/ChangeLog: PR fortran/96668 * gimplify.c (gimplify_omp_for): Add 'bool openacc' argument; update omp_finish_clause calls. (gimplify_adjust_omp_clauses_1, gimplify_adjust_omp_clauses, gimplify_expr, gimplify_omp_loop): Update omp_finish_clause and/or gimplify_for calls. * langhooks-def.h (lhd_omp_finish_clause): Add bool openacc arg. * langhooks.c (lhd_omp_finish_clause): Likewise. * langhooks.h (lhd_omp_finish_clause): Likewise. * omp-low.c (scan_sharing_clauses): Keep GOMP_MAP_TO_PSET cause for 'declare target' vars. include/ChangeLog: PR fortran/96668 * gomp-constants.h (GOMP_MAP_ALWAYS_POINTER_P): Define. libgomp/ChangeLog: PR fortran/96668 * libgomp.h (struct target_var_desc): Add has_null_ptr_assoc member. * target.c (gomp_map_vars_existing): Add always_to_flag flag. (gomp_map_vars_existing): Update call to it. (gomp_map_fields_existing): Likewise (gomp_map_vars_internal): Update PSET handling such that if a nullptr is now allocated or if GOMP_MAP_POINTER is used PSET is updated and pointer remapped. (GOMP_target_enter_exit_data): Hanlde GOMP_MAP_ALWAYS_POINTER like GOMP_MAP_POINTER. * testsuite/libgomp.fortran/map-alloc-ptr-1.f90: New test. * testsuite/libgomp.fortran/map-alloc-ptr-2.f90: New test.
114 lines
3.1 KiB
Fortran
114 lines
3.1 KiB
Fortran
! { dg-do run }
|
|
!
|
|
! PR fortran/96668
|
|
|
|
implicit none
|
|
integer, pointer :: p1(:), p2(:), p3(:)
|
|
integer, allocatable :: a1(:), a2(:)
|
|
p1 => null()
|
|
p3 => null()
|
|
|
|
!$omp target enter data map(to:p3)
|
|
|
|
!$omp target data map(a1, a2, p1)
|
|
!$omp target
|
|
if (allocated (a1)) stop 1
|
|
if (allocated (a2)) stop 1
|
|
if (associated (p1)) stop 1
|
|
if (associated (p3)) stop 1
|
|
!$omp end target
|
|
|
|
allocate (a1, source=[10,11,12,13,14])
|
|
allocate (a2, source=[10,11,12,13,14])
|
|
allocate (p1, source=[9,8,7,6,5,4])
|
|
allocate (p3, source=[4,5,6])
|
|
p2 => p1
|
|
|
|
!$omp target enter data map(to:p3)
|
|
|
|
! allocatable, TR9 requires 'always' modifier:
|
|
!$omp target map(always, tofrom: a1)
|
|
if (.not. allocated(a1)) stop 2
|
|
if (size(a1) /= 5) stop 3
|
|
if (any (a1 /= [10,11,12,13,14])) stop 5
|
|
a1(:) = [101, 102, 103, 104, 105]
|
|
!$omp end target
|
|
|
|
! allocatable, extension (OpenMP 6.0?): without 'always'
|
|
!$omp target
|
|
if (.not. allocated(a2)) stop 2
|
|
if (size(a2) /= 5) stop 3
|
|
if (any (a2 /= [10,11,12,13,14])) stop 5
|
|
a2(:) = [101, 102, 103, 104, 105]
|
|
!$omp end target
|
|
|
|
! pointer: target is automatically mapped
|
|
! without requiring an explicit mapping or even the always modifier
|
|
!$omp target !! map(always, tofrom: p1)
|
|
if (.not. associated(p1)) stop 7
|
|
if (size(p1) /= 6) stop 8
|
|
if (any (p1 /= [9,8,7,6,5,4])) stop 10
|
|
p1(:) = [-1, -2, -3, -4, -5, -6]
|
|
!$omp end target
|
|
|
|
!$omp target !! map(always, tofrom: p3)
|
|
if (.not. associated(p3)) stop 7
|
|
if (size(p3) /= 3) stop 8
|
|
if (any (p3 /= [4,5,6])) stop 10
|
|
p3(:) = [23,24,25]
|
|
!$omp end target
|
|
|
|
if (any (p1 /= [-1, -2, -3, -4, -5, -6])) stop 141
|
|
|
|
!$omp target exit data map(from:p3)
|
|
!$omp target exit data map(from:p3)
|
|
if (any (p3 /= [23,24,25])) stop 141
|
|
|
|
allocate (p1, source=[99,88,77,66,55,44,33])
|
|
|
|
!$omp target ! And this also should work
|
|
if (.not. associated(p1)) stop 7
|
|
if (size(p1) /= 7) stop 8
|
|
if (any (p1 /= [99,88,77,66,55,44,33])) stop 10
|
|
p1(:) = [-11, -22, -33, -44, -55, -66, -77]
|
|
!$omp end target
|
|
!$omp end target data
|
|
|
|
if (any (a1 /= [101, 102, 103, 104, 105])) stop 12
|
|
if (any (a2 /= [101, 102, 103, 104, 105])) stop 12
|
|
|
|
if (any (p1 /= [-11, -22, -33, -44, -55, -66, -77])) stop 142
|
|
if (any (p2 /= [-1, -2, -3, -4, -5, -6])) stop 143
|
|
|
|
|
|
block
|
|
integer, pointer :: tmp(:), tmp2(:), tmp3(:)
|
|
tmp => p1
|
|
tmp2 => p2
|
|
tmp3 => p3
|
|
!$omp target enter data map(to:p3)
|
|
|
|
!$omp target data map(to: p1, p2)
|
|
p1 => null ()
|
|
p2 => null ()
|
|
p3 => null ()
|
|
!$omp target map(always, tofrom: p1)
|
|
if (associated (p1)) stop 22
|
|
!$omp end target
|
|
if (associated (p1)) stop 22
|
|
|
|
!$omp target
|
|
if (associated (p2)) stop 22
|
|
!$omp end target
|
|
if (associated (p2)) stop 22
|
|
|
|
!$omp target
|
|
if (associated (p3)) stop 22
|
|
!$omp end target
|
|
if (associated (p3)) stop 22
|
|
!$omp end target data
|
|
!$omp target exit data map(from:p3)
|
|
deallocate(tmp, tmp2, tmp3)
|
|
end block
|
|
deallocate(a1, a2)
|
|
end
|