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