Mercurial > hg > CbC > CbC_gcc

view libgomp/testsuite/libgomp.fortran/vla1.f90 @ 67:f6334be47118

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc from gcc-4.6-20100522 to gcc-4.6-20110318
author nobuyasu <dimolto@cr.ie.u-ryukyu.ac.jp>
date Tue, 22 Mar 2011 17:18:12 +0900
parents a06113de4d67
children 84e7813d76e9
line wrap: on
line source

! { 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
    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) firstprivate (c, d, e, f, g, h, i, j, k) &
!$omp & firstprivate (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
    x = omp_get_thread_num ()
    w = ''
    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
    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)
!$omp barrier
    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
    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