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