[gomp] Fix lastprivate passed by reference, add a bunch of vla Fortran testcases
Jakub Jelinek
jakub@redhat.com
Sat Nov 5 20:32:00 GMT 2005
Hi!
As shown by attached vla4.f90, expand_lastprivate_clauses didn't
handle is_reference (var) properly. vla[23456].f90 are slightly
modified vla1.f90 tests that stress test various data sharing
clauses (vla1 - firstprivate, vla2 - private, vla3 - shared
vla4 - firstprivate+lastprivate, vla5 - lastprivate, vla6 - copyprivate).
With all patches I have in my tree ATM, all but vla3.f90 pass.
Ok for gomp?
vla3.f90 is the same problem as
FAIL: gcc.dg/gomp/vla-3.c (test for excess errors)
that's been present for several days now, particularly ICE on
scan_sharing_clauses's:
case OMP_CLAUSE_SHARED:
gcc_assert (is_parallel_ctx (ctx));
decl = OMP_CLAUSE_DECL (c);
gcc_assert (!is_variable_sized (decl));
ICE on this line ^^^^^^^^^^^^^^^^
by_ref = use_pointer_for_field (decl, true);
if (! TREE_READONLY (decl)
|| TREE_ADDRESSABLE (decl)
|| by_ref
|| is_reference (decl))
{
install_var_field (decl, by_ref, ctx);
install_var_local (decl, ctx);
break;
}
/* We don't need to copy const scalar vars back. */
TREE_SET_CODE (c, OMP_CLAUSE_FIRSTPRIVATE);
goto do_private;
2005-11-05 Jakub Jelinek <jakub@redhat.com>
* omp-low.c (expand_lastprivate_clauses): If var is passed by
reference, dereference new_var.
* testsuite/libgomp.fortran/vla2.f90: New test.
* testsuite/libgomp.fortran/vla3.f90: New test.
* testsuite/libgomp.fortran/vla4.f90: New test.
* testsuite/libgomp.fortran/vla5.f90: New test.
* testsuite/libgomp.fortran/vla6.f90: New test.
--- gcc/omp-low.c.jj 2005-11-05 13:43:39.000000000 +0100
+++ gcc/omp-low.c 2005-11-05 18:28:17.000000000 +0100
@@ -1567,6 +1567,8 @@ expand_lastprivate_clauses (tree clauses
new_var = lookup_decl (var, ctx);
x = build_outer_var_ref (var, ctx);
+ if (is_reference (var))
+ new_var = build_fold_indirect_ref (new_var);
x = lang_hooks.decls.omp_clause_assign_op (c, x, new_var);
append_to_statement_list (x, &sub_list);
}
--- libgomp/testsuite/libgomp.fortran/vla2.f90.jj 2005-11-05 11:07:09.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/vla2.f90 2005-11-05 19:54:42.000000000 +0100
@@ -0,0 +1,142 @@
+! { 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
+ l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+ 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
+ call foo (c, d, e, f, g, h, i, j, k, 7)
+ end subroutine test
+end
--- libgomp/testsuite/libgomp.fortran/vla5.f90.jj 2005-11-05 18:53:43.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/vla5.f90 2005-11-05 18:54:40.000000000 +0100
@@ -0,0 +1,200 @@
+! { 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, z2
+ 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.
+ call omp_set_dynamic (.false.)
+ call omp_set_num_threads (6)
+!$omp parallel do default (none) lastprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) schedule (static) shared (z2)
+ do 110 z = 0, omp_get_num_threads () - 1
+ if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+ 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)
+110 continue
+!$omp end parallel do
+ if (l) call abort
+ if (z2 == 6) then
+ x = 5
+ w = 'thread5thr_number_5THREAD5THR_NUMBER_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 113, p = 1, 2
+ do 113, q = 3, 7
+ do 113, 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)
+113 continue
+ do 114, p = 3, 5
+ do 114, q = 2, 6
+ do 114, 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
+114 continue
+ do 115, p = 1, 5
+ do 115, q = 4, 6
+ l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115 continue
+ if (l) call abort
+ end if
+ 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
--- libgomp/testsuite/libgomp.fortran/vla6.f90.jj 2005-11-05 19:50:22.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/vla6.f90 2005-11-05 19:54:09.000000000 +0100
@@ -0,0 +1,191 @@
+! { 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
+ l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) shared (z)
+ 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 single
+ z = omp_get_thread_num ()
+!$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+ w = ''
+ x = z
+ 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'
+ 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 113, p = 1, 2
+ do 113, q = 3, 7
+ do 113, 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)
+113 continue
+ do 114, p = 3, 5
+ do 114, q = 2, 6
+ do 114, 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
+114 continue
+ do 115, p = 1, 5
+ do 115, q = 4, 6
+ l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115 continue
+!$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
+ call foo (c, d, e, f, g, h, i, j, k, 7)
+ end subroutine test
+end
--- libgomp/testsuite/libgomp.fortran/vla4.f90.jj 2005-11-05 11:24:12.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/vla4.f90 2005-11-05 18:51:01.000000000 +0100
@@ -0,0 +1,228 @@
+! { 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, z2
+ 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.
+ call omp_set_dynamic (.false.)
+ call omp_set_num_threads (6)
+!$omp parallel do 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) schedule (static) shared (z2) &
+!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+ do 110 z = 0, omp_get_num_threads () - 1
+ if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+ 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)
+110 continue
+!$omp end parallel do
+ if (l) call abort
+ if (z2 == 6) then
+ x = 5
+ w = 'thread5thr_number_5THREAD5THR_NUMBER_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 113, p = 1, 2
+ do 113, q = 3, 7
+ do 113, 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)
+113 continue
+ do 114, p = 3, 5
+ do 114, q = 2, 6
+ do 114, 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
+114 continue
+ do 115, p = 1, 5
+ do 115, q = 4, 6
+ l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115 continue
+ if (l) call abort
+ end if
+ 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
--- libgomp/testsuite/libgomp.fortran/vla3.f90.jj 2005-11-05 11:08:55.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/vla3.f90 2005-11-05 11:36:44.000000000 +0100
@@ -0,0 +1,191 @@
+! { 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
Jakub
More information about the Gcc-patches
mailing list