libgomp/testsuite/libgomp.fortran/udr9.f90

   1 ! { dg-do run }
   2
   3 module 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
  14 contains
  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) call abort
  27     x = y
  28   end subroutine
  29 end module udr9m1
  30 module 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
  40 contains
  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
  53 end 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) call abort
  65 end