1! { dg-do run }
2
3! Test of attach/detach with "acc parallel".
4
5program dtype
6  implicit none
7  integer, parameter :: n = 512
8  type mytype
9    integer, allocatable :: a(:)
10    integer, allocatable :: b(:)
11  end type mytype
12  integer i
13
14  type(mytype) :: var
15
16  allocate(var%a(1:n))
17  allocate(var%b(1:n))
18
19!$acc data copy(var)
20!$acc parallel loop copy(var%a(1:n)) copy(var%b(1:n))
21  do i = 1,n
22    var%a(i) = i
23    var%b(i) = i
24  end do
25!$acc end parallel loop
26!$acc end data
27
28  do i = 1,n
29    if (i .ne. var%a(i)) stop 1
30    if (i .ne. var%b(i)) stop 2
31  end do
32
33  deallocate(var%a)
34  deallocate(var%b)
35
36end program dtype
37