libgomp/testsuite/libgomp.fortran/character1.f90

   1 ! { dg-do run }
   2 !$ use omp_lib
   3
   4   character (len = 8) :: h, i
   5   character (len = 4) :: j, k
   6   h = '01234567'
   7   i = 'ABCDEFGH'
   8   j = 'IJKL'
   9   k = 'MN'
  10   call test (h, j)
  11 contains
  12   subroutine test (p, q)
  13     character (len = 8) :: p
  14     character (len = 4) :: q, r
  15     character (len = 16) :: f
  16     character (len = 32) :: g
  17     integer, dimension (18) :: s
  18     logical :: l
  19     integer :: m
  20     f = 'test16'
  21     g = 'abcdefghijklmnopqrstuvwxyz'
  22     r = ''
  23     l = .false.
  24     s = -6
  25 !$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
  26 !$omp & num_threads (4)
  27     m = omp_get_thread_num ()
  28     if (any (s .ne. -6)) l = .true.
  29     l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
  30     l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
  31     l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
  32     l = l .or. k .ne. 'MN'
  33 !$omp barrier
  34     if (m .eq. 0) then
  35       f = 'ffffffff0'
  36       g = 'xyz'
  37       i = '123'
  38       k = '9876'
  39       p = '_abc'
  40       q = '_def'
  41       r = '1_23'
  42     else if (m .eq. 1) then
  43       f = '__'
  44       p = 'xxx'
  45       r = '7575'
  46     else if (m .eq. 2) then
  47       f = 'ZZ'
  48       p = 'm2'
  49       r = 'M2'
  50     else if (m .eq. 3) then
  51       f = 'YY'
  52       p = 'm3'
  53       r = 'M3'
  54     end if
  55     s = m
  56 !$omp barrier
  57     l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
  58     l = l .or. q .ne. '_def'
  59     if (any (s .ne. m)) l = .true.
  60     if (m .eq. 0) then
  61       l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
  62     else if (m .eq. 1) then
  63       l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
  64     else if (m .eq. 2) then
  65       l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
  66     else if (m .eq. 3) then
  67       l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
  68     end if
  69 !$omp end parallel
  70     if (l) call abort
  71   end subroutine test
  72 end