gcc/fortran/

	* dump-parse-tree.c (show_omp_namelist): Dump reduction
	id in each list item.
	(show_omp_node): Only handle OMP_LIST_REDUCTION, not
	OMP_LIST_REDUCTION_FIRST .. OMP_LIST_REDUCTION_LAST.  Don't
	dump reduction id here.
	* frontend-passes.c (dummy_code_callback): Renamed to...
	(gfc_dummy_code_callback): ... this.  No longer static.
	(optimize_reduction): Use gfc_dummy_code_callback instead of
	dummy_code_callback.
	* gfortran.h (gfc_statement): Add ST_OMP_DECLARE_REDUCTION.
	(symbol_attribute): Add omp_udr_artificial_var bitfield.
	(gfc_omp_reduction_op): New enum.
	(gfc_omp_namelist): Add rop and udr fields.
	(OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT,
	OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV,
	OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND,
	OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST): Removed.
	(OMP_LIST_REDUCTION): New.
	(gfc_omp_udr): New type.
	(gfc_get_omp_udr): Define.
	(gfc_symtree): Add n.omp_udr field.
	(gfc_namespace): Add omp_udr_root field, add omp_udr_ns bitfield.
	(gfc_free_omp_udr, gfc_omp_udr_find, gfc_resolve_omp_udrs,
	gfc_dummy_code_callback): New prototypes.
	* match.h (gfc_match_omp_declare_reduction): New prototype.
	* module.c (MOD_VERSION): Increase to 13.
	(omp_declare_reduction_stmt): New array.
	(mio_omp_udr_expr, write_omp_udr, write_omp_udrs, load_omp_udrs):
	New functions.
	(read_module): Read OpenMP user defined reductions.
	(write_module): Write OpenMP user defined reductions.
	* openmp.c: Include arith.h.
	(gfc_free_omp_udr, gfc_find_omp_udr): New functions.
	(gfc_match_omp_clauses): Handle user defined reductions.
	Store reduction kind into gfc_omp_namelist instead of using
	several OMP_LIST_* entries.
	(match_udr_expr, gfc_omp_udr_predef, gfc_omp_udr_find,
	gfc_match_omp_declare_reduction): New functions.
	(resolve_omp_clauses): Adjust for reduction clauses being only
	in OMP_LIST_REDUCTION list.  Diagnose missing UDRs.
	(struct omp_udr_callback_data): New type.
	(omp_udr_callback, gfc_resolve_omp_udr, gfc_resolve_omp_udrs): New
	functions.
	* parse.c (decode_omp_directive): Handle !$omp declare reduction.
	(case_decl): Add ST_OMP_DECLARE_REDUCTION.
	(gfc_ascii_statement): Print ST_OMP_DECLARE_REDUCTION.
	* resolve.c (resolve_fl_variable): Allow len=: or len=* on
	sym->attr.omp_udr_artificial_var symbols.
	(resolve_types): Call gfc_resolve_omp_udrs.
	* symbol.c (gfc_get_uop): If gfc_current_ns->omp_udr_ns,
	use parent ns instead of gfc_current_ns.
	(gfc_get_sym_tree): Don't insert symbols into
	namespaces with omp_udr_ns set.
	(free_omp_udr_tree): New function.
	(gfc_free_namespace): Call it.
	* trans-openmp.c (struct omp_udr_find_orig_data): New type.
	(omp_udr_find_orig, gfc_trans_omp_udr_expr): New functions.
	(gfc_trans_omp_array_reduction): Renamed to...
	(gfc_trans_omp_array_reduction_or_udr): ... this.  Remove SYM
	argument, instead pass gfc_omp_namelist pointer N.  Handle
	user defined reductions.
	(gfc_trans_omp_reduction_list): Remove REDUCTION_CODE argument.
	Handle user defined reductions and reduction ops in gfc_omp_namelist.
	(gfc_trans_omp_clauses): Adjust for just a single OMP_LIST_REDUCTION
	list.
	(gfc_split_omp_clauses): Likewise.
