libgomp/testsuite/libgomp.fortran/udr4.f90

   1 ! { dg-do run }
   2
   3 !$omp declare reduction (foo : character(kind=1, len=*) &
   4 !$omp & : omp_out = fn (omp_out, omp_in)) initializer (omp_priv = '')
   5 !$omp declare reduction (bar : character(kind=1, len=:) &
   6 !$omp & : omp_out = fn (omp_in, omp_out)) initializer (omp_priv = '')
   7 !$omp declare reduction (baz : character(kind=1, len=1) &
   8 !$omp & : omp_out = char (ichar (omp_out) + ichar (omp_in) &
   9 !$omp & - ichar ('0'))) initializer (omp_priv = '0')
  10 !$omp declare reduction (baz : character(kind=1, len=2) &
  11 !$omp & : omp_out = char (ichar (omp_out(1:1)) + ichar (omp_in(1:1)) &
  12 !$omp & - ichar ('0')) // char (ichar (omp_out(2:2)) + &
  13 !$omp & ichar (omp_in(2:2)) - ichar ('0'))) initializer (omp_priv = '00')
  14   interface
  15     elemental function fn (x, y)
  16       character (len=64), intent (in) :: x, y
  17       character (len=64) :: fn
  18     end function
  19   end interface
  20   character(kind=1, len=64) :: c(-3:-2,1:1,7:8), d(2:3,-7:-5)
  21   character(kind = 1, len=1) :: e(2:4)
  22   character(kind = 1, len=1+1) :: f(8:10,9:10)
  23   integer :: i, j, k
  24   c = ''
  25   d = ''
  26   e = '0'
  27   f = '00'
  28 !$omp parallel do reduction (foo : c) reduction (bar : d) &
  29 !$omp & reduction (baz : e, f) private (j, k)
  30   do i = 1, 64
  31     forall (j = -3:-2, k = 7:8) &
  32       c(j,1,k) = trim(c(j,1,k)) // char (ichar ('0') + i)
  33     d = char (ichar ('0') + i) // d
  34     e = char (ichar (e) + mod (i, 3))
  35     f = char (ichar (f(:,:)(1:1)) + mod (i, 2)) &
  36 &       // char (ichar (f(:,:)(2:2)) + mod (i, 3))
  37   end do
  38   do i = 1, 64
  39     if (any (index (c, char (ichar ('0') + i)) .eq. 0)) STOP 1
  40     if (any (index (d, char (ichar ('0') + i)) .eq. 0)) STOP 2
  41   end do
  42   if (any (e.ne.char (ichar ('0') + 64))) STOP 3
  43   if (any (f(:,:)(1:1).ne.char (ichar ('0') + 32))) STOP 4
  44   if (any (f(:,:)(2:2).ne.char (ichar ('0') + 64))) STOP 5
  45 end
  46 elemental function fn (x, y)
  47   character (len=64), intent (in) :: x, y
  48   character (len=64) :: fn
  49   fn = trim(x) // y
  50 end function