1! { dg-do compile }
2
3module m
4  integer :: i
5end module m
6subroutine f1
7  call f2
8contains
9  subroutine f2
10    use m
11    implicit none
12    integer, save :: t
13    t = 1
14    !$omp threadprivate (t1)	! { dg-error "Unexpected" }
15  end subroutine f2
16  subroutine f3
17    use m
18    implicit none
19    integer :: j
20    j = 1
21    !$omp declare reduction (foo:real:omp_out = omp_out + omp_in)	! { dg-error "Unexpected" }
22  end subroutine f3
23  subroutine f4
24    use m
25    implicit none
26    !$omp declare target
27    integer, save :: f4_1
28    f4_1 = 1
29    !$omp declare target (f4_1)	! { dg-error "Unexpected" }
30    !$omp declare target	! { dg-error "Unexpected" }
31  end subroutine f4
32  integer function f5 (a, b)
33    integer :: a, b
34    a = 1; b = 2
35    !$omp declare simd (f5) notinbranch	! { dg-error "Unexpected" }
36  end function f5
37end subroutine f1
38