gcc/testsuite/
	* gfortran.dg/gomp/allocatable_components_1.f90: Adjust for
	reduction clause diagnostic changes.
	* gfortran.dg/gomp/appendix-a/a.31.3.f90: Likewise.
	* gfortran.dg/gomp/reduction1.f90: Likewise.
	* gfortran.dg/gomp/reduction3.f90: Likewise.
	* gfortran.dg/gomp/udr1.f90: New test.
	* gfortran.dg/gomp/udr2.f90: New test.
	* gfortran.dg/gomp/udr3.f90: New test.
	* gfortran.dg/gomp/udr4.f90: New test.
	* gfortran.dg/gomp/udr5.f90: New test.
	* gfortran.dg/gomp/udr6.f90: New test.
	* gfortran.dg/gomp/udr7.f90: New test.
libgomp/
	* testsuite/libgomp.fortran/simd1.f90: New test.
	* testsuite/libgomp.fortran/udr1.f90: New test.
	* testsuite/libgomp.fortran/udr2.f90: New test.
	* testsuite/libgomp.fortran/udr3.f90: New test.
	* testsuite/libgomp.fortran/udr4.f90: New test.
	* testsuite/libgomp.fortran/udr5.f90: New test.
	* testsuite/libgomp.fortran/udr6.f90: New test.
	* testsuite/libgomp.fortran/udr7.f90: New test.
	* testsuite/libgomp.fortran/udr8.f90: New test.
	* testsuite/libgomp.fortran/udr9.f90: New test.
	* testsuite/libgomp.fortran/udr10.f90: New test.
	* testsuite/libgomp.fortran/udr11.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@211303 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed, 621 insertions, 4 deletions

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 5eb8cc90ce3..ff389bc08a1 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,18 @@
+2014-06-06  Jakub Jelinek  <jakub@redhat.com>
+
+	* testsuite/libgomp.fortran/simd1.f90: New test.
+	* testsuite/libgomp.fortran/udr1.f90: New test.
+	* testsuite/libgomp.fortran/udr2.f90: New test.
+	* testsuite/libgomp.fortran/udr3.f90: New test.
+	* testsuite/libgomp.fortran/udr4.f90: New test.
+	* testsuite/libgomp.fortran/udr5.f90: New test.
+	* testsuite/libgomp.fortran/udr6.f90: New test.
+	* testsuite/libgomp.fortran/udr7.f90: New test.
+	* testsuite/libgomp.fortran/udr8.f90: New test.
+	* testsuite/libgomp.fortran/udr9.f90: New test.
+	* testsuite/libgomp.fortran/udr10.f90: New test.
+	* testsuite/libgomp.fortran/udr11.f90: New test.
+
 2014-05-27  Uros Bizjak  <ubizjak@gmail.com>
 
 	* testsuite/libgomp.fortran/declare-simd-1.f90: Require
diff --git a/libgomp/testsuite/libgomp.fortran/simd1.f90 b/libgomp/testsuite/libgomp.fortran/simd1.f90
index abd63b0643f..b97d27f8dc5 100644
--- a/libgomp/testsuite/libgomp.fortran/simd1.f90
+++ b/libgomp/testsuite/libgomp.fortran/simd1.f90
@@ -2,22 +2,34 @@
 ! { dg-additional-options "-msse2" { target sse2_runtime } }
 ! { dg-additional-options "-mavx" { target avx_runtime } }
 
-  integer :: i, j, k, l, r, a(30)
+  type dt
+    integer :: x = 0
+  end type
+  type (dt) :: t
+  integer :: i, j, k, l, r, s, a(30)
   integer, target :: q(30)
   integer, pointer :: p(:)
