Projet_SETI_RISC-V/riscv-gnu-toolchain/gcc/libgomp/testsuite/libgomp.fortran/character1.f90
2023-03-06 14:48:14 +01:00

72 lines
1.8 KiB
Fortran

! { 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) stop 1
end subroutine test
end