1! { dg-do run }
2  common /blk/ q, e
3  integer :: q, r
4  logical :: e
5!$omp parallel
6!$omp single
7  call foo (2, 7)
8  r = bar (12, 18)
9!$omp end single
10!$omp end parallel
11  if (q .ne. 6 .or. r .ne. 17 .or. e) stop 1
12contains
13  subroutine foo (a, b)
14    integer, intent (in) :: a, b
15    common /blk/ q, e
16    integer :: q, r, d
17    logical :: e
18!$omp taskloop lastprivate (q) nogroup
19    do d = a, b, 2
20      q = d
21      if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
22!$omp atomic write
23        e = .true.
24      end if
25    end do
26  end subroutine foo
27  function bar (a, b)
28    integer, intent (in) :: a, b
29    integer :: bar
30    common /blk/ q, e
31    integer :: q, r, d, s
32    logical :: e
33    s = 7
34!$omp taskloop lastprivate (s)
35    do d = a, b - 1
36      if (d < 12 .or. d > 17) then
37!$omp atomic write
38        e = .true.
39      end if
40      s = d
41    end do
42!$omp end taskloop
43    bar = s
44  end function bar
45end
46