libgomp/testsuite/libgomp.fortran/target-memcpy-async-1.f90

   1 ! Test for omp_target_memcpy_async without considering dependence objects.
   2
   3 program main
   4   use omp_lib
   5   use iso_c_binding
   6   implicit none (external, type)
   7   integer :: d, id, i, j
   8   integer, target :: q(0:127), q2(0:127)
   9   type(c_ptr) :: p
  10   integer(omp_depend_kind) :: obj(1:0)
  11
  12   d = omp_get_default_device ()
  13   id = omp_get_initial_device ()
  14
  15   if (d < 0 .or. d >= omp_get_num_devices ()) &
  16     d = id
  17
  18   p = omp_target_alloc (130 * c_sizeof (q), d)
  19   if (.not. c_associated (p)) &
  20     stop 0  ! okay
  21
  22   q = [(i, i = 0, 127)]
  23   if (omp_target_memcpy_async (p, c_loc (q), 128 * sizeof (q(0)), 0_c_size_t, &
  24       0_c_size_t, d, id, 0, obj) /= 0) &
  25     stop 1
  26
  27   !$omp taskwait
  28
  29   q2 = [(0, i = 0, 127)]
  30   if (omp_target_memcpy_async (c_loc (q2), p, 128 * sizeof (q2(0)), 0_c_size_t,&
  31       0_c_size_t, id, d, 0, obj) /= 0) &
  32     stop 2
  33
  34   !$omp taskwait
  35
  36   do j = 0, 127
  37     if (q(j) /= q2(j)) &
  38       stop 3
  39   end do
  40
  41   call omp_target_free (p, d)
  42 end program main