blob: 150df6f8a4ff8411b89b3c5a093de817c548efb2 [file] [log] [blame]
program main
use omp_lib
use iso_c_binding
implicit none (external, type)
integer :: d, id, n, shared_mem, i
integer, target :: a(1:128)
type(c_ptr) :: p
d = omp_get_default_device ()
id = omp_get_initial_device ()
n = omp_get_num_devices ()
if (d < 0 .or. d >= n) &
d = id
if (omp_target_is_accessible (p, c_sizeof (d), n) /= 1) &
stop 1
if (omp_target_is_accessible (p, c_sizeof (d), id) /= 1) &
stop 2
if (omp_target_is_accessible (p, c_sizeof (d), omp_initial_device) /= 1) &
stop 3
if (omp_target_is_accessible (p, c_sizeof (d), -5) /= 0) &
stop 4
if (omp_target_is_accessible (p, c_sizeof (d), n + 1) /= 0) &
stop 5
! Currently, a host pointer is accessible if the device supports shared
! memory or omp_target_is_accessible is executed on the host. This
! test case must be adapted when unified shared memory is avialable.
do d = 0, omp_get_num_devices ()
shared_mem = 0;
!$omp target map (alloc: shared_mem) device (d)
shared_mem = 1;
!$omp end target
if (omp_target_is_accessible (p, c_sizeof (d), d) /= shared_mem) &
stop 6;
if (omp_target_is_accessible (c_loc (a), 128 * sizeof (a(1)), d) /= shared_mem) &
stop 7;
do i = 1, 128
if (omp_target_is_accessible (c_loc (a(i)), sizeof (a(i)), d) /= shared_mem) &
stop 8;
end do
end do
end program main