libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90

   1 ! { dg-do run }
   2 !
   3 ! Test OpenMP 4.5 structure-element mapping
   4
   5 ! TODO: ...%str4 + %uni4 should be tested but that currently fails due to
   6 !       PR fortran/95868 (see commented lined)
   7 ! TODO: Test also 'var' as array and/or pointer; nested derived types,
   8 !       type-extended types.
   9
  10 program main
  11   implicit none
  12
  13   type t2
  14     integer :: a, b
  15     ! For complex, assume small integers are exactly representable
  16     complex(kind=8) :: c
  17     integer :: d(10)
  18     integer, pointer :: e => null(), f(:) => null()
  19     character(len=5) :: str1
  20     character(len=5) :: str2(4)
  21     character(len=:), pointer :: str3 => null()
  22     character(len=:), pointer :: str4(:) => null()
  23     character(kind=4, len=5) :: uni1
  24     character(kind=4, len=5) :: uni2(4)
  25     character(kind=4, len=:), pointer :: uni3 => null()
  26     character(kind=4, len=:), pointer :: uni4(:) => null()
  27   end type t2
  28
  29   integer :: i
  30
  31   call one ()
  32   call two ()
  33   call three ()
  34   call four ()
  35   call five ()
  36   call six ()
  37   call seven ()
  38   call eight ()
  39
  40 contains
  41   ! Implicitly mapped – but no pointers are mapped
  42   subroutine one()
  43     type(t2) :: var
  44
  45     print '(g0)', '==== TESTCASE "one" ===='
  46
  47     var = t2(a = 1, &
  48              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
  49              d = [(-3*i, i = 1, 10)], &
  50              str1 = "abcde", &
  51              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
  52              uni1 = 4_"abcde", &
  53              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
  54     allocate (var%e, source=99)
  55     allocate (var%f, source=[22, 33, 44, 55])
  56     allocate (var%str3, source="HelloWorld")
  57     allocate (var%str4, source=["Let's", "Go!!!"])
  58     allocate (var%uni3, source=4_"HelloWorld")
  59     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
  60
  61     !$omp target map(tofrom:var)
  62       if (var%a /= 1) stop 1
  63       if (var%b /= 2)  stop 2
  64       if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
  65       if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
  66       if (var%str1 /= "abcde") stop 5
  67       if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
  68       if (var%uni1 /= 4_"abcde") stop 7
  69       if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 8
  70     !$omp end target
  71
  72     deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
  73   end subroutine one
  74
  75   ! Explicitly mapped – all and full arrays
  76   subroutine two()
  77     type(t2) :: var
  78
  79     print '(g0)', '==== TESTCASE "two" ===='
  80
  81     var = t2(a = 1, &
  82              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
  83              d = [(-3*i, i = 1, 10)], &
  84              str1 = "abcde", &
  85              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
  86              uni1 = 4_"abcde", &
  87              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
  88     allocate (var%e, source=99)
  89     allocate (var%f, source=[22, 33, 44, 55])
  90     allocate (var%str3, source="HelloWorld")
  91     allocate (var%str4, source=["Let's", "Go!!!"])
  92     allocate (var%uni3, source=4_"HelloWorld")
  93     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
  94
  95     !$omp target map(tofrom: var%a, var%b, var%c, var%d, var%e, var%f, &
  96     !$omp&                   var%str1, var%str2, var%str3, var%str4,   &
  97     !$omp&                   var%uni1, var%uni2, var%uni3, var%uni4)
  98       if (var%a /= 1) stop 1
  99       if (var%b /= 2)  stop 2
 100       if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
 101       if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
 102       if (var%str1 /= "abcde") stop 5
 103       if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
 104
 105       if (.not. associated (var%e)) stop 7
 106       if (var%e /= 99) stop 8
 107       if (.not. associated (var%f)) stop 9
 108       if (size (var%f) /= 4) stop 10
 109       if (any (var%f /= [22, 33, 44, 55])) stop 11
 110       if (.not. associated (var%str3)) stop 12
 111       if (len (var%str3) /= len ("HelloWorld")) stop 13
 112       if (var%str3 /= "HelloWorld") stop 14
 113       if (.not. associated (var%str4)) stop 15
 114       if (len (var%str4) /= 5) stop 16
 115       if (size (var%str4) /= 2) stop 17
 116       if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18
 117
 118       if (var%uni1 /= 4_"abcde") stop 19
 119       if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 20
 120       if (.not. associated (var%uni3)) stop 21
 121       if (len (var%uni3) /= len (4_"HelloWorld")) stop 22
 122       if (var%uni3 /= 4_"HelloWorld") stop 23
 123       if (.not. associated (var%uni4)) stop 24
 124       if (len (var%uni4) /= 5) stop 25
 125       if (size (var%uni4) /= 2) stop 26
 126       if (any (var%uni4 /= [4_"Let's", 4_"Go!!!"])) stop 27
 127     !$omp end target
 128
 129     deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
 130   end subroutine two
 131
 132   ! Explicitly mapped – one by one but full arrays
 133   subroutine three()
 134     type(t2) :: var
 135
 136     print '(g0)', '==== TESTCASE "three" ===='
 137
 138     var = t2(a = 1, &
 139              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 140              d = [(-3*i, i = 1, 10)], &
 141              str1 = "abcde", &
 142              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 143              uni1 = 4_"abcde", &
 144              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 145     allocate (var%e, source=99)
 146     allocate (var%f, source=[22, 33, 44, 55])
 147     allocate (var%str3, source="HelloWorld")
 148     allocate (var%str4, source=["Let's", "Go!!!"])
 149     allocate (var%uni3, source=4_"HelloWorld")
 150     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
 151
 152     !$omp target map(tofrom: var%a)
 153       if (var%a /= 1) stop 1
 154     !$omp end target
 155     !$omp target map(tofrom: var%b)
 156       if (var%b /= 2)  stop 2
 157     !$omp end target
 158     !$omp target map(tofrom: var%c)
 159       if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
 160     !$omp end target
 161     !$omp target map(tofrom: var%d)
 162       if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
 163     !$omp end target
 164     !$omp target map(tofrom: var%str1)
 165       if (var%str1 /= "abcde") stop 5
 166     !$omp end target
 167     !$omp target map(tofrom: var%str2)
 168       if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
 169     !$omp end target
 170
 171     !$omp target map(tofrom: var%e)
 172       if (.not. associated (var%e)) stop 7
 173       if (var%e /= 99) stop 8
 174     !$omp end target
 175     !$omp target map(tofrom: var%f)
 176       if (.not. associated (var%f)) stop 9
 177       if (size (var%f) /= 4) stop 10
 178       if (any (var%f /= [22, 33, 44, 55])) stop 11
 179     !$omp end target
 180     !$omp target map(tofrom: var%str3)
 181       if (.not. associated (var%str3)) stop 12
 182       if (len (var%str3) /= len ("HelloWorld")) stop 13
 183       if (var%str3 /= "HelloWorld") stop 14
 184     !$omp end target
 185     !$omp target map(tofrom: var%str4)
 186       if (.not. associated (var%str4)) stop 15
 187       if (len (var%str4) /= 5) stop 16
 188       if (size (var%str4) /= 2) stop 17
 189       if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18
 190     !$omp end target
 191
 192     !$omp target map(tofrom: var%uni1)
 193       if (var%uni1 /= 4_"abcde") stop 19
 194     !$omp end target
 195     !$omp target map(tofrom: var%uni2)
 196       if (any (var%uni2 /= [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])) stop 20
 197     !$omp end target
 198     !$omp target map(tofrom: var%uni3)
 199       if (.not. associated (var%uni3)) stop 21
 200       if (len (var%uni3) /= len (4_"HelloWorld")) stop 22
 201       if (var%uni3 /= 4_"HelloWorld") stop 23
 202     !$omp end target
 203     !$omp target map(tofrom: var%uni4)
 204       if (.not. associated (var%uni4)) stop 24
 205       if (len (var%uni4) /= 5) stop 25
 206       if (size (var%uni4) /= 2) stop 26
 207       if (any (var%uni4 /= [4_"Let's", 4_"Go!!!"])) stop 27
 208     !$omp end target
 209
 210     deallocate(var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
 211   end subroutine three
 212
 213   ! Explicitly mapped – all but only subarrays
 214   subroutine four()
 215     type(t2) :: var
 216
 217     print '(g0)', '==== TESTCASE "four" ===='
 218
 219     var = t2(a = 1, &
 220              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 221              d = [(-3*i, i = 1, 10)], &
 222              str1 = "abcde", &
 223              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 224              uni1 = 4_"abcde", &
 225              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 226     allocate (var%f, source=[22, 33, 44, 55])
 227     allocate (var%str4, source=["Let's", "Go!!!"])
 228     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
 229
 230 !   !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3)) &
 231 !   !$omp&       map(tofrom: var%str4(2:2), var%uni2(2:3), var%uni4(2:2))
 232     !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3), var%uni2(2:3))
 233       if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
 234       if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
 235
 236       if (.not. associated (var%f)) stop 9
 237       if (size (var%f) /= 4) stop 10
 238       if (any (var%f(2:3) /= [33, 44])) stop 11
 239 !     if (.not. associated (var%str4)) stop 15
 240 !     if (len (var%str4) /= 5) stop 16
 241 !     if (size (var%str4) /= 2) stop 17
 242 !     if (var%str4(2) /= "Go!!!") stop 18
 243
 244       if (any (var%uni2(2:3) /= [4_"67890", 4_"ABCDE"])) stop 19
 245 !     if (.not. associated (var%uni4)) stop 20
 246 !     if (len (var%uni4) /= 5) stop 21
 247 !     if (size (var%uni4) /= 2) stop 22
 248 !     if (var%uni4(2) /= "Go!!!") stop 23
 249     !$omp end target
 250
 251     deallocate(var%f, var%str4)
 252   end subroutine four
 253
 254   ! Explicitly mapped – all but only subarrays and one by one
 255   subroutine five()
 256     type(t2) :: var
 257
 258     print '(g0)', '==== TESTCASE "five" ===='
 259
 260     var = t2(a = 1, &
 261              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 262              d = [(-3*i, i = 1, 10)], &
 263              str1 = "abcde", &
 264              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 265              uni1 = 4_"abcde", &
 266              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 267     allocate (var%f, source=[22, 33, 44, 55])
 268     allocate (var%str4, source=["Let's", "Go!!!"])
 269
 270     !$omp target map(tofrom: var%d(4:7))
 271       if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
 272     !$omp end target
 273     !$omp target map(tofrom: var%str2(2:3))
 274       if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
 275     !$omp end target
 276
 277     !$omp target map(tofrom: var%f(2:3))
 278      if (.not. associated (var%f)) stop 9
 279      if (size (var%f) /= 4) stop 10
 280      if (any (var%f(2:3) /= [33, 44])) stop 11
 281     !$omp end target
 282 !  !$omp target map(tofrom: var%str4(2:2))
 283 !     if (.not. associated (var%str4)) stop 15
 284 !     if (len (var%str4) /= 5) stop 16
 285 !     if (size (var%str4) /= 2) stop 17
 286 !     if (var%str4(2) /= "Go!!!") stop 18
 287 !   !$omp end target
 288 !  !$omp target map(tofrom: var%uni4(2:2))
 289 !     if (.not. associated (var%uni4)) stop 15
 290 !     if (len (var%uni4) /= 5) stop 16
 291 !     if (size (var%uni4) /= 2) stop 17
 292 !     if (var%uni4(2) /= 4_"Go!!!") stop 18
 293 !  !$omp end target
 294
 295     deallocate(var%f, var%str4)
 296   end subroutine five
 297
 298   ! Explicitly mapped – all but only array elements
 299   subroutine six()
 300     type(t2) :: var
 301
 302     print '(g0)', '==== TESTCASE "six" ===='
 303
 304     var = t2(a = 1, &
 305              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 306              d = [(-3*i, i = 1, 10)], &
 307              str1 = "abcde", &
 308              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 309              uni1 = 4_"abcde", &
 310              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 311     allocate (var%f, source=[22, 33, 44, 55])
 312     allocate (var%str4, source=["Let's", "Go!!!"])
 313     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
 314
 315 !   !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), &
 316 !   !$omp                    var%str4(2), var%uni2(3), var%uni4(2))
 317     !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), var%uni2(3))
 318       if (var%d(5) /= -3*5) stop 4
 319       if (var%str2(3) /= "ABCDE") stop 6
 320       if (var%uni2(3) /= 4_"ABCDE") stop 7
 321
 322      if (.not. associated (var%f)) stop 9
 323      if (size (var%f) /= 4) stop 10
 324      if (var%f(3) /= 44) stop 11
 325 !     if (.not. associated (var%str4)) stop 15
 326 !     if (len (var%str4) /= 5) stop 16
 327 !     if (size (var%str4) /= 2) stop 17
 328 !     if (var%str4(2) /= "Go!!!") stop 18
 329 !     if (.not. associated (var%uni4)) stop 19
 330 !     if (len (var%uni4) /= 5) stop 20
 331 !     if (size (var%uni4) /= 2) stop 21
 332 !     if (var%uni4(2) /= 4_"Go!!!") stop 22
 333     !$omp end target
 334
 335     deallocate(var%f, var%str4, var%uni4)
 336   end subroutine six
 337
 338   ! Explicitly mapped – all but only array elements and one by one
 339   subroutine seven()
 340     type(t2) :: var
 341
 342     print '(g0)', '==== TESTCASE "seven" ===='
 343
 344     var = t2(a = 1, &
 345              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 346              d = [(-3*i, i = 1, 10)], &
 347              str1 = "abcde", &
 348              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 349              uni1 = 4_"abcde", &
 350              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 351     allocate (var%f, source=[22, 33, 44, 55])
 352     allocate (var%str4, source=["Let's", "Go!!!"])
 353     allocate (var%uni4, source=[4_"Let's", 4_"Go!!!"])
 354
 355     !$omp target map(tofrom: var%d(5))
 356       if (var%d(5) /= (-3*5)) stop 4
 357     !$omp end target
 358     !$omp target map(tofrom: var%str2(2:3))
 359       if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
 360     !$omp end target
 361     !$omp target map(tofrom: var%uni2(2:3))
 362       if (any (var%uni2(2:3) /= [4_"67890", 4_"ABCDE"])) stop 7
 363     !$omp end target
 364
 365     !$omp target map(tofrom: var%f(2:3))
 366      if (.not. associated (var%f)) stop 9
 367      if (size (var%f) /= 4) stop 10
 368      if (any (var%f(2:3) /= [33, 44])) stop 11
 369     !$omp end target
 370 !   !$omp target map(tofrom: var%str4(2:2))
 371 !     if (.not. associated (var%str4)) stop 15
 372 !     if (len (var%str4) /= 5) stop 16
 373 !     if (size (var%str4) /= 2) stop 17
 374 !     if (var%str4(2) /= "Go!!!") stop 18
 375 !   !$omp end target
 376 !   !$omp target map(tofrom: var%uni4(2:2))
 377 !     if (.not. associated (var%uni4)) stop 15
 378 !     if (len (var%uni4) /= 5) stop 16
 379 !     if (size (var%uni4) /= 2) stop 17
 380 !     if (var%uni4(2) /= 4_"Go!!!") stop 18
 381 !   !$omp end target
 382
 383     deallocate(var%f, var%str4, var%uni4)
 384   end subroutine seven
 385
 386   ! Check mapping of NULL pointers
 387   subroutine eight()
 388     type(t2) :: var
 389
 390     print '(g0)', '==== TESTCASE "eight" ===='
 391
 392     var = t2(a = 1, &
 393              b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
 394              d = [(-3*i, i = 1, 10)], &
 395              str1 = "abcde", &
 396              str2 = ["12345", "67890", "ABCDE", "FGHIJ"], &
 397              uni1 = 4_"abcde", &
 398              uni2 = [4_"12345", 4_"67890", 4_"ABCDE", 4_"FGHIJ"])
 399
 400 !    !$omp target map(tofrom: var%e, var%f, var%str3, var%str4, var%uni3, var%uni4)
 401     !$omp target map(tofrom: var%e, var%str3, var%uni3)
 402       if (associated (var%e)) stop 1
 403 !      if (associated (var%f)) stop 2
 404       if (associated (var%str3)) stop 3
 405 !      if (associated (var%str4)) stop 4
 406       if (associated (var%uni3)) stop 5
 407 !      if (associated (var%uni4)) stop 6
 408     !$omp end target
 409   end subroutine eight
 410
 411 end program main