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

   1 ! { dg-additional-options "-fdump-tree-original" }
   2
   3 ! PR fortran/98476
   4
   5 program abc
   6   implicit none
   7   integer a, b
   8
   9   a = 83
  10   b = 73
  11   call test(a, b)
  12
  13 contains
  14   subroutine test(aa, bb)
  15     use iso_c_binding, only: c_ptr, c_loc, c_f_pointer
  16     integer :: aa, bb
  17     integer, target :: cc, dd
  18     type(c_ptr) :: pcc, pdd
  19     cc = 131
  20     dd = 484
  21
  22     !$omp target enter data map(to: aa, bb, cc, dd)
  23
  24     !$omp target data use_device_ptr(aa, cc) use_device_addr(bb, dd)
  25       pcc = c_loc(cc)
  26       pdd = c_loc(dd)
  27
  28       ! TODO: has_device_addr(cc, dd)
  29       !$omp target is_device_ptr(aa, bb)
  30         if (aa /= 83 .or. bb /= 73) stop 1
  31         aa = 42
  32         bb = 43
  33         block
  34           integer, pointer :: c2, d2
  35           call c_f_pointer(pcc, c2)
  36           call c_f_pointer(pdd, d2)
  37           if (c2 /= 131 .or. d2 /= 484) stop 2
  38           c2 = 44
  39           d2 = 45
  40         end block
  41       !$omp end target
  42     !$omp end target data
  43
  44     !$omp target exit data map(from:aa, bb, cc, dd)
  45
  46     if (aa /= 42 .or. bb /= 43) stop 3
  47     if (cc /= 44 .or. dd /= 45) stop 5
  48   endsubroutine
  49 end program
  50
  51 ! { dg-final { scan-tree-dump-times "omp target data .*use_device_addr\\(aa\\)" 1 "original" } }
  52 ! { dg-final { scan-tree-dump-times "omp target data .*use_device_addr\\(bb\\)" 1 "original" } }
  53 ! { dg-final { scan-tree-dump-times "omp target data .*use_device_addr\\(cc\\)" 1 "original" } }
  54 ! { dg-final { scan-tree-dump-times "omp target data .*use_device_addr\\(dd\\)" 1 "original" } }