1! { dg-do compile }
2! { dg-additional-options "-fcoarray=single" }
3!
4subroutine check_coindexed()
5implicit none
6type t
7  integer :: i
8end type t
9type t2
10  integer, allocatable :: i[:]
11  type(t), allocatable :: x[:]
12end type t2
13type(t), allocatable :: A(:)[:], B(:)[:]
14type(t) :: D(1)[*], E[*]
15type(t2) :: C
16save :: D, E
17
18! Coarrays are fine if they are local/not coindexed:
19
20!$acc enter data copyin(D(1)%i)
21!$acc enter data copyin(A(1))
22!$acc enter data copyin(B(1)%i)
23!$acc enter data copyin(C%i)
24!$acc enter data copyin(C%x%i)
25!$acc enter data copyin(C%i)
26!$acc enter data copyin(C%x%i)
27
28! Does not like the '[' after the identifier:
29!$acc enter data copyin(E[2]) ! { dg-error "Syntax error in OpenMP variable list" }
30
31!$acc enter data copyin(D(1)[2]%i) ! { dg-error "List item shall not be coindexed" }
32!$acc enter data copyin(A(1)[4])   ! { dg-error "List item shall not be coindexed" }
33!$acc enter data copyin(B(1)[4]%i) ! { dg-error "List item shall not be coindexed" }
34!$acc enter data copyin(C%i[2])    ! { dg-error "List item shall not be coindexed" }
35!$acc enter data copyin(C%x[4]%i)  ! { dg-error "List item shall not be coindexed" }
36
37end
38