1! { dg-do run }
2
3! Test of attach/detach with scalar elements and nested derived types.
4
5program dtype
6  implicit none
7  integer, parameter :: n = 512
8  type subtype
9    integer :: g, h
10    integer, allocatable :: q(:)
11  end type subtype
12  type mytype
13    integer, allocatable :: a(:)
14    integer, allocatable :: c, d
15    integer, allocatable :: b(:)
16    integer :: f
17    type(subtype) :: s
18  end type mytype
19  integer i
20
21  type(mytype) :: var
22
23  allocate(var%a(1:n))
24  allocate(var%b(1:n))
25  allocate(var%c)
26  allocate(var%d)
27  allocate(var%s%q(1:n))
28
29  var%c = 16
30  var%d = 20
31  var%f = 7
32  var%s%g = 21
33  var%s%h = 38
34
35!$acc enter data copyin(var)
36
37  do i = 1, n
38    var%a(i) = 0
39    var%b(i) = 0
40    var%s%q(i) = 0
41  end do
42
43!$acc data copy(var%a(5:n - 5), var%b(5:n - 5), var%c, var%d) &
44!$acc & copy(var%s%q)
45
46!$acc parallel loop default(none) present(var)
47  do i = 5,n - 5
48    var%a(i) = i
49    var%b(i) = i * 2
50    var%s%q(i) = i * 3
51    var%s%g = 100
52    var%s%h = 101
53  end do
54!$acc end parallel loop
55
56!$acc end data
57
58!$acc exit data copyout(var)
59
60  do i = 1,4
61    if (var%a(i) .ne. 0) stop 1
62    if (var%b(i) .ne. 0) stop 2
63    if (var%s%q(i) .ne. 0) stop 3
64  end do
65
66  do i = 5,n - 5
67    if (i .ne. var%a(i)) stop 4
68    if (i * 2 .ne. var%b(i)) stop 5
69    if (i * 3 .ne. var%s%q(i)) stop 6
70  end do
71
72  do i = n - 4,n
73    if (var%a(i) .ne. 0) stop 7
74    if (var%b(i) .ne. 0) stop 8
75    if (var%s%q(i) .ne. 0) stop 9
76  end do
77
78  if (var%c .ne. 16) stop 10
79  if (var%d .ne. 20) stop 11
80  if (var%s%g .ne. 100 .or. var%s%h .ne. 101) stop 12
81  if (var%f .ne. 7) stop 13
82
83  deallocate(var%a)
84  deallocate(var%b)
85  deallocate(var%c)
86  deallocate(var%d)
87  deallocate(var%s%q)
88
89end program dtype
90