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