97 lines
2.3 KiB
Fortran
97 lines
2.3 KiB
Fortran
! Verify that a 'enter data'ed 'pointer' object creates a persistent, visible device copy
|
|
|
|
! { dg-do run }
|
|
! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } }
|
|
|
|
module m
|
|
implicit none
|
|
contains
|
|
|
|
subroutine verify_a (a_ref, a)
|
|
implicit none
|
|
integer, dimension (:, :, :), allocatable :: a_ref
|
|
integer, dimension (:, :, :), pointer :: a
|
|
|
|
!$acc routine seq
|
|
|
|
if (any (lbound (a) /= lbound (a_ref))) stop 101
|
|
if (any (ubound (a) /= ubound (a_ref))) stop 102
|
|
if (size (a) /= size (a_ref)) stop 103
|
|
end subroutine verify_a
|
|
|
|
end module m
|
|
|
|
program main
|
|
use m
|
|
use openacc
|
|
implicit none
|
|
integer, parameter :: n = 30
|
|
integer, dimension (:, :, :), allocatable, target :: a1, a2
|
|
integer, dimension (:, :, :), pointer :: p
|
|
|
|
allocate (a1(1:n, 0:n-1, 10:n/2))
|
|
!$acc enter data create(a1)
|
|
allocate (a2(3:n/3, 10:n, n-10:n+10))
|
|
!$acc enter data create(a2)
|
|
|
|
p => a1
|
|
call verify_a(a1, p)
|
|
|
|
! 'p' object isn't present on the device.
|
|
!$acc parallel ! Implicit 'copy(p)'; creates 'p' object...
|
|
call verify_a(a1, p)
|
|
!$acc end parallel ! ..., and deletes it again.
|
|
|
|
p => a2
|
|
call verify_a(a2, p)
|
|
|
|
! 'p' object isn't present on the device.
|
|
!$acc parallel ! Implicit 'copy(p)'; creates 'p' object...
|
|
call verify_a(a2, p)
|
|
!$acc end parallel ! ..., and deletes it again.
|
|
|
|
p => a1
|
|
|
|
!$acc enter data create(p)
|
|
! 'p' object is now present on the device (visible device copy).
|
|
!TODO PR96080 if (.not. acc_is_present (p)) stop 1
|
|
|
|
!$acc parallel
|
|
! On the device, got created as 'p => a1'.
|
|
call verify_a(a1, p)
|
|
!$acc end parallel
|
|
call verify_a(a1, p)
|
|
|
|
!$acc parallel
|
|
p => a2
|
|
! On the device, 'p => a2' is now set.
|
|
call verify_a(a2, p)
|
|
!$acc end parallel
|
|
! On the host, 'p => a1' persists.
|
|
call verify_a(a1, p)
|
|
|
|
!$acc parallel
|
|
! On the device, 'p => a2' persists.
|
|
call verify_a(a2, p)
|
|
!$acc end parallel
|
|
! On the host, 'p => a1' still persists.
|
|
call verify_a(a1, p)
|
|
|
|
p => a2
|
|
|
|
!$acc parallel
|
|
p => a1
|
|
! On the device, 'p => a1' is now set.
|
|
call verify_a(a1, p)
|
|
!$acc end parallel
|
|
! On the host, 'p => a2' persists.
|
|
call verify_a(a2, p)
|
|
|
|
!$acc parallel
|
|
! On the device, 'p => a1' persists.
|
|
call verify_a(a1, p)
|
|
!$acc end parallel
|
|
! On the host, 'p => a2' still persists.
|
|
call verify_a(a2, p)
|
|
|
|
end program main
|