libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90

   1 ! Test whether use_device_ptr properly handles OPTIONAL arguments
   2 ! (Only case of present arguments is tested)
   3 program test_it
   4   implicit none
   5   integer, target :: ixx
   6   integer, pointer :: ptr_i, ptr_null
   7
   8   ptr_i => ixx
   9   call foo(ptr_i)
  10
  11   ptr_null => null()
  12   call bar(ptr_null)
  13 contains
  14   subroutine foo(ii)
  15     integer, pointer, optional :: ii
  16
  17     if (.not.present(ii)) call abort()
  18     if (.not.associated(ii, ixx)) call abort()
  19     !$omp target data map(to:ixx) use_device_ptr(ii)
  20     if (.not.present(ii)) call abort()
  21     if (.not.associated(ii)) call abort()
  22     !$omp end target data
  23   end subroutine foo
  24
  25   ! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
  26   subroutine bar(jj)
  27     integer, pointer, optional :: jj
  28
  29     if (.not.present(jj)) call abort()
  30     if (associated(jj)) call abort()
  31     !$omp target data map(to:ixx) use_device_ptr(jj)
  32     if (.not.present(jj)) call abort()
  33    if (associated(jj)) call abort()
  34     !$omp end target data
  35   end subroutine bar
  36 end program test_it