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 10program 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 40contains 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 411end program main 412