libgomp/testsuite/libgomp.fortran/task2.f90

   1 ! { dg-options "-std=legacy" }
   2
   3   integer :: err
   4   err = 0
   5 !$omp parallel num_threads (4) default (none) shared (err)
   6 !$omp single
   7   call test
   8 !$omp end single
   9 !$omp end parallel
  10   if (err.ne.0) STOP 1
  11 contains
  12   subroutine check (x, y, l)
  13     integer :: x, y
  14     logical :: l
  15     l = l .or. x .ne. y
  16   end subroutine check
  17
  18   subroutine foo (c, d, e, f, g, h, i, j, k, n)
  19     use omp_lib
  20     integer :: n
  21     character (len = *) :: c
  22     character (len = n) :: d
  23     integer, dimension (2, 3:5, n) :: e
  24     integer, dimension (2, 3:n, n) :: f
  25     character (len = *), dimension (5, 3:n) :: g
  26     character (len = n), dimension (5, 3:n) :: h
  27     real, dimension (:, :, :) :: i
  28     double precision, dimension (3:, 5:, 7:) :: j
  29     integer, dimension (:, :, :) :: k
  30     logical :: l
  31     integer :: p, q, r
  32     character (len = n) :: s
  33     integer, dimension (2, 3:5, n) :: t
  34     integer, dimension (2, 3:n, n) :: u
  35     character (len = n), dimension (5, 3:n) :: v
  36     character (len = 2 * n + 24) :: w
  37     integer :: x, z
  38     character (len = 1) :: y
  39     s = 'PQRSTUV'
  40     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
  41     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
  42     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
  43     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
  44 !$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
  45 !$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err)
  46     l = .false.
  47     l = l .or. c .ne. 'abcdefghijkl'
  48     l = l .or. d .ne. 'ABCDEFG'
  49     l = l .or. s .ne. 'PQRSTUV'
  50     do 100, p = 1, 2
  51       do 100, q = 3, 7
  52         do 100, r = 1, 7
  53           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
  54           l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
  55           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
  56           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
  57           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
  58           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
  59           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
  60           l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
  61           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
  62           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
  63 100 continue
  64     do 101, p = 3, 5
  65       do 101, q = 2, 6
  66         do 101, r = 1, 7
  67           l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
  68           l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
  69 101 continue
  70     do 102, p = 1, 5
  71       do 102, q = 4, 6
  72         l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
  73 102 continue
  74     call check (size (e, 1), 2, l)
  75     call check (size (e, 2), 3, l)
  76     call check (size (e, 3), 7, l)
  77     call check (size (e), 42, l)
  78     call check (size (f, 1), 2, l)
  79     call check (size (f, 2), 5, l)
  80     call check (size (f, 3), 7, l)
  81     call check (size (f), 70, l)
  82     call check (size (g, 1), 5, l)
  83     call check (size (g, 2), 5, l)
  84     call check (size (g), 25, l)
  85     call check (size (h, 1), 5, l)
  86     call check (size (h, 2), 5, l)
  87     call check (size (h), 25, l)
  88     call check (size (i, 1), 3, l)
  89     call check (size (i, 2), 5, l)
  90     call check (size (i, 3), 7, l)
  91     call check (size (i), 105, l)
  92     call check (size (j, 1), 4, l)
  93     call check (size (j, 2), 5, l)
  94     call check (size (j, 3), 7, l)
  95     call check (size (j), 140, l)
  96     call check (size (k, 1), 5, l)
  97     call check (size (k, 2), 1, l)
  98     call check (size (k, 3), 3, l)
  99     call check (size (k), 15, l)
 100     if (l) then
 101 !$omp atomic
 102       err = err + 1
 103     end if
 104 !$omp end task
 105   c = ''
 106   d = ''
 107   e(:, :, :) = 199
 108   f(:, :, :) = 198
 109   g(:, :) = ''
 110   h(:, :) = ''
 111   i(:, :, :) = 7.0
 112   j(:, :, :) = 8.0
 113   k(:, :, :) = 9
 114   s = ''
 115   t(:, :, :) = 10
 116   u(:, :, :) = 11
 117   v(:, :) = ''
 118   end subroutine foo
 119
 120   subroutine test
 121     character (len = 12) :: c
 122     character (len = 7) :: d
 123     integer, dimension (2, 3:5, 7) :: e
 124     integer, dimension (2, 3:7, 7) :: f
 125     character (len = 12), dimension (5, 3:7) :: g
 126     character (len = 7), dimension (5, 3:7) :: h
 127     real, dimension (3:5, 2:6, 1:7) :: i
 128     double precision, dimension (3:6, 2:6, 1:7) :: j
 129     integer, dimension (1:5, 7:7, 4:6) :: k
 130     integer :: p, q, r
 131     c = 'abcdefghijkl'
 132     d = 'ABCDEFG'
 133     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
 134     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
 135     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
 136     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
 137     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
 138     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
 139     forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
 140     forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
 141     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
 142     call foo (c, d, e, f, g, h, i, j, k, 7)
 143   end subroutine test
 144 end