libgomp/testsuite/libgomp.fortran/is_device_ptr-3.f90

   1 module m
   2    use iso_c_binding
   3    implicit none
   4 contains
   5    subroutine s(x,y,z)
   6       type(c_ptr), optional :: x
   7       integer, pointer, optional :: y
   8       integer, allocatable, optional :: z
   9       logical is_present, is_null
  10       is_present = present(x)
  11       if (is_present) &
  12         is_null = .not. c_associated(x)
  13
  14       !$omp target is_device_ptr(x) has_device_addr(y) has_device_addr(z)
  15         if (is_present) then
  16           if (is_null) then
  17             if (c_associated(x)) stop 1
  18             if (associated(y)) stop 2
  19             if (allocated(z)) stop 3
  20           else
  21             if (.not. c_associated(x, c_loc(y))) stop 4
  22             if (y /= 7) stop 5
  23             if (z /= 9) stop 6
  24           end if
  25         end if
  26       !$omp end target
  27    end
  28 end
  29
  30 use m
  31 implicit none
  32 integer, pointer :: p
  33 integer, allocatable :: a
  34 p => null()
  35 call s()
  36 !$omp target data map(p,a) use_device_addr(p,a)
  37   call s(c_null_ptr, p, a)
  38 !$omp end target data
  39 allocate(p,a)
  40 p = 7
  41 a = 9
  42 !$omp target data map(p,a) use_device_addr(p,a)
  43   call s(c_loc(p), p, a)
  44 !$omp end target data
  45 deallocate(p,a)
  46 end