Subversion Repositories openrisc

! { dg-do run }

  call test
contains
  subroutine check (x, y, l)
    integer :: x, y
    logical :: l
    l = l .or. x .ne. y
  end subroutine check

  subroutine foo (c, d, e, f, g, h, i, j, k, n)
    use omp_lib
    integer :: n
    character (len = *) :: c
    character (len = n) :: d
    integer, dimension (2, 3:5, n) :: e
    integer, dimension (2, 3:n, n) :: f
    character (len = *), dimension (5, 3:n) :: g
    character (len = n), dimension (5, 3:n) :: h
    real, dimension (:, :, :) :: i
    double precision, dimension (3:, 5:, 7:) :: j
    integer, dimension (:, :, :) :: k
    logical :: l
    integer :: p, q, r
    character (len = n) :: s
    integer, dimension (2, 3:5, n) :: t
    integer, dimension (2, 3:n, n) :: u
    character (len = n), dimension (5, 3:n) :: v
    character (len = 2 * n + 24) :: w
    integer :: x, z
    character (len = 1) :: y
    s = 'PQRSTUV'
    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
    l = .false.
!$omp parallel default (none) shared (c, d, e, f, g, h, i, j, k) &
!$omp & shared (s, t, u, v) reduction (.or.:l) num_threads (6) &
!$omp private (p, q, r, w, x, y)
    l = l .or. c .ne. 'abcdefghijkl'
    l = l .or. d .ne. 'ABCDEFG'
    l = l .or. s .ne. 'PQRSTUV'
    do 100, p = 1, 2
      do 100, q = 3, 7
        do 100, r = 1, 7
          if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
          l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
          if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
          l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
          if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
          if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
100 continue
    do 101, p = 3, 5
      do 101, q = 2, 6
        do 101, r = 1, 7
          l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
          l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
101 continue
    do 102, p = 1, 5
      do 102, q = 4, 6
        l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
102 continue
    do 110 z = 0, omp_get_num_threads () - 1
!$omp barrier
      x = omp_get_thread_num ()
      w = ''
      if (z .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
      if (z .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
      if (z .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
      if (z .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
      if (z .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
      if (z .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
      if (x .eq. z) then
        c = w(8:19)
        d = w(1:7)
        forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
        forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
        forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
        forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
        forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
        forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
        forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
        forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
        forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
        s = w(20:26)
        forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
        forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
        forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
        forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
      end if
!$omp barrier
      x = z
      y = ''
      if (x .eq. 0) y = '0'
      if (x .eq. 1) y = '1'
      if (x .eq. 2) y = '2'
      if (x .eq. 3) y = '3'
      if (x .eq. 4) y = '4'
      if (x .eq. 5) y = '5'
      l = l .or. w(7:7) .ne. y
      l = l .or. w(19:19) .ne. y
      l = l .or. w(26:26) .ne. y
      l = l .or. w(38:38) .ne. y
      l = l .or. c .ne. w(8:19)
      l = l .or. d .ne. w(1:7)
      l = l .or. s .ne. w(20:26)
      do 103, p = 1, 2
        do 103, q = 3, 7
          do 103, r = 1, 7
            if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
            l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
            if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
            if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
            if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
            if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
            if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
            l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
            if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
            if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
103   continue
      do 104, p = 3, 5
        do 104, q = 2, 6
          do 104, r = 1, 7
            l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
            l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
104   continue
      do 105, p = 1, 5
        do 105, q = 4, 6
          l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
105   continue
110 continue
    call check (size (e, 1), 2, l)
    call check (size (e, 2), 3, l)
    call check (size (e, 3), 7, l)
    call check (size (e), 42, l)
    call check (size (f, 1), 2, l)
    call check (size (f, 2), 5, l)
    call check (size (f, 3), 7, l)
    call check (size (f), 70, l)
    call check (size (g, 1), 5, l)
    call check (size (g, 2), 5, l)
    call check (size (g), 25, l)
    call check (size (h, 1), 5, l)
    call check (size (h, 2), 5, l)
    call check (size (h), 25, l)
    call check (size (i, 1), 3, l)
    call check (size (i, 2), 5, l)
    call check (size (i, 3), 7, l)
    call check (size (i), 105, l)
    call check (size (j, 1), 4, l)
    call check (size (j, 2), 5, l)
    call check (size (j, 3), 7, l)
    call check (size (j), 140, l)
    call check (size (k, 1), 5, l)
    call check (size (k, 2), 1, l)
    call check (size (k, 3), 3, l)
    call check (size (k), 15, l)
!$omp end parallel
    if (l) call abort
  end subroutine foo

  subroutine test
    character (len = 12) :: c
    character (len = 7) :: d
    integer, dimension (2, 3:5, 7) :: e
    integer, dimension (2, 3:7, 7) :: f
    character (len = 12), dimension (5, 3:7) :: g
    character (len = 7), dimension (5, 3:7) :: h
    real, dimension (3:5, 2:6, 1:7) :: i
    double precision, dimension (3:6, 2:6, 1:7) :: j
    integer, dimension (1:5, 7:7, 4:6) :: k
    integer :: p, q, r
    c = 'abcdefghijkl'
    d = 'ABCDEFG'
    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
    call foo (c, d, e, f, g, h, i, j, k, 7)
  end subroutine test
end