1! { dg-do run }
2
3module udr9m1
4  integer, parameter :: a = 6
5  integer :: b
6!$omp declare reduction (foo : integer : combiner1 (omp_out, omp_in)) &
7!$omp & initializer (initializer1 (omp_priv, omp_orig))
8!$omp declare reduction (.add. : integer : &
9!$omp & combiner1 (omp_out, omp_in)) &
10!$omp & initializer (initializer1 (omp_priv, omp_orig))
11  interface operator (.add.)
12    module procedure f1
13  end interface
14contains
15  integer function f1 (x, y)
16    integer, intent (in) :: x, y
17    f1 = x + y
18  end function f1
19  elemental subroutine combiner1 (x, y)
20    integer, intent (inout) :: x
21    integer, intent (in) :: y
22    x = x + iand (y, -4)
23  end subroutine
24  subroutine initializer1 (x, y)
25    integer :: x, y
26    if (y .ne. 3) stop 1
27    x = y
28  end subroutine
29end module udr9m1
30module udr9m2
31  use udr9m1
32  type dt
33    integer :: x
34  end type
35!$omp declare reduction (+ : dt : combiner2 (omp_in, omp_out)) &
36!$omp & initializer (initializer2 (omp_priv))
37  interface operator (+)
38    module procedure f2
39  end interface
40contains
41  type(dt) function f2 (x, y)
42    type(dt), intent (in) :: x, y
43    f2%x = x%x + y%x
44  end function f2
45  subroutine combiner2 (x, y)
46    type(dt) :: x, y
47    y = y + x
48  end subroutine combiner2
49  subroutine initializer2 (x)
50    type(dt), intent(out) :: x
51    x%x = 0
52  end subroutine initializer2
53end module udr9m2
54  use udr9m2
55  integer :: i, j
56  type(dt) :: d
57  j = 3
58  d%x = 0
59!$omp parallel do reduction (.add.: j) reduction (+ : d)
60  do i = 1, 100
61    j = j.add.iand (i, -4)
62    d = d + dt(i)
63  end do
64  if (d%x /= 5050 .or. j /= 4903) stop 2
65end
66