view libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 @ 157:dafe684d005c

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:08:54 +0900
parents 1830386684a0
children
line wrap: on
line source

! { dg-do run }
! Test whether use_device_ptr properly handles OPTIONAL arguments
! (Only case of present arguments is tested)
program test_it
  implicit none
  integer, target :: ixx
  integer, pointer :: ptr_i, ptr_null

  ptr_i => ixx
  call foo(ptr_i)

  ptr_null => null()
  call bar(ptr_null)

  call foo_absent()
  call bar_absent()
contains
  subroutine foo(ii)
    integer, pointer, optional :: ii

    if (.not.present(ii)) stop 1
    if (.not.associated(ii, ixx)) stop 2
    !$omp target data map(to:ixx) use_device_ptr(ii)
    if (.not.present(ii)) stop 3
    if (.not.associated(ii)) stop 4
    !$omp end target data
  end subroutine foo

  ! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
  subroutine bar(jj)
    integer, pointer, optional :: jj

    if (.not.present(jj)) stop 5
    if (associated(jj)) stop 6
    !$omp target data map(to:ixx) use_device_ptr(jj)
    if (.not.present(jj)) stop 7
   if (associated(jj)) stop 8
    !$omp end target data
  end subroutine bar

  subroutine foo_absent(ii)
    integer, pointer, optional :: ii

    if (present(ii)) STOP 31
    !$omp target data map(to:ixx) use_device_ptr(ii)
    if (present(ii)) STOP 32
    !$omp end target data
  end subroutine foo_absent

  ! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
  subroutine bar_absent(jj)
    integer, pointer, optional :: jj

    if (present(jj)) STOP 41
    !$omp target data map(to:ixx) use_device_ptr(jj)
    if (present(jj)) STOP 42
    !$omp end target data
  end subroutine bar_absent
end program test_it