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