1! { dg-do compile }
2
3subroutine f6
4!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "Unclassifiable OpenMP directive" }
5!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & ! { dg-error "Unclassifiable OpenMP directive" }
6!$omp & initializer (omp_priv (omp_orig))
7end subroutine f6
8subroutine f7
9  integer :: a
10!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "Unclassifiable OpenMP directive" }
11!$omp declare reduction (bar:real:omp_out = omp_out.or.omp_in) ! { dg-error "Operands of logical operator" }
12!$omp declare reduction (baz:real:omp_out = omp_out + omp_in)
13!$omp & initializer (a (omp_priv, omp_orig)) ! { dg-error "Unclassifiable OpenMP directive" }
14  real :: r
15  r = 0.0
16!$omp parallel reduction (bar:r)
17!$omp end parallel
18end subroutine f7
19subroutine f8
20  interface
21    subroutine f8a (x)
22      integer :: x
23    end subroutine f8a
24  end interface
25!$omp declare reduction (baz:integer:omp_out = omp_out + omp_in) &
26!$omp & initializer (f8a (omp_orig)) ! { dg-error "One of actual subroutine arguments in INITIALIZER clause" }
27!$omp declare reduction (foo:integer:f8a) ! { dg-error "is not a variable" }
28!$omp declare reduction (bar:integer:omp_out = omp_out - omp_in) &
29!$omp & initializer (f8a) ! { dg-error "is not a variable" }
30end subroutine f8
31subroutine f9
32  type dt	! { dg-error "which is not consistent with the CALL" }
33    integer :: x = 0
34    integer :: y = 0
35  end type dt
36  integer :: i
37!$omp declare reduction (foo:integer:dt (omp_out, omp_in)) ! { dg-error "which is not consistent with the CALL" }
38!$omp declare reduction (bar:integer:omp_out = omp_out + omp_in) &
39!$omp & initializer (dt (omp_priv, omp_orig)) ! { dg-error "which is not consistent with the CALL" }
40  i = 0
41!$omp parallel reduction (foo : i)
42!$omp end parallel
43!$omp parallel reduction (bar : i)
44!$omp end parallel
45end subroutine f9
46subroutine f10
47  integer :: a, b
48!$omp declare reduction(foo:character(len=64) &
49!$omp & :omp_out(a:b) = omp_in(a:b)) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" }
50!$omp declare reduction(bar:character(len=16) &
51!$omp & :omp_out = trim(omp_out) // omp_in) &
52!$omp & initializer (omp_priv(a:b) = ' ') ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" }
53end subroutine f10
54