+  !$omp declare reduction (foo : integer : &
+  !$omp & omp_out = omp_out + omp_in) initializer (omp_priv = 0)
+  !$omp declare reduction (+ : dt : omp_out%x = omp_out%x &
+  !$omp & + omp_in%x)
   a(:) = 1
   q(:) = 1
   p => q
   r = 0
   j = 10
   k = 20
-  !$omp simd safelen (8) reduction(+:r) linear(j, k : 2) &
-  !$omp& private (l) aligned(p : 4)
+  s = 0
+  !$omp simd safelen (8) reduction(+:r, t) linear(j, k : 2) &
+  !$omp& private (l) aligned(p : 4) reduction(foo:s)
   do i = 1, 30
     l = j + k + a(i) + p(i)
     r = r + l
     j = j + 2
     k = k + 2
+    s = s + l
+    t%x = t%x + l
   end do
-  if (r.ne.2700.or.j.ne.70.or.k.ne.80) call abort
+  if (r.ne.2700.or.j.ne.70.or.k.ne.80.or.s.ne.2700) call abort
+  if (t%x.ne.2700) call abort
 end
diff --git a/libgomp/testsuite/libgomp.fortran/udr1.f90 b/libgomp/testsuite/libgomp.fortran/udr1.f90
new file mode 100644
index 00000000000..5b8044fbe75
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr1.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+
+module udr1
+  type dt
+    integer :: x = 7
+    integer :: y = 9
+  end type
+end module udr1
+  use udr1, only : dt
+!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in)
+  integer :: i, j
+!$omp declare reduction (bar : integer : &
+!$omp & omp_out = omp_out + iand (omp_in, -4)) initializer (omp_priv = 3)
+  type (dt) :: d
+!$omp declare reduction (+ : dt : omp_out%x = omp_out%x &
+!$omp & + iand (omp_in%x, -8))
+!$omp declare reduction (foo : dt : omp_out%x = iand (omp_in%x, -8) &
+!$omp & + omp_out%x) initializer (omp_priv = dt (5, 21))
+  interface operator (+)
+    function notdefined(x, y)
+      use udr1, only : dt
+      type(dt), intent (in) :: x, y
+      type(dt) :: notdefined
+    end function
+  end interface
+  j = 0
+!$omp parallel do reduction (foo : j)
+  do i = 1, 100
+    j = j + i
+  end do
+  if (j .ne. 5050) call abort
+  j = 3
+!$omp parallel do reduction (bar : j)
+  do i = 1, 100
+    j = j + 4 * i
+  end do
+  if (j .ne. (5050 * 4 + 3)) call abort
+!$omp parallel do reduction (+ : d)
+  do i = 1, 100
+    if (d%y .ne. 9) call abort
+    d%x = d%x + 8 * i
+  end do
+  if (d%x .ne. (5050 * 8 + 7) .or. d%y .ne. 9) call abort
+  d = dt (5, 21)
+!$omp parallel do reduction (foo : d)
+  do i = 1, 100
+    if (d%y .ne. 21) call abort
+    d%x = d%x + 8 * i
+  end do
+  if (d%x .ne. (5050 * 8 + 5) .or. d%y .ne. 21) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr10.f90 b/libgomp/testsuite/libgomp.fortran/udr10.f90
new file mode 100644
index 00000000000..b64b4f48800
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr10.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+module udr10m
+  type dt
+    integer :: x = 0
+  end type
+!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in)
+!$omp declare reduction(+:dt:omp_out=omp_out+omp_in)
+  interface operator(+)
+    module procedure addme
+  end interface
+  interface operator(.add.)
+    module procedure addme
+  end interface
+contains
+  type(dt) function addme (x, y)
+    type (dt), intent (in) :: x, y
+    addme%x = x%x + y%x
+  end function addme
+end module udr10m
+program udr10
+  use udr10m, only : operator(.localadd.) => operator(.add.), &
+& operator(+), dl => dt
+  type(dl) :: j, k
+  integer :: i
+!$omp parallel do reduction(+:j) reduction(.localadd.:k)
+  do i = 1, 100
+    j = j .localadd. dl(i)
+    k = k + dl(i * 2)
+  end do
+  if (j%x /= 5050 .or. k%x /= 10100) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr11.f90 b/libgomp/testsuite/libgomp.fortran/udr11.f90
new file mode 100644
index 00000000000..61fb196105d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr11.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+
+module udr11
+  type dt
+    integer :: x = 0
+  end type
+end module udr11
+  use udr11, only : dt
+!$omp declare reduction(+:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(-:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(*:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(.and.:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(.or.:dt:omp_out%x=omp_out%x+3*omp_in%x)
+!$omp declare reduction(.eqv.:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(.neqv.:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(min:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(max:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(iand:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(ior:dt:omp_out%x=omp_out%x+omp_in%x)
+!$omp declare reduction(ieor:dt:omp_out%x=omp_out%x+omp_in%x)
+  interface operator(.and.)
+    function addme1 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme1
+    end function addme1
+  end interface
+  interface operator(.or.)
+    function addme2 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme2
+    end function addme2
+  end interface
+  interface operator(.eqv.)
+    function addme3 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme3
+    end function addme3
+  end interface
+  interface operator(.neqv.)
+    function addme4 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme4
+    end function addme4
+  end interface
+  interface operator(+)
+    function addme5 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme5
+    end function addme5
+  end interface
+  interface operator(-)
+    function addme6 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme6
+    end function addme6
+  end interface
+  interface operator(*)
+    function addme7 (x, y)
+      use udr11, only : dt
+      type (dt), intent (in) :: x, y
+      type(dt) :: addme7
+    end function addme7
+  end interface
+  type(dt) :: j, k, l, m, n, o, p, q, r, s, t, u
+  integer :: i
+!$omp parallel do reduction(.and.:j) reduction(.or.:k) &
+!$omp & reduction(.eqv.:l) reduction(.neqv.:m) &
+!$omp & reduction(min:n) reduction(max:o) &
+!$omp & reduction(iand:p) reduction(ior:q) reduction (ieor:r) &
+!$omp & reduction(+:s) reduction(-:t) reduction(*:u)
+  do i = 1, 100
+    j%x = j%x + i
+    k%x = k%x + 2 * i
+    l%x = l%x + 3 * i
+    m%x = m%x + i
+    n%x = n%x + 2 * i
+    o%x = o%x + 3 * i
+    p%x = p%x + i
+    q%x = q%x + 2 * i
+    r%x = r%x + 3 * i
+    s%x = s%x + i
+    t%x = t%x + 2 * i
+    u%x = u%x + 3 * i
+  end do
+  if (j%x /= 5050 .or. k%x /= 30300 .or. l%x /= 15150) call abort
+  if (m%x /= 5050 .or. n%x /= 10100 .or. o%x /= 15150) call abort
+  if (p%x /= 5050 .or. q%x /= 10100 .or. r%x /= 15150) call abort
+  if (s%x /= 5050 .or. t%x /= 10100 .or. u%x /= 15150) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr2.f90 b/libgomp/testsuite/libgomp.fortran/udr2.f90
new file mode 100644
index 00000000000..861a4b27022
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr2.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+
+module udr2
+  type dt
+    integer :: x = 7
+    integer :: y = 9
+  end type
+end module udr2
+  use udr2, only : dt
+!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in)
+  integer :: i, j(2:4,3:5)
+!$omp declare reduction (bar : integer : &
+!$omp & omp_out = omp_out + iand (omp_in, -4)) initializer (omp_priv = 3)
+  interface operator (+)
+    function notdefined(x, y)
+      use udr2, only : dt
+      type(dt), intent (in) :: x, y
+      type(dt) :: notdefined
+    end function
+  end interface
+  type (dt) :: d(2:4,3:5)
+!$omp declare reduction (+ : dt : omp_out%x = omp_out%x &
+!$omp & + iand (omp_in%x, -8))
+!$omp declare reduction (foo : dt : omp_out%x = iand (omp_in%x, -8) &
+!$omp & + omp_out%x) initializer (omp_priv = dt (5, 21))
+  j = 0
+!$omp parallel do reduction (foo : j)
+  do i = 1, 100
+    j = j + i
+  end do
+  if (any(j .ne. 5050)) call abort
+  j = 3
+!$omp parallel do reduction (bar : j)
+  do i = 1, 100
+    j = j + 4 * i
+  end do
+  if (any(j .ne. (5050 * 4 + 3))) call abort
+!$omp parallel do reduction (+ : d)
+  do i = 1, 100
+    if (any(d%y .ne. 9)) call abort
+    d%x = d%x + 8 * i
+  end do
+  if (any(d%x .ne. (5050 * 8 + 7)) .or. any(d%y .ne. 9)) call abort
+  d = dt (5, 21)
+!$omp parallel do reduction (foo : d)
+  do i = 1, 100
+    if (any(d%y .ne. 21)) call abort
+    d%x = d%x + 8 * i
+  end do
+  if (any(d%x .ne. (5050 * 8 + 5)) .or. any(d%y .ne. 21)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr3.f90 b/libgomp/testsuite/libgomp.fortran/udr3.f90
new file mode 100644
index 00000000000..258b6722000
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+
+!$omp declare reduction (foo : character(kind=1, len=*) &
+!$omp & : omp_out = trim(omp_out) // omp_in) initializer (omp_priv = '')
+!$omp declare reduction (bar : character(kind=1, len=:) &
+!$omp & : omp_out = trim(omp_in) // omp_out) initializer (omp_priv = '')
+!$omp declare reduction (baz : character(kind=1, len=1) &
+!$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) &
+!$omp & - ichar ('0'))) initializer (omp_priv = '0')
+!$omp declare reduction (baz : character(kind=1, len=2) &
+!$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) &
+!$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + &
+!$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00')
+  character(kind=1, len=64) :: c, d
+  character(kind = 1, len=1) :: e
+  character(kind = 1, len=1+1) :: f
+  integer :: i
+  c = ''
+  d = ''
+  e = '0'
+  f = '00'
+!$omp parallel do reduction (foo : c) reduction (bar : d) &
+!$omp & reduction (baz : e, f)
+  do i = 1, 64
+    c = trim(c) // char (ichar ('0') + i)
+    d = char (ichar ('0') + i) // d
+    e = char (ichar (e) + mod (i, 3))
+    f = char (ichar (f(1:1)) + mod (i, 2)) &
+&	// char (ichar (f(2:2)) + mod (i, 3))
+  end do
+  do i = 1, 64
+    if (index (c, char (ichar ('0') + i)) .eq. 0) call abort
+    if (index (d, char (ichar ('0') + i)) .eq. 0) call abort
+  end do
+  if (e.ne.char (ichar ('0') + 64)) call abort
+  if (f(1:1).ne.char (ichar ('0') + 32)) call abort
+  if (f(2:2).ne.char (ichar ('0') + 64)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr4.f90 b/libgomp/testsuite/libgomp.fortran/udr4.f90
new file mode 100644
index 00000000000..50f69005e3e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr4.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+
+!$omp declare reduction (foo : character(kind=1, len=*) &
+!$omp & : omp_out = trim(omp_out) // omp_in) initializer (omp_priv = '')
+!$omp declare reduction (bar : character(kind=1, len=:) &
+!$omp & : omp_out = trim(omp_in) // omp_out) initializer (omp_priv = '')
+!$omp declare reduction (baz : character(kind=1, len=1) &
+!$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) &
+!$omp & - ichar ('0'))) initializer (omp_priv = '0')
+!$omp declare reduction (baz : character(kind=1, len=2) &
+!$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) &
+!$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + &
+!$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00')
+  character(kind=1, len=64) :: c(-3:-2,1:1,7:8), d(2:3,-7:-5)
+  character(kind = 1, len=1) :: e(2:4)
+  character(kind = 1, len=1+1) :: f(8:10,9:10)
+  integer :: i, j, k
+  c = ''
+  d = ''
+  e = '0'
+  f = '00'
+!$omp parallel do reduction (foo : c) reduction (bar : d) &
+!$omp & reduction (baz : e, f) private (j, k)
+  do i = 1, 64
+    forall (j = -3:-2, k = 7:8) &
+      c(j,1,k) = trim(c(j,1,k)) // char (ichar ('0') + i)
+    d = char (ichar ('0') + i) // d
+    e = char (ichar (e) + mod (i, 3))
+    f = char (ichar (f(:,:)(1:1)) + mod (i, 2)) &
+&	// char (ichar (f(:,:)(2:2)) + mod (i, 3))
+  end do
+  do i = 1, 64
+    if (any (index (c, char (ichar ('0') + i)) .eq. 0)) call abort
+    if (any (index (d, char (ichar ('0') + i)) .eq. 0)) call abort
+  end do
+  if (any (e.ne.char (ichar ('0') + 64))) call abort
+  if (any (f(:,:)(1:1).ne.char (ichar ('0') + 32))) call abort
+  if (any (f(:,:)(2:2).ne.char (ichar ('0') + 64))) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr5.f90 b/libgomp/testsuite/libgomp.fortran/udr5.f90
new file mode 100644
index 00000000000..6dae9b9b816
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr5.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+
+module m
+  interface operator(.add.)
+    module procedure do_add
+  end interface
+  type dt
+    real :: r = 0.0
+  end type
+contains
+  function do_add(x, y)
+    type (dt), intent (in) :: x, y
+    type (dt) :: do_add
+    do_add%r = x%r + y%r
+  end function
+  subroutine dp_add(x, y)
+    double precision :: x, y
+    x = x + y
+  end subroutine
+  subroutine dp_init(x)
+    double precision :: x
+    x = 0.0
+  end subroutine
+end module
+
+program udr5
+  use m, only : operator(.add.), dt, dp_add, dp_init
+  type(dt) :: xdt, one
+  real :: r
+  integer (kind = 4) :: i4
+  integer (kind = 8) :: i8
+  real (kind = 4) :: r4
+  double precision :: dp
+!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in)
+!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) &
+!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0)
+!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) &
+!$omp & initializer (dp_init (omp_priv))
+
+  one%r = 1.0
+  r = 0.0
+  i4 = 0
+  i8 = 0
+  r4 = 0.0
+  call dp_init (dp)
+!$omp parallel reduction(.add.: xdt) reduction(+: r) &
+!$omp & reduction(foo: i4, i8, r4, dp)
+  xdt = xdt.add.one
+  r = r + 1.0
+  i4 = i4 + 1
+  i8 = i8 + 1
+  r4 = r4 + 1.0
+  call dp_add (dp, 1.0d0)
+!$omp end parallel
+  if (xdt%r .ne. r) call abort
+  if (i4.ne.r.or.i8.ne.r.or.r4.ne.r.or.dp.ne.r) call abort
+end program udr5
diff --git a/libgomp/testsuite/libgomp.fortran/udr6.f90 b/libgomp/testsuite/libgomp.fortran/udr6.f90
new file mode 100644
index 00000000000..7fb3ee5122e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr6.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+
+module m
+  interface operator(.add.)
+    module procedure do_add
+  end interface
+  type dt
+    real :: r = 0.0
+  end type
+contains
+  function do_add(x, y)
+    type (dt), intent (in) :: x, y
+    type (dt) :: do_add
+    do_add%r = x%r + y%r
+  end function
+  subroutine dp_add(x, y)
+    double precision :: x, y
+    x = x + y
+  end subroutine
+  subroutine dp_init(x)
+    double precision :: x
+    x = 0.0
+  end subroutine
+end module
+
+program udr6
+  use m, only : operator(.add.), dt, dp_add, dp_init
+  type(dt), allocatable :: xdt(:)
+  type(dt) :: one
+  real :: r
+  integer (kind = 4), allocatable, dimension(:) :: i4
+  integer (kind = 8), allocatable, dimension(:,:) :: i8
+  integer :: i
+  real (kind = 4), allocatable :: r4(:,:)
+  double precision, allocatable :: dp(:)
+!$omp declare reduction(.add.:dt:omp_out=omp_out.add.omp_in)
+!$omp declare reduction(foo:integer(4),integer(kind=8),real (kind = 4) &
+!$omp & :omp_out = omp_out + omp_in) initializer (omp_priv = 0)
+!$omp declare reduction(foo:double precision:dp_add (omp_out, omp_in)) &
+!$omp & initializer (dp_init (omp_priv))
+
+  one%r = 1.0
+  allocate (xdt(4), i4 (3), i8(-5:-2,2:3), r4(2:5,1:1), dp(7))
+  r = 0.0
+  i4 = 0
+  i8 = 0
+  r4 = 0.0
+  do i = 1, 7
+    call dp_init (dp(i))
+  end do
+!$omp parallel reduction(.add.: xdt) reduction(+: r) &
+!$omp & reduction(foo: i4, i8, r4, dp) private(i)
+  do i = 1, 4
+    xdt(i) = xdt(i).add.one
+  end do
+  r = r + 1.0
+  i4 = i4 + 1
+  i8 = i8 + 1
+  r4 = r4 + 1.0
+  do i = 1, 7
+    call dp_add (dp(i), 1.0d0)
+  end do
+!$omp end parallel
+  if (any (xdt%r .ne. r)) call abort
+  if (any (i4.ne.r).or.any(i8.ne.r)) call abort
+  if (any(r4.ne.r).or.any(dp.ne.r)) call abort
+  deallocate (xdt, i4, i8, r4, dp)
+end program udr6
diff --git a/libgomp/testsuite/libgomp.fortran/udr7.f90 b/libgomp/testsuite/libgomp.fortran/udr7.f90
new file mode 100644
index 00000000000..5253dd7d086
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr7.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+
+program udr7
+  implicit none
+  interface
+    subroutine omp_priv (x, y, z)
+      real, intent (in) :: x
+      real, intent (inout) :: y
+      real, intent (in) :: z(:)
+    end subroutine omp_priv
+    real function omp_orig (x)
+      real, intent (in) :: x
+    end function omp_orig
+  end interface
+!$omp declare reduction (omp_priv : real : &
+!$omp & omp_priv (omp_orig (omp_in), omp_out, (/ 1.0, 2.0, 3.0 /))) &
+!$omp & initializer (omp_out (omp_priv, omp_in (omp_orig)))
+  real :: x (2:4, 1:1, -2:0)
+  integer :: i
+  x = 0
+!$omp parallel do reduction (omp_priv : x)
+  do i = 1, 64
+    x = x + i
+  end do
+  if (any (x /= 2080.0)) call abort
+contains
+  subroutine omp_out (x, y)
+    real, intent (out) :: x
+    real, intent (in) :: y
+    if (y /= 4.0) call abort
+    x = 0.0
+  end subroutine omp_out
+  real function omp_in (x)
+    real, intent (in) :: x
+    omp_in = x + 4.0
+  end function omp_in
+end program udr7
+subroutine omp_priv (x, y, z)
+  real, intent (in) :: x
+  real, intent (inout) :: y
+  real, intent (in) :: z(:)
+  if (any (z .ne. (/ 1.0, 2.0, 3.0 /))) call abort
+  y = y + (x - 4.0)
+end subroutine omp_priv
+real function omp_orig (x)
+  real, intent (in) :: x
+  omp_orig = x + 4.0
+end function omp_orig
diff --git a/libgomp/testsuite/libgomp.fortran/udr8.f90 b/libgomp/testsuite/libgomp.fortran/udr8.f90
new file mode 100644
index 00000000000..9ef48a5c787
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr8.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+module udr8m1
+  integer, parameter :: a = 6
+  integer :: b
+!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in)
+!$omp declare reduction (.add. : integer : &
+!$omp & omp_out = omp_out .add. iand (omp_in, -4)) &
+!$omp & initializer (omp_priv = 3)
+  interface operator (.add.)
+    module procedure f1
+  end interface
+contains
+  integer function f1 (x, y)
+    integer, intent (in) :: x, y
+    f1 = x + y
+  end function f1
+end module udr8m1
+module udr8m2
+  use udr8m1
+  type dt
+    integer :: x
+  end type
+!$omp declare reduction (+ : dt : omp_out = omp_out + omp_in) &
+!$omp & initializer (omp_priv = dt (0))
+  interface operator (+)
+    module procedure f2
+  end interface
+contains
+  type(dt) function f2 (x, y)
+    type(dt), intent (in) :: x, y
+    f2%x = x%x + y%x
+  end function f2
+end module udr8m2
+  use udr8m2
+  integer :: i, j
+  type(dt) :: d
+  j = 3
+  d%x = 0
+!$omp parallel do reduction (.add.: j) reduction (+ : d)
+  do i = 1, 100
+    j = j.add.iand (i, -4)
+    d = d + dt(i)
+  end do
+  if (d%x /= 5050 .or. j /= 4903) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/udr9.f90 b/libgomp/testsuite/libgomp.fortran/udr9.f90
new file mode 100644
index 00000000000..a4fec1337c2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/udr9.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+
+module udr9m1
+  integer, parameter :: a = 6
+  integer :: b
+!$omp declare reduction (foo : integer : combiner1 (omp_out, omp_in)) &
+!$omp & initializer (initializer1 (omp_priv, omp_orig))
+!$omp declare reduction (.add. : integer : &
+!$omp & combiner1 (omp_out, omp_in)) &
+!$omp & initializer (initializer1 (omp_priv, omp_orig))
+  interface operator (.add.)
+    module procedure f1
+  end interface
+contains
+  integer function f1 (x, y)
+    integer, intent (in) :: x, y
+    f1 = x + y
+  end function f1
+  elemental subroutine combiner1 (x, y)
+    integer, intent (inout) :: x
+    integer, intent (in) :: y
+    x = x + iand (y, -4)
+  end subroutine
+  subroutine initializer1 (x, y)
+    integer :: x, y
+    if (y .ne. 3) call abort
+    x = y
+  end subroutine
+end module udr9m1
+module udr9m2
+  use udr9m1
+  type dt
+    integer :: x
+  end type
+!$omp declare reduction (+ : dt : combiner2 (omp_in, omp_out)) &
+!$omp & initializer (initializer2 (omp_priv))
+  interface operator (+)
+    module procedure f2
+  end interface
+contains
+  type(dt) function f2 (x, y)
+    type(dt), intent (in) :: x, y
+    f2%x = x%x + y%x
+  end function f2
+  subroutine combiner2 (x, y)
+    type(dt) :: x, y
+    y = y + x
+  end subroutine combiner2
+  subroutine initializer2 (x)
+    type(dt), intent(out) :: x
+    x%x = 0
+  end subroutine initializer2
+end module udr9m2
+  use udr9m2
+  integer :: i, j
+  type(dt) :: d
+  j = 3
+  d%x = 0
+!$omp parallel do reduction (.add.: j) reduction (+ : d)
+  do i = 1, 100
+    j = j.add.iand (i, -4)
+    d = d + dt(i)
+  end do
+  if (d%x /= 5050 .or. j /= 4903) call abort
+end