1! { dg-additional-options "-ffree-line-length-none" }
2subroutine foo (x, a)
3  implicit none
4  integer, value :: x
5  integer, contiguous :: a(0:)
6  external :: bar
7  integer :: i
8
9  !$omp masked
10   call bar ()
11  !$omp end masked
12
13  !$omp masked filter (0)
14   call bar ()
15  !$omp end masked
16
17  !$omp masked filter (7)
18   call bar ()
19  !$omp end masked
20
21  !$omp masked filter (x)
22   call bar ()
23  !$omp end masked
24
25  !$omp masked taskloop simd filter (x) grainsize (12) simdlen (4)
26    do i = 0, 127
27      a(i) = i
28    end do
29  !$omp end masked taskloop simd
30
31  !$omp parallel masked filter (x) firstprivate (x)
32    call bar ()
33  !$omp end parallel masked
34
35  !$omp masked
36    !$omp masked filter (0)
37      !$omp masked filter (x)
38      !$omp end masked
39    !$omp end masked
40  !$omp end masked
41end
42
43subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, pp, q, r, r2)
44  implicit none (type, external)
45  logical :: i1, i2, fi
46  integer :: i, d, f, p, s, g, l, ll, nth, ntm, pp, q, r, r2
47  allocatable :: q
48  integer, save :: t
49  !$omp threadprivate (t)
50
51  !$omp parallel masked &
52  !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
53  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) filter (d)  ! allocate (f)
54    !
55  !$omp end parallel masked
56
57  !$omp taskgroup task_reduction (+:r2)  ! allocate (r2)
58    !$omp masked taskloop &
59    !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) final(fi) mergeable priority (pp) &
60    !$omp&  reduction(default, +:r) in_reduction(+:r2) filter (d)  ! allocate (f)
61    do i = 0, 63
62      ll = ll + 1
63    end do
64    !$omp end masked taskloop
65  !$omp end taskgroup
66
67  !$omp taskgroup task_reduction (+:r2)  ! allocate (r2)
68    !$omp masked taskloop simd &
69    !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
70    !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
71    !$omp&  order(concurrent) filter (d)  !  allocate (f)
72    do i = 0, 63
73      ll = ll + 1
74    end do
75    !$omp end masked taskloop simd
76  !$omp end taskgroup
77
78  !$omp parallel masked taskloop &
79    !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) final(fi) mergeable priority (pp) &
80    !$omp&  reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d)  ! allocate (f)
81    do i = 0, 63
82      ll = ll + 1
83    end do
84  !$omp end parallel masked taskloop
85
86  !$omp parallel masked taskloop simd &
87    !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
88    !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) &
89    !$omp&  order(concurrent) filter (d)  ! allocate (f)
90    do i = 0, 63
91      ll = ll + 1
92    end do
93  !$omp end parallel masked taskloop simd
94end subroutine
95