libgomp/testsuite/libgomp.fortran/target-enter-data-7.f90

   1 module m
   2   implicit none
   3   character(len=:), allocatable :: strA(:), strA2
   4   character(len=:), pointer :: strP(:), strP2
   5   !$omp declare target enter(strA,strA2,strP,strP2)
   6 contains
   7   subroutine opt_map(str1, str2, str3)
   8     character(len=:), allocatable :: str1, str2, str3, str4
   9     optional :: str2, str3
  10
  11     if (.not.present(str2)) error stop
  12     if (present(str3))  error stop
  13
  14     !$omp target map(str1,str2,str3,str4)
  15       if (allocated(str1)) error stop
  16       if (allocated(str2)) error stop
  17       if (present(str3)) error stop
  18       if (allocated(str4)) error stop
  19     !$omp end target
  20   end
  21   subroutine call_opt()
  22     character(len=:), allocatable :: str1, str2
  23     call opt_map(str1, str2)
  24   end
  25   subroutine test
  26    !$omp declare target
  27    if (.not. allocated(strA)) error stop
  28    !if (.not. allocated(strA2)) error stop
  29    if (.not. associated(strP)) error stop
  30    !if (.not. associated(strP2)) error stop
  31
  32     ! ensure length was updated as well
  33     if (len(strA) /= 3) error stop
  34     if (len(strA2) /= 5) error stop
  35     if (len(strP) /= 4) error stop
  36     if (len(strP2) /= 8) error stop
  37 !    if (any (strA /= ['Hav', 'e f', 'un!'])) error stop
  38 !    if (strA2 /= 'Hello') error stop
  39 !    if (any (strP /= ['abcd', 'efgh', 'ijkl'])) error stop
  40 !    if (strP2 /= 'TestCase') error stop
  41 !
  42 !    strA = ['123', '456', '789']
  43 !    strA2 = 'World'
  44 !    strP = ['ABCD', 'EFGH', 'IJKL']
  45 !    strP2 = 'Passed!!'
  46   end
  47 end
  48
  49 program main
  50   use m
  51   implicit none
  52   call call_opt
  53
  54   strA = ['Hav', 'e f', 'un!']
  55   strA2 = 'Hello'
  56   allocate(character(len=4) :: strP(3))
  57   strP = ['abcd', 'efgh', 'ijkl']
  58   allocate(character(len=8) :: strP2)
  59   strP2 = 'TestCase'
  60
  61   !$omp target enter data map(always, to: strA, strA2)
  62   !$omp target enter data map(to: strP, strP2)
  63   !$omp target
  64     call test()
  65   !$omp end target
  66   !$omp target exit data map(always, from: strA, strA2, strP, strP2)
  67
  68   if (len(strA) /= 3) error stop
  69   if (len(strA2) /= 5) error stop
  70   if (len(strP) /= 4) error stop
  71   if (len(strP2) /= 8) error stop
  72 !  if (any (strA /= ['123', '456', '789'])) error stop
  73 !  if (strA2 /= 'World') error stop
  74 !  if (any(strP /= ['ABCD', 'EFGH', 'IJKL'])) error stop
  75 !  if (strP2 /= 'Passed!!') error stop
  76
  77 !  deallocate(strP, strP2, strA, strA2)
  78 end