libgomp/testsuite/libgomp.fortran/udr15.f90

   1 ! { dg-do run }
   2
   3 module udr15m1
   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. f3 (omp_in, -4)) &
   9 !$omp & initializer (s1 (omp_priv, omp_orig))
  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   integer function f3 (x, y)
  19     integer, intent (in) :: x, y
  20     f3 = iand (x, y)
  21   end function f3
  22   subroutine s1 (x, y)
  23     integer, intent (in) :: y
  24     integer, intent (out) :: x
  25     x = 3
  26   end subroutine s1
  27 end module udr15m1
  28 module udr15m2
  29   use udr15m1, f4 => f1, f5 => f3, s2 => s1, operator (.addtwo.) => operator (.add.)
  30   type dt
  31     integer :: x
  32   end type
  33 !$omp declare reduction (+ : dt : omp_out = f6 (omp_out + omp_in)) &
  34 !$omp & initializer (s3 (omp_priv))
  35   interface operator (+)
  36     module procedure f2
  37   end interface
  38 contains
  39   type(dt) function f2 (x, y)
  40     type(dt), intent (in) :: x, y
  41     f2%x = x%x + y%x
  42   end function f2
  43   type(dt) function f6 (x)
  44     type(dt), intent (in) :: x
  45     f6%x = x%x
  46   end function f6
  47   subroutine s3 (x)
  48     type(dt), intent (out) :: x
  49     x = dt(0)
  50   end subroutine
  51 end module udr15m2
  52   use udr15m2, operator (.addthree.) => operator (.addtwo.), &
  53                f7 => f4, f8 => f6, s4 => s3
  54   integer :: i, j
  55   type(dt) :: d
  56   j = 3
  57   d%x = 0
  58 !$omp parallel do reduction (.addthree.: j) reduction (+ : d)
  59   do i = 1, 100
  60     j = j.addthree.iand (i, -4)
  61     d = d + dt(i)
  62   end do
  63   if (d%x /= 5050 .or. j /= 4903) call abort
  64 end