Mercurial > hg > CbC > CbC_gcc
diff libgomp/testsuite/libgomp.fortran/character1.f90 @ 0:a06113de4d67
first commit
author | kent <kent@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 17 Jul 2009 14:47:48 +0900 |
parents | |
children | 84e7813d76e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libgomp/testsuite/libgomp.fortran/character1.f90 Fri Jul 17 14:47:48 2009 +0900 @@ -0,0 +1,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