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