mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-12-14 22:43:39 +08:00
bc4ed079dc
Attach and detach operations are not supposed to affect structural or dynamic reference counts for OpenACC. Previously they did so, which led to subtle problems in some circumstances. We can avoid reference-counting attach/detach operations by extending and slightly repurposing the do_detach field in target_var_desc. It is now called is_attach to better reflect its new role. 2020-07-27 Julian Brown <julian@codesourcery.com> Thomas Schwinge <thomas@codesourcery.com> libgomp/ * libgomp.h (struct target_var_desc): Rename do_detach field to is_attach. * oacc-mem.c (goacc_exit_datum_1): Add assert. Don't set finalize for GOMP_MAP_FORCE_DETACH. Update checking to use is_attach field. (goacc_enter_data_internal): Don't affect reference counts for attach mappings. (goacc_exit_data_internal): Don't affect reference counts for detach mappings. * target.c (gomp_map_vars_existing): Don't affect reference counts for attach mappings. (gomp_map_vars_internal): Set renamed is_attach flag unconditionally to mark attach mappings. (gomp_unmap_vars_internal): Use is_attach flag to prevent affecting reference count for attach mappings. * testsuite/libgomp.oacc-c-c++-common/mdc-refcount-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/mdc-refcount-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/mdc-refcount-2.c: New test. * testsuite/libgomp.oacc-fortran/deep-copy-6-no_finalize.F90: Mark test as shouldfail. * testsuite/libgomp.oacc-fortran/deep-copy-6.f90: Adjust to fail gracefully in no-finalize mode. Co-Authored-By: Thomas Schwinge <thomas@codesourcery.com>
77 lines
1.5 KiB
Fortran
77 lines
1.5 KiB
Fortran
! { dg-do run }
|
|
|
|
! Test of attachment counters and finalize.
|
|
|
|
program dtype
|
|
use openacc
|
|
implicit none
|
|
integer, parameter :: n = 512
|
|
type mytype
|
|
integer, allocatable :: a(:)
|
|
integer, allocatable :: b(:)
|
|
end type mytype
|
|
integer i
|
|
|
|
type(mytype), target :: var
|
|
integer, pointer :: hostptr(:)
|
|
|
|
allocate(var%a(1:n))
|
|
allocate(var%b(1:n))
|
|
|
|
hostptr => var%a
|
|
|
|
!$acc data copy(var)
|
|
|
|
do i = 1, n
|
|
var%a(i) = 0
|
|
var%b(i) = 0
|
|
end do
|
|
|
|
!$acc enter data copyin(var%a(5:n - 5), var%b(5:n - 5))
|
|
|
|
do i = 1,20
|
|
!$acc enter data attach(var%a)
|
|
end do
|
|
|
|
!$acc parallel loop
|
|
do i = 5,n - 5
|
|
var%a(i) = i
|
|
var%b(i) = i * 2
|
|
end do
|
|
!$acc end parallel loop
|
|
|
|
if (.not. acc_is_present(var%a(5:n - 5))) stop 11
|
|
if (.not. acc_is_present(var%b(5:n - 5))) stop 12
|
|
if (.not. acc_is_present(var)) stop 13
|
|
!$acc exit data copyout(var%a(5:n - 5), var%b(5:n - 5)) finalize
|
|
if (acc_get_device_type() .ne. acc_device_host) then
|
|
if (acc_is_present(var%a(5:n - 5))) stop 21
|
|
if (acc_is_present(var%b(5:n - 5))) stop 22
|
|
end if
|
|
if (.not. acc_is_present(var)) stop 23
|
|
|
|
!$acc end data
|
|
|
|
! See 'deep-copy-6-no_finalize.F90'.
|
|
if (.not. associated(hostptr, var%a)) stop 30
|
|
|
|
do i = 1,4
|
|
if (var%a(i) .ne. 0) stop 1
|
|
if (var%b(i) .ne. 0) stop 2
|
|
end do
|
|
|
|
do i = 5,n - 5
|
|
if (i .ne. var%a(i)) stop 3
|
|
if (i * 2 .ne. var%b(i)) stop 4
|
|
end do
|
|
|
|
do i = n - 4,n
|
|
if (var%a(i) .ne. 0) stop 5
|
|
if (var%b(i) .ne. 0) stop 6
|
|
end do
|
|
|
|
deallocate(var%a)
|
|
deallocate(var%b)
|
|
|
|
end program dtype
|