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