libgomp/testsuite/libgomp.fortran/vla7.f90

   1 ! { dg-do run }
   2 ! { dg-options "-w" }
   3
   4   character (6) :: c, f2
   5   character (6) :: d(2)
   6   c = f1 (6)
   7   if (c .ne. 'opqrst') call abort
   8   c = f2 (6)
   9   if (c .ne. '_/!!/_') call abort
  10   d = f3 (6)
  11   if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
  12   d = f4 (6)
  13   if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
  14 contains
  15   function f1 (n)
  16     use omp_lib
  17     character (n) :: f1
  18     logical :: l
  19     f1 = 'abcdef'
  20     l = .false.
  21 !$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
  22     l = f1 .ne. 'abcdef'
  23     if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
  24     if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
  25 !$omp barrier
  26     l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
  27     l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
  28 !$omp end parallel
  29     f1 = 'zZzz_z'
  30 !$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
  31     l = l .or. f1 .ne. 'zZzz_z'
  32 !$omp barrier
  33 !$omp master
  34     f1 = 'abc'
  35 !$omp end master
  36 !$omp barrier
  37     l = l .or. f1 .ne. 'abc'
  38 !$omp barrier
  39     if (omp_get_thread_num () .eq. 1) f1 = 'def'
  40 !$omp barrier
  41     l = l .or. f1 .ne. 'def'
  42 !$omp end parallel
  43     if (l) call abort
  44     f1 = 'opqrst'
  45   end function f1
  46   function f3 (n)
  47     use omp_lib
  48     character (n), dimension (2) :: f3
  49     logical :: l
  50     f3 = 'abcdef'
  51     l = .false.
  52 !$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
  53     l = any (f3 .ne. 'abcdef')
  54     if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
  55     if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
  56 !$omp barrier
  57     l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
  58     l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
  59 !$omp end parallel
  60     f3 = 'zZzz_z'
  61 !$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
  62     l = l .or. any (f3 .ne. 'zZzz_z')
  63 !$omp barrier
  64 !$omp master
  65     f3 = 'abc'
  66 !$omp end master
  67 !$omp barrier
  68     l = l .or. any (f3 .ne. 'abc')
  69 !$omp barrier
  70     if (omp_get_thread_num () .eq. 1) f3 = 'def'
  71 !$omp barrier
  72     l = l .or. any (f3 .ne. 'def')
  73 !$omp end parallel
  74     if (l) call abort
  75     f3(1) = 'opqrst'
  76     f3(2) = 'a'
  77   end function f3
  78   function f4 (n)
  79     use omp_lib
  80     character (n), dimension (n - 4) :: f4
  81     logical :: l
  82     f4 = 'abcdef'
  83     l = .false.
  84 !$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
  85     l = any (f4 .ne. 'abcdef')
  86     if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
  87     if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
  88 !$omp barrier
  89     l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
  90     l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
  91     l = l .or. size (f4) .ne. 2
  92 !$omp end parallel
  93     f4 = 'zZzz_z'
  94 !$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
  95     l = l .or. any (f4 .ne. 'zZzz_z')
  96 !$omp barrier
  97 !$omp master
  98     f4 = 'abc'
  99 !$omp end master
 100 !$omp barrier
 101     l = l .or. any (f4 .ne. 'abc')
 102 !$omp barrier
 103     if (omp_get_thread_num () .eq. 1) f4 = 'def'
 104 !$omp barrier
 105     l = l .or. any (f4 .ne. 'def')
 106     l = l .or. size (f4) .ne. 2
 107 !$omp end parallel
 108     if (l) call abort
 109     f4(1) = 'Opqrst'
 110     f4(2) = 'A'
 111   end function f4
 112 end
 113 function f2 (n)
 114   use omp_lib
 115   character (*) :: f2
 116   logical :: l
 117   f2 = 'abcdef'
 118   l = .false.
 119 !$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
 120   l = f2 .ne. 'abcdef'
 121   if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
 122   if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
 123 !$omp barrier
 124   l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
 125   l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
 126 !$omp end parallel
 127   f2 = 'zZzz_z'
 128 !$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
 129   l = l .or. f2 .ne. 'zZzz_z'
 130 !$omp barrier
 131 !$omp master
 132   f2 = 'abc'
 133 !$omp end master
 134 !$omp barrier
 135   l = l .or. f2 .ne. 'abc'
 136 !$omp barrier
 137   if (omp_get_thread_num () .eq. 1) f2 = 'def'
 138 !$omp barrier
 139   l = l .or. f2 .ne. 'def'
 140 !$omp end parallel
 141   if (l) call abort
 142   f2 = '_/!!/_'
 143 end function f2