1! { dg-do run }
2
3module m
4  interface operator(.add.)
5    module procedure do_add
6  end interface
7  type dt
8    real :: r = 0.0
9  end type
10contains
11  elemental function do_add(x, y)
12    type (dt), intent (in) :: x, y
13    type (dt) :: do_add
14    do_add%r = x%r + y%r
15  end function
16  elemental subroutine dp_add(x, y)
17    double precision, intent (inout) :: x
18    double precision, intent (in) :: y
19    x = x + y
20  end subroutine
21  elemental subroutine dp_init(x)
22    double precision, intent (out) :: x
23    x = 0.0
24  end subroutine
25end module
26
27program udr6
28  use m, only : operator(.add.), dt, dp_add, dp_init
29  type(dt), allocatable :: xdt(:)
30  type(dt) :: one
31  real :: r
32  integer (kind = 4), allocatable, dimension(:) :: i4
33  integer (kind = 8), allocatable, dimension(:,:) :: i8
34  integer :: i
35  real (kind = 4), allocatable :: r4(:,:)
36  double precision, allocatable :: dp(:)
37!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in)
38!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) &
39!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0)
40!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) &
41!$omp & initializer (dp_init (omp_priv))
42
43  one%r = 1.0
44  allocate (xdt(4), i4 (3), i8(-5:-2,2:3), r4(2:5,1:1), dp(7))
45  r = 0.0
46  i4 = 0
47  i8 = 0
48  r4 = 0.0
49  do i = 1, 7
50    call dp_init (dp(i))
51  end do
52!$omp parallel reduction(.add.: xdt) reduction(+: r) &
53!$omp & reduction(foo: i4, i8, r4, dp) private(i)
54  do i = 1, 4
55    xdt(i) = xdt(i).add.one
56  end do
57  r = r + 1.0
58  i4 = i4 + 1
59  i8 = i8 + 1
60  r4 = r4 + 1.0
61  do i = 1, 7
62    call dp_add (dp(i), 1.0d0)
63  end do
64!$omp end parallel
65  if (any (xdt%r .ne. r)) STOP 1
66  if (any (i4.ne.r).or.any(i8.ne.r)) STOP 2
67  if (any(r4.ne.r).or.any(dp.ne.r)) STOP 3
68  deallocate (xdt, i4, i8, r4, dp)
69end program udr6
70