Mercurial > hg > CbC > CbC_gcc
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