This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gomp] Constant length character OpenMP testcase


Hi!

I have committed this testcase (which passes).  Wrote a similar one
with variable length strings, unfortunately, even without -fopenmp
(both 4.0/4.1) f951 hangs on it, so I won't commit that yet.

2005-10-12  Jakub Jelinek  <jakub@redhat.com>

	* testsuite/libgomp.fortran/character1.f90: New test.

--- libgomp/testsuite/libgomp.fortran/character1.f90.jj	2005-10-12 20:39:40.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/character1.f90	2005-10-12 21:40:14.000000000 +0200
@@ -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

	Jakub


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]