| ! 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 |