summaryrefslogtreecommitdiff
path: root/libgomp/testsuite/libgomp.fortran/character1.f90
blob: f75ae27e8f90997c0d754e83fbaccfd2e7c1aa72 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
! { dg-do run }
!$ use omp_lib

  character (len = 8) :: h, i
  character (len = 4) :: j, k
  h = '01234567'
  i = 'ABCDEFGH'
  j = 'IJKL'
  k = 'MN'
  call test (h, j)
contains
  subroutine test (p, q)
    character (len = 8) :: p
    character (len = 4) :: q, r
    character (len = 16) :: f
    character (len = 32) :: g
    integer, dimension (18) :: s
    logical :: l
    integer :: m
    f = 'test16'
    g = 'abcdefghijklmnopqrstuvwxyz'
    r = ''
    l = .false.
    s = -6
!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
!$omp & num_threads (4)
    m = omp_get_thread_num ()
    if (any (s .ne. -6)) l = .true.
    l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
    l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
    l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
    l = l .or. k .ne. 'MN'
!$omp barrier
    if (m .eq. 0) then
      f = 'ffffffff0'
      g = 'xyz'
      i = '123'
      k = '9876'
      p = '_abc'
      q = '_def'
      r = '1_23'
    else if (m .eq. 1) then
      f = '__'
      p = 'xxx'
      r = '7575'
    else if (m .eq. 2) then
      f = 'ZZ'
      p = 'm2'
      r = 'M2'
    else if (m .eq. 3) then
      f = 'YY'
      p = 'm3'
      r = 'M3'
    end if
    s = m
!$omp barrier
    l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
    l = l .or. q .ne. '_def'
    if (any (s .ne. m)) l = .true.
    if (m .eq. 0) then
      l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
    else if (m .eq. 1) then
      l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
    else if (m .eq. 2) then
      l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
    else if (m .eq. 3) then
      l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
    end if
!$omp end parallel
    if (l) call abort
  end subroutine test
end