1! { dg-do compile }
2
3module udr5m1
4  type dt
5    real :: r
6  end type dt
7end module udr5m1
8module udr5m2
9  use udr5m1
10  interface operator(+)
11    module procedure addm2
12  end interface
13!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) &
14!$omp & initializer(omp_priv=dt(0.0))
15!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) &
16!$omp & initializer(omp_priv=dt(0.0))
17  interface operator(.myadd.)
18    module procedure addm2
19  end interface
20contains
21  type(dt) function addm2 (x, y)
22    type(dt), intent (in):: x, y
23    addm2%r = x%r + y%r
24  end function
25end module udr5m2
26module udr5m3
27  use udr5m1
28  interface operator(.myadd.)
29    module procedure addm3
30  end interface
31!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) &
32!$omp & initializer(omp_priv=dt(0.0))
33!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) &
34!$omp & initializer(omp_priv=dt(0.0))
35  interface operator(+)
36    module procedure addm3
37  end interface
38contains
39  type(dt) function addm3 (x, y)
40    type(dt), intent (in):: x, y
41    addm3%r = x%r + y%r
42  end function
43end module udr5m3
44subroutine f1
45  use udr5m2
46  type(dt) :: d, e
47  integer :: i
48  d=dt(0.0)
49  e = dt (0.0)
50!$omp parallel do reduction (+ : d) reduction ( .myadd. : e)
51  do i=1,100
52    d=d+dt(i)
53    e=e+dt(i)
54  end do
55end subroutine f1
56subroutine f2
57  use udr5m3	! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
58  use udr5m2	! { dg-error "Ambiguous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
59end subroutine f2
60