libgomp/testsuite/libgomp.fortran/target-map-1.f90

   1 ! PR fortran/67311
   2
   3 implicit none
   4   TYPE myType
   5     integer :: A
   6     TYPE(myType), DIMENSION(:), POINTER :: x
   7     TYPE(myType), DIMENSION(:), contiguous, POINTER :: y
   8     integer :: B
   9   END TYPE myType
  10   call openmp_sub
  11 contains
  12   subroutine openmp_sub
  13     type(myType) :: argument
  14
  15     !$OMP PARALLEL DEFAULT(NONE) PRIVATE(argument)
  16       argument%a = 5
  17       argument%b = 7
  18       call foo(argument)
  19       if (.not.associated(argument%x) .or. size(argument%x) /= 2) stop 2
  20       if (argument%a /= 8 .or. argument%b /= 9 &
  21           .or. any(argument%x(:)%a /= [2, 3]) &
  22           .or. any(argument%x(:)%b /= [9, 1])) stop 3
  23       if (.not.associated(argument%y) .or. size(argument%y) /= 3) stop 4
  24       if (any(argument%y(:)%a /= [11, 22, 33]) &
  25           .or. any(argument%y(:)%b /= [44, 55, 66])) stop 5
  26       deallocate (argument%x, argument%y)
  27     !$OMP END PARALLEL
  28   end subroutine openmp_sub
  29   subroutine foo(x)
  30     type(myType), intent(inout) :: x
  31     !$omp declare target
  32     if (x%a /= 5 .or. x%b /= 7) stop 1
  33     x%a = 8; x%b = 9
  34     allocate (x%x(2))
  35     x%x(:)%a = [2, 3]
  36     x%x(:)%b = [9, 1]
  37     allocate (x%y(3))
  38     x%y(:)%a = [11, 22, 33]
  39     x%y(:)%b = [44, 55, 66]
  40   end subroutine
  41 end