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