1! { dg-do run }
2
3! Test of attach/detach with "acc enter/exit data".
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, allocatable :: r(:)
13  integer i
14
15  type(mytype) :: var
16
17  allocate(var%a(1:n))
18  allocate(var%b(1:n))
19  allocate(r(1:n))
20
21!$acc enter data copyin(var)
22
23!$acc enter data copyin(var%a, var%b, r)
24
25!$acc parallel loop
26  do i = 1,n
27    var%a(i) = i
28    var%b(i) = i * 2
29    r(i) = i * 3
30  end do
31!$acc end parallel loop
32
33!$acc exit data copyout(var%a)
34!$acc exit data copyout(var%b)
35!$acc exit data copyout(r)
36
37  do i = 1,n
38    if (i .ne. var%a(i)) stop 1
39    if (i * 2 .ne. var%b(i)) stop 2
40    if (i * 3 .ne. r(i)) stop 3
41  end do
42
43!$acc exit data delete(var)
44
45  deallocate(var%a)
46  deallocate(var%b)
47  deallocate(r)
48
49end program dtype
50