1! { dg-do run }
2
3  integer :: x(2, 3)
4  integer, allocatable :: z(:, :)
5  allocate (z(-2:3, 2:4))
6  call foo (x, z)
7contains
8  subroutine foo (x, z)
9    integer :: x(:, :), y
10    integer, allocatable :: z(:, :)
11    y = 1
12    !$omp parallel shared (x, y, z)
13      !$omp single
14        !$omp taskgroup
15          !$omp task depend(in: x)
16  	  if (y.ne.1) STOP 1
17          !$omp end task
18          !$omp task depend(out: x(1:2, 1:3))
19  	  y = 2
20          !$omp end task
21        !$omp end taskgroup
22        !$omp taskgroup
23          !$omp task depend(in: z)
24  	  if (y.ne.2) STOP 2
25          !$omp end task
26          !$omp task depend(out: z(-2:3, 2:4))
27  	  y = 3
28          !$omp end task
29        !$omp end taskgroup
30        !$omp taskgroup
31          !$omp task depend(in: x)
32  	  if (y.ne.3) STOP 3
33          !$omp end task
34          !$omp task depend(out: x(1:, 1:))
35  	  y = 4
36          !$omp end task
37        !$omp end taskgroup
38      !$omp end single
39    !$omp end parallel
40    if (y.ne.4) STOP 4
41  end subroutine
42end
43