libgomp/testsuite/libgomp.fortran/map-subarray-3.f90

   1 ! { dg-do run }
   2
   3 module mymod
   4 type G
   5 integer :: x, y
   6 integer, pointer :: arr(:)
   7 integer :: z
   8 end type G
   9 end module mymod
  10
  11 program myprog
  12 use mymod
  13
  14 integer, target :: arr1(10)
  15 integer, target :: arr2(10)
  16 integer, target :: arr3(10)
  17 type(G), dimension(3) :: gvar
  18
  19 integer :: i, j
  20
  21 gvar(1)%arr => arr1
  22 gvar(2)%arr => arr2
  23 gvar(3)%arr => arr3
  24
  25 gvar(1)%arr = 0
  26 gvar(2)%arr = 0
  27 gvar(3)%arr = 0
  28
  29 i = 1
  30 j = 1
  31
  32 ! Here 'gvar(i)' and 'gvar(j)' are the same element, so this should work.
  33 ! This generates a whole-array mapping for gvar(i)%arr, but with the
  34 ! "runtime implicit" bit set so the smaller subarray gvar(j)%arr(1:5) takes
  35 ! precedence.
  36
  37 !$omp target map(gvar(i)%arr, gvar(j)%arr(1:5))
  38 gvar(i)%arr(1) = gvar(i)%arr(1) + 1
  39 gvar(j)%arr(1) = gvar(j)%arr(1) + 2
  40 !$omp end target
  41
  42 !$omp target map(gvar(i)%arr(1:5), gvar(j)%arr)
  43 gvar(i)%arr(1) = gvar(i)%arr(1) + 3
  44 gvar(j)%arr(1) = gvar(j)%arr(1) + 4
  45 !$omp end target
  46
  47 ! For these ones, we know the array index is the same, so we can just
  48 ! drop the whole-array mapping.
  49
  50 !$omp target map(gvar(i)%arr, gvar(i)%arr(1:5))
  51 gvar(i)%arr(1) = gvar(i)%arr(1) + 1
  52 gvar(i)%arr(1) = gvar(j)%arr(1) + 2
  53 !$omp end target
  54
  55 !$omp target map(gvar(i)%arr(1:5), gvar(i)%arr)
  56 gvar(i)%arr(1) = gvar(i)%arr(1) + 3
  57 gvar(i)%arr(1) = gvar(j)%arr(1) + 4
  58 !$omp end target
  59
  60 if (gvar(1)%arr(1).ne.20) stop 1
  61
  62 end program myprog