1! { dg-do compile }
2
3module mymod
4  implicit none (type, external)
5  integer, target :: var(0:5) = [0,1,2,3,4,5]
6end module mymod
7
8program main
9  use mymod
10  implicit none
11
12  type t
13    integer :: x(0:64)
14    integer :: y
15  end type t
16  type(t) :: dep2(0:64)
17  integer :: dep1(0:64)
18
19  integer arr(0:63)
20  !$omp parallel
21  !$omp master
22  block
23    integer :: i
24    do i = 0, 63
25      !$omp task depend (iterator (j=i:i+1) , out : dep1 (j))
26        arr(i) = i
27      !$omp end task
28      !$omp task depend (iterator (j=i:i+1) , out : dep2 (j))
29        arr(i) = i
30      !$omp end task
31      !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%y)
32        arr(i) = i
33      !$omp end task
34      !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%x(j))
35        arr(i) = i
36      !$omp end task
37      !$omp task depend (out : dep2 (:4))
38        arr(i) = i
39      !$omp end task
40      !$omp taskwait depend(out: dep1(1))
41    end do
42  end block
43  !$omp end master
44  !$omp end parallel
45end
46