libgomp/testsuite/libgomp.fortran/target-has-device-addr-4.f90

   1 ! Test allocatables in HAS_DEVICE_ADDR.
   2
   3 program main
   4   use omp_lib
   5   use iso_c_binding
   6   implicit none
   7
   8   integer, parameter :: N = 5
   9   integer, allocatable :: x
  10   integer, allocatable :: y(:)
  11   call scalar_dummy (x)
  12   call array_dummy (y)
  13   call array_dummy_optional (y)
  14   call array_dummy_optional ()
  15
  16 contains
  17   subroutine scalar_dummy (a)
  18     integer, allocatable :: a
  19
  20     allocate (a)
  21     a = 24
  22
  23     !$omp target data map(a) use_device_addr(a)
  24       !$omp target has_device_addr(a)
  25         a = 42
  26       !$omp end target
  27     !$omp end target data
  28     if (a /= 42) stop 1
  29
  30     deallocate (a)
  31   end subroutine scalar_dummy
  32
  33   subroutine array_dummy (a)
  34     integer, allocatable :: a(:)
  35     integer :: i
  36
  37     allocate (a(N))
  38     a = 42
  39
  40     !$omp target data map(a) use_device_addr(a)
  41       !$omp target has_device_addr(a)
  42         a = [(i, i=1, N)]
  43       !$omp end target
  44     !$omp end target data
  45     if (any (a /= [(i, i=1, N)])) stop 2
  46
  47     deallocate (a)
  48   end subroutine array_dummy
  49
  50   subroutine array_dummy_optional (a)
  51     integer, optional, allocatable :: a(:)
  52     integer :: i
  53
  54     if (present (a)) then
  55       allocate (a(N))
  56       a = 42
  57     end if
  58
  59     !$omp target data map(a) use_device_addr(a)
  60       !$omp target has_device_addr(a)
  61         if (present (a)) a = [(i, i=1, N)]
  62       !$omp end target
  63     !$omp end target data
  64
  65     if (present (a)) then
  66       if (any (a /= [(i, i=1, N)])) stop 2
  67       deallocate (a)
  68     end if
  69   end subroutine array_dummy_optional
  70
  71 end program main