libgomp/testsuite/libgomp.fortran/udr8.f90

   1 ! { dg-do run }
   2
   3 module udr8m1
   4   integer, parameter :: a = 6
   5   integer :: b
   6 !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in)
   7 !$omp declare reduction (.add. : integer : &
   8 !$omp & omp_out = omp_out .add. iand (omp_in, -4)) &
   9 !$omp & initializer (omp_priv = 3)
  10   interface operator (.add.)
  11     module procedure f1
  12   end interface
  13 contains
  14   integer function f1 (x, y)
  15     integer, intent (in) :: x, y
  16     f1 = x + y
  17   end function f1
  18 end module udr8m1
  19 module udr8m2
  20   use udr8m1
  21   type dt
  22     integer :: x
  23   end type
  24 !$omp declare reduction (+ : dt : omp_out = omp_out + omp_in) &
  25 !$omp & initializer (omp_priv = dt (0))
  26   interface operator (+)
  27     module procedure f2
  28   end interface
  29 contains
  30   type(dt) function f2 (x, y)
  31     type(dt), intent (in) :: x, y
  32     f2%x = x%x + y%x
  33   end function f2
  34 end module udr8m2
  35   use udr8m2
  36   integer :: i, j
  37   type(dt) :: d
  38   j = 3
  39   d%x = 0
  40 !$omp parallel do reduction (.add.: j) reduction (+ : d)
  41   do i = 1, 100
  42     j = j.add.iand (i, -4)
  43     d = d + dt(i)
  44   end do
  45   if (d%x /= 5050 .or. j /= 4903) call abort
  46 end