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

   1 ! Check that 'map(alloc:' properly works with
   2 ! - deferred-length character strings
   3 ! - arrays with array descriptors
   4 ! For those, the array descriptor / string length must be mapped with 'to:'
   5
   6 program main
   7 implicit none
   8
   9 type t
  10   integer :: ic(2:5)
  11   character(len=11) :: ccstr(3:4)
  12   character(len=11,kind=4) :: cc4str(3:7)
  13   integer, pointer :: pc(:)
  14   character(len=:), pointer :: pcstr(:)
  15   character(len=:,kind=4), pointer :: pc4str(:)
  16 end type t
  17
  18 type(t) :: dt
  19
  20 integer :: ii(5)
  21 character(len=11) :: clstr(-1:1)
  22 character(len=11,kind=4) :: cl4str(0:3)
  23 integer, pointer :: ip(:)
  24 integer, allocatable :: ia(:)
  25 character(len=:), pointer :: pstr(:)
  26 character(len=:), allocatable :: astr(:)
  27 character(len=:,kind=4), pointer :: p4str(:)
  28 character(len=:,kind=4), allocatable :: a4str(:)
  29
  30 allocate(dt%pc(5))
  31 allocate(character(len=2) :: dt%pcstr(2))
  32
  33 allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
  34
  35 allocate(ip(5), ia(8))
  36 allocate(character(len=2) :: pstr(-2:0))
  37 allocate(character(len=6) :: astr(3:5))
  38
  39 allocate(character(len=3,kind=4) :: p4str(2:4))
  40 allocate(character(len=7,kind=4) :: a4str(-2:3))
  41
  42
  43 ! integer :: ic(2:5)
  44
  45 !$omp target enter data map(alloc: dt%ic(3:5))
  46 dt%ic(2) = 22
  47 !$omp target map(alloc: dt%ic(3:5))
  48   if (size(dt%ic) /= 4) error stop
  49   if (lbound(dt%ic, 1) /= 2) error stop
  50   if (ubound(dt%ic, 1) /= 5) error stop
  51   dt%ic(3:5) = [33, 44, 55]
  52 !$omp end target
  53 !$omp target exit data map(from: dt%ic(3:5))
  54 if (size(dt%ic) /= 4) error stop
  55 if (lbound(dt%ic, 1) /= 2) error stop
  56 if (ubound(dt%ic, 1) /= 5) error stop
  57 if (any (dt%ic /= [22, 33, 44, 55])) error stop
  58
  59 ! character(len=11) :: ccstr(3:4)
  60
  61 !$omp target enter data map(alloc: dt%ccstr(4:4))
  62 dt%ccstr(3) = "12345678901"
  63 !$omp target map(alloc: dt%ccstr(4:4))
  64   if (len(dt%ccstr) /= 11) error stop
  65   if (size(dt%ccstr) /= 2) error stop
  66   if (lbound(dt%ccstr, 1) /= 3) error stop
  67   if (ubound(dt%ccstr, 1) /= 4) error stop
  68   dt%ccstr(4:4) = ["abcdefghijk"]
  69 !$omp end target
  70 !$omp target exit data map(from: dt%ccstr(4:4))
  71 if (len(dt%ccstr) /= 11) error stop
  72 if (size(dt%ccstr) /= 2) error stop
  73 if (lbound(dt%ccstr, 1) /= 3) error stop
  74 if (ubound(dt%ccstr, 1) /= 4) error stop
  75 if (any (dt%ccstr /= ["12345678901", "abcdefghijk"])) error stop
  76
  77
  78 ! character(len=11,kind=4) :: cc4str(3:7)
  79
  80 ! Value check fails
  81 !$omp target enter data map(alloc: dt%cc4str(4:7))
  82 dt%cc4str(3) = 4_"12345678901"
  83 !$omp target map(alloc: dt%cc4str(4:7))
  84   if (len(dt%cc4str) /= 11) error stop
  85   if (size(dt%cc4str) /= 5) error stop
  86   if (lbound(dt%cc4str, 1) /= 3) error stop
  87   if (ubound(dt%cc4str, 1) /= 7) error stop
  88   dt%cc4str(4:7) = [4_"abcdefghijk", &
  89                4_"qerftcea6ds", 4_"a1f9g37ga4.", &
  90                4_"45ngwj56sj2"]
  91 !$omp end target
  92 !$omp target exit data map(from: dt%cc4str(4:7))
  93 if (len(dt%cc4str) /= 11) error stop
  94 if (size(dt%cc4str) /= 5) error stop
  95 if (lbound(dt%cc4str, 1) /= 3) error stop
  96 if (ubound(dt%cc4str, 1) /= 7) error stop
  97 if (dt%cc4str(3) /= 4_"12345678901") error stop
  98 if (dt%cc4str(4) /= 4_"abcdefghijk") error stop
  99 if (dt%cc4str(5) /= 4_"qerftcea6ds") error stop
 100 if (dt%cc4str(6) /= 4_"a1f9g37ga4.") error stop
 101 if (dt%cc4str(7) /= 4_"45ngwj56sj2") error stop
 102
 103 ! integer, pointer :: pc(:)
 104 ! allocate(dt%pc(5))
 105
 106 ! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
 107
 108 !$omp target enter data map(alloc: dt%pc(2:5))
 109 dt%pc(1) = 11
 110 !$omp target map(alloc: dt%pc(2:5))
 111   if (.not. associated(dt%pc)) error stop
 112   if (size(dt%pc) /= 5) error stop
 113   if (lbound(dt%pc, 1) /= 1) error stop
 114   if (ubound(dt%pc, 1) /= 5) error stop
 115   dt%pc(2:5) = [22, 33, 44, 55]
 116 !$omp end target
 117 !$omp target exit data map(from: dt%pc(2:5))
 118 if (.not. associated(dt%pc)) error stop
 119 if (size(dt%pc) /= 5) error stop
 120 if (lbound(dt%pc, 1) /= 1) error stop
 121 if (ubound(dt%pc, 1) /= 5) error stop
 122 if (any (dt%pc /= [11, 22, 33, 44, 55])) error stop
 123
 124 ! character(len=:), pointer :: pcstr(:)
 125 ! allocate(character(len=2) :: dt%pcstr(2))
 126
 127 ! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
 128
 129 ! FIXME: Disabled befause of PR108837
 130 !
 131 !!$omp target enter data map(alloc: dt%pcstr(2:2))
 132 !dt%pcstr(1) = "01"
 133 !!$omp target map(alloc: dt%pcstr(2:2))
 134 !  if (.not. associated(dt%pcstr)) error stop
 135 !  if (len(dt%pcstr) /= 2) error stop
 136 !  if (size(dt%pcstr) /= 2) error stop
 137 !  if (lbound(dt%pcstr, 1) /= 1) error stop
 138 !  if (ubound(dt%pcstr, 1) /= 2) error stop
 139 !  dt%pcstr(2:2) = ["jk"]
 140 !!$omp end target
 141 !!$omp target exit data map(from: dt%pcstr(2:2))
 142 !if (.not. associated(dt%pcstr)) error stop
 143 !if (len(dt%pcstr) /= 2) error stop
 144 !if (size(dt%pcstr) /= 2) error stop
 145 !if (lbound(dt%pcstr, 1) /= 1) error stop
 146 !if (ubound(dt%pcstr, 1) /= 2) error stop
 147 !if (any (dt%pcstr /= ["01", "jk"])) error stop
 148
 149
 150 ! character(len=:,kind=4), pointer :: pc4str(:)
 151 ! allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
 152
 153 ! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
 154 ! structure element when other mapped elements from the same structure weren't mapped together with it
 155
 156 ! FIXME: Disabled befause of PR108837
 157 !
 158 !!$omp target enter data map(alloc: dt%pc4str(3:3))
 159 !dt%pc4str(2) = 4_"456"
 160 !!$omp target map(alloc: dt%pc4str(3:3))
 161 !  if (.not. associated(dt%pc4str)) error stop
 162 !  if (len(dt%pc4str) /= 3) error stop
 163 !  if (size(dt%pc4str) /= 2) error stop
 164 !  if (lbound(dt%pc4str, 1) /= 2) error stop
 165 !  if (ubound(dt%pc4str, 1) /= 3) error stop
 166 !  dt%pc4str(3:3) = [4_"tzu"]
 167 !!$omp end target
 168 !!$omp target exit data map(from: dt%pc4str(3:3))
 169 !if (.not. associated(dt%pc4str)) error stop
 170 !if (len(dt%pc4str) /= 3) error stop
 171 !if (size(dt%pc4str) /= 2) error stop
 172 !if (lbound(dt%pc4str, 1) /= 2) error stop
 173 !if (ubound(dt%pc4str, 1) /= 3) error stop
 174 !if (dt%pc4str(2) /= 4_"456") error stop
 175 !if (dt%pc4str(3) /= 4_"tzu") error stop
 176
 177 ! libgomp: GOMP_target_enter_exit_data unhandled kind 0x01
 178
 179 ! integer :: ii(5)
 180
 181 !$omp target enter data map(alloc: ii(2:5))
 182 ii(1) = -1
 183 !$omp target map(alloc: ii(2:5))
 184   if (size(ii) /= 5) error stop
 185   if (lbound(ii, 1) /= 1) error stop
 186   if (ubound(ii, 1) /= 5) error stop
 187   ii(2:5) = [-2, -3, -4, -5]
 188 !$omp end target
 189 !$omp target exit data map(from: ii(2:5))
 190 if (size(ii) /= 5) error stop
 191 if (lbound(ii, 1) /= 1) error stop
 192 if (ubound(ii, 1) /= 5) error stop
 193 if (any (ii /= [-1, -2, -3, -4, -5])) error stop
 194
 195
 196 ! character(len=11) :: clstr(-1:1)
 197
 198 !$omp target enter data map(alloc: clstr(0:1))
 199 clstr(-1) = "12345678901"
 200 !$omp target map(alloc: clstr(0:1))
 201   if (len(clstr) /= 11) error stop
 202   if (size(clstr) /= 3) error stop
 203   if (lbound(clstr, 1) /= -1) error stop
 204   if (ubound(clstr, 1) /= 1) error stop
 205   clstr(0:1) = ["abcdefghijk", "ABCDEFGHIJK"]
 206 !$omp end target
 207 !$omp target exit data map(from: clstr(0:1))
 208 if (len(clstr) /= 11) error stop
 209 if (size(clstr) /= 3) error stop
 210 if (lbound(clstr, 1) /= -1) error stop
 211 if (ubound(clstr, 1) /= 1) error stop
 212 if (any (clstr /= ["12345678901", "abcdefghijk", "ABCDEFGHIJK"])) error stop
 213
 214 ! character(len=11,kind=4) :: cl4str(0:3)
 215
 216 !$omp target enter data map(alloc: cl4str(1:3))
 217 cl4str(0) = 4_"12345678901"
 218 !$omp target map(alloc: cl4str(1:3))
 219   if (len(cl4str) /= 11) error stop
 220   if (size(cl4str) /= 4) error stop
 221   if (lbound(cl4str, 1) /= 0) error stop
 222   if (ubound(cl4str, 1) /= 3) error stop
 223   cl4str(1:3) = [4_"abcdefghijk", &
 224             4_"qerftcea6ds", 4_"a1f9g37ga4."]
 225 !$omp end target
 226 !$omp target exit data map(from: cl4str(1:3))
 227 if (len(cl4str) /= 11) error stop
 228 if (size(cl4str) /= 4) error stop
 229 if (lbound(cl4str, 1) /= 0) error stop
 230 if (ubound(cl4str, 1) /= 3) error stop
 231 if (cl4str(0) /= 4_"12345678901") error stop
 232 if (cl4str(1) /= 4_"abcdefghijk") error stop
 233 if (cl4str(2) /= 4_"qerftcea6ds") error stop
 234 if (cl4str(3) /= 4_"a1f9g37ga4.") error stop
 235
 236
 237 ! allocate(ip(5), ia(8))
 238
 239 !$omp target enter data map(alloc: ip(2:5))
 240 ip(1) = 11
 241 !$omp target map(alloc: ip(2:5))
 242   if (.not. associated(ip)) error stop
 243   if (size(ip) /= 5) error stop
 244   if (lbound(ip, 1) /= 1) error stop
 245   if (ubound(ip, 1) /= 5) error stop
 246   ip(2:5) = [22, 33, 44, 55]
 247 !$omp end target
 248 !$omp target exit data map(from: ip(2:5))
 249 if (.not. associated(ip)) error stop
 250 if (size(ip) /= 5) error stop
 251 if (lbound(ip, 1) /= 1) error stop
 252 if (ubound(ip, 1) /= 5) error stop
 253 if (any (ip /= [11, 22, 33, 44, 55])) error stop
 254
 255 ! allocate(ip(5), ia(8))
 256
 257 !$omp target enter data map(alloc: ia(2:8))
 258 ia(1) = 1
 259 !$omp target map(alloc: ia(2:8))
 260   if (.not. allocated(ia)) error stop
 261   if (size(ia) /= 8) error stop
 262   if (lbound(ia, 1) /= 1) error stop
 263   if (ubound(ia, 1) /= 8) error stop
 264   ia(2:8) = [2,3,4,5,6,7,8]
 265 !$omp end target
 266 !$omp target exit data map(from: ia(2:8))
 267 if (.not. allocated(ia)) error stop
 268 if (size(ia) /= 8) error stop
 269 if (lbound(ia, 1) /= 1) error stop
 270 if (ubound(ia, 1) /= 8) error stop
 271 if (any (ia /= [1,2,3,4,5,6,7,8])) error stop
 272
 273
 274 ! character(len=:), pointer :: pstr(:)
 275 ! allocate(character(len=2) :: pstr(-2:0))
 276
 277 ! libgomp: nvptx_alloc error: out of memory
 278
 279 ! FIXME: array offset wrongly calculated as it uses TYPE_SIZE_UNIT, which is a SAVE_EXPR
 280 !
 281 !!$omp target enter data map(alloc: pstr(-1:0))
 282 !pstr(-2) = "01"
 283 !!$omp target map(alloc: pstr(-1:0))
 284 !  if (.not. associated(pstr)) error stop
 285 !  if (len(pstr) /= 2) error stop
 286 !  if (size(pstr) /= 3) error stop
 287 !  if (lbound(pstr, 1) /= -2) error stop
 288 !  if (ubound(pstr, 1) /= 0) error stop
 289 !  pstr(-1:0) = ["jk", "aq"]
 290 !!$omp end target
 291 !!$omp target exit data map(from: pstr(-1:0))
 292 !if (.not. associated(pstr)) error stop
 293 !if (len(pstr) /= 2) error stop
 294 !if (size(pstr) /= 3) error stop
 295 !if (lbound(pstr, 1) /= -2) error stop
 296 !if (ubound(pstr, 1) /= 0) error stop
 297 !if (any (pstr /= ["01", "jk", "aq"])) error stop
 298
 299
 300 ! character(len=:), allocatable :: astr(:)
 301 ! allocate(character(len=6) :: astr(3:5))
 302
 303 ! libgomp: nvptx_alloc error: out of memory
 304
 305 ! FIXME
 306 !!$omp target enter data map(alloc: astr(4:5))
 307 !astr(3) = "01db45"
 308 !!$omp target map(alloc: astr(4:5))
 309 !  if (.not. allocated(astr)) error stop
 310 !  if (len(astr) /= 6) error stop
 311 !  if (size(astr) /= 3) error stop
 312 !  if (lbound(astr, 1) /= 3) error stop
 313 !  if (ubound(astr, 1) /= 5) error stop
 314 !!!  astr(4:5) = ["jk$D%S", "zutg47"]
 315 !!$omp end target
 316 !!!$omp target exit data map(from: astr(4:5))
 317 !!if (.not. allocated(astr)) error stop
 318 !!!if (len(astr) /= 6) error stop
 319 !if (size(astr) /= 3) error stop
 320 !if (lbound(astr, 1) /= 3) error stop
 321 !if (ubound(astr, 1) /= 5) error stop
 322 !if (any (astr /= ["01db45", "jk$D%S", "zutg47"])) error stop
 323 !
 324
 325 ! character(len=:,kind=4), pointer :: p4str(:)
 326 ! allocate(character(len=3,kind=4) :: p4str(2:4))
 327
 328 ! FAILS with value check
 329
 330 ! FIXME: array offset wrongly calculated as it uses TYPE_SIZE_UNIT, which is a SAVE_EXPR
 331 !
 332 !!$omp target enter data map(alloc: p4str(3:4))
 333 !p4str(2) = 4_"f85"
 334 !!$omp target map(alloc: p4str(3:4))
 335 !  if (.not. associated(p4str)) error stop
 336 !  if (len(p4str) /= 3) error stop
 337 !  if (size(p4str) /= 3) error stop
 338 !  if (lbound(p4str, 1) /= 2) error stop
 339 !  if (ubound(p4str, 1) /= 4) error stop
 340 !  p4str(3:4) = [4_"8af", 4_"A%F"]
 341 !!$omp end target
 342 !!$omp target exit data map(from: p4str(3:4))
 343 !if (.not. associated(p4str)) error stop
 344 !if (len(p4str) /= 3) error stop
 345 !if (size(p4str) /= 3) error stop
 346 !if (lbound(p4str, 1) /= 2) error stop
 347 !if (ubound(p4str, 1) /= 4) error stop
 348 !if (p4str(2)  /= 4_"f85") error stop
 349 !if (p4str(3)  /= 4_"8af") error stop
 350 !if (p4str(4)  /= 4_"A%F") error stop
 351
 352 ! character(len=:,kind=4), allocatable :: a4str(:)
 353 ! allocate(character(len=7,kind=4) :: a4str(-2:3))
 354
 355 ! libgomp: Trying to map into device [0x1027ba0..0x251050bb9c9ebba0) object when [0x7ffd026e6708..0x7ffd026e6710) is already mapped
 356
 357 ! FIXME: Disabled befause of PR108838
 358 !!$omp target enter data map(alloc: a4str(-1:3))
 359 !!a4str(-2) = 4_"sf456aq"
 360 !!$omp target map(alloc: a4str(-1:3))
 361 !  if (.not. allocated(a4str)) error stop
 362 !  if (len(a4str) /= 7) error stop
 363 !  if (size(a4str) /= 6) error stop
 364 !  if (lbound(a4str, 1) /= -2) error stop
 365 !  if (ubound(a4str, 1) /= 3) error stop
 366 !  a4str(-1:3) = [4_"3dtzu24", 4_"_4fh7sm", 4_"=ff85s7", 4_"j=8af4d", 4_".,A%Fsz"]
 367 !!$omp end target
 368 !!$omp target exit data map(from: a4str(-1:3))
 369 !if (.not. allocated(a4str)) error stop
 370 !if (len(a4str) /= 7) error stop
 371 !if (size(a4str) /= 6) error stop
 372 !if (lbound(a4str, 1) /= -2) error stop
 373 !if (ubound(a4str, 1) /= 3) error stop
 374 !if (a4str(-2) /= 4_"sf456aq") error stop
 375 !if (a4str(-1) /= 4_"3dtzu24") error stop
 376 !if (a4str(0)  /= 4_"_4fh7sm") error stop
 377 !if (a4str(1)  /= 4_"=ff85s7") error stop
 378 !if (a4str(2)  /= 4_"j=8af4d") error stop
 379 !if (a4str(3)  /= 4_".,A%Fsz") error stop
 380
 381 deallocate(dt%pc)
 382 deallocate(dt%pcstr)
 383
 384 deallocate(dt%pc4str)
 385
 386 deallocate(ip, ia)
 387 deallocate(pstr)
 388 deallocate(astr)
 389
 390 deallocate(p4str)
 391 deallocate(a4str)
 392 end