1! { dg-do compile }
2
3subroutine f3
4!$omp declare reduction ! { dg-error "Unclassifiable OpenMP directive" }
5!$omp declare reduction foo ! { dg-error "Unclassifiable OpenMP directive" }
6!$omp declare reduction (foo) ! { dg-error "Unclassifiable OpenMP directive" }
7!$omp declare reduction (foo:integer) ! { dg-error "Unclassifiable OpenMP directive" }
8!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) &
9!$omp & initializer(omp_priv=0) initializer(omp_priv=0) ! { dg-error "Unexpected junk after" }
10end subroutine f3
11subroutine f4
12  implicit integer (o)
13  implicit real (b)
14!$omp declare reduction (foo:integer:omp_priv(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine omp_priv" }
15!$omp declare reduction (foo:real:bar(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine bar used" }
16!$omp declare reduction (bar:integer:omp_out=omp_out+omp_in) &
17!$omp & initializer(omp_out (omp_priv)) ! { dg-error "Implicitly declared subroutine omp_out used" }
18!$omp declare reduction (bar:real:omp_out=omp_out+omp_in) &
19!$omp & initializer(bar (omp_priv, omp_orig)) ! { dg-error "Implicitly declared subroutine bar used" }
20!$omp declare reduction (id1:integer:omp_out=omp_orig(omp_out,omp_in)) ! { dg-error "Implicitly declared function omp_orig used" }
21!$omp declare reduction (id1:real:omp_out=foo(omp_out,omp_in)) ! { dg-error "Implicitly declared function foo used" }
22!$omp declare reduction (id2:integer:omp_out=omp_out+omp_in) &
23!$omp & initializer(omp_priv = omp_in (omp_orig)) ! { dg-error "Implicitly declared function omp_in used" }
24!$omp declare reduction (id2:real:omp_out=omp_out+omp_in) &
25!$omp & initializer(omp_priv = baz (omp_orig)) ! { dg-error "Implicitly declared function baz used" }
26  integer :: i
27  real :: r
28  i = 0
29  r = 0
30!$omp parallel reduction (foo: i, r)
31!$omp end parallel
32!$omp parallel reduction (bar: i, r)
33!$omp end parallel
34!$omp parallel reduction (id1: i, r)
35!$omp end parallel
36!$omp parallel reduction (id2: i, r)
37!$omp end parallel
38end subroutine f4
39subroutine f5
40  interface
41    subroutine f5a (x, *, y)
42      double precision :: x, y
43    end subroutine f5a
44  end interface
45!$omp declare reduction (foo:double precision: & ! { dg-error "Subroutine call with alternate returns in combiner" }
46!$omp & f5a (omp_out, *10, omp_in))
47!$omp declare reduction (bar:double precision: &
48!$omp omp_out = omp_in + omp_out) &
49!$omp & initializer (f5a (omp_priv, *20, omp_orig)) ! { dg-error "Subroutine call with alternate returns in INITIALIZER clause" }
5010 continue
5120 continue
52end subroutine f5
53subroutine f6
54  integer :: a
55!$omp declare reduction(foo:character(len=a*2) & ! { dg-error "cannot appear in the expression|not constant" }
56!$omp & :omp_out=trim(omp_out)//omp_in) &
57!$omp & initializer(omp_priv=' ')
58end subroutine f6
59subroutine f7
60  type dt1
61    integer :: a = 1
62    integer :: b
63  end type
64  type dt2
65    integer :: a = 2
66    integer :: b = 3
67  end type
68  type dt3
69    integer :: a
70    integer :: b
71  end type dt3
72!$omp declare reduction(foo:dt1,dt2:omp_out%a=omp_out%a+omp_in%a)
73!$omp declare reduction(foo:dt3:omp_out%a=omp_out%a+omp_in%a) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" }
74end subroutine f7
75