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