diff options
| author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
|---|---|---|
| committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
| commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
| tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /libgomp/testsuite/libgomp.fortran | |
| download | cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.bz2 cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.xz | |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
127 files changed, 7284 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable1.f90 b/libgomp/testsuite/libgomp.fortran/allocatable1.f90 new file mode 100644 index 000000000..1efe2abe9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable1.f90 @@ -0,0 +1,81 @@ +! { dg-do run } +!$ use omp_lib + + integer, allocatable :: a(:, :) + integer :: b(6, 3) + integer :: i, j + logical :: k, l + b(:, :) = 16 + l = .false. + if (allocated (a)) call abort +!$omp parallel private (a, b) reduction (.or.:l) + l = l.or.allocated (a) + allocate (a(3, 6)) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.18.or.size(a,1).ne.3.or.size(a,2).ne.6 + a(3, 2) = 1 + b(3, 2) = 1 + deallocate (a) + l = l.or.allocated (a) +!$omp end parallel + if (allocated (a).or.l) call abort + allocate (a(6, 3)) + a(:, :) = 3 + if (.not.allocated (a)) call abort + l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3 + if (l) call abort +!$omp parallel private (a, b) reduction (.or.:l) + l = l.or..not.allocated (a) + a(3, 2) = 1 + b(3, 2) = 1 +!$omp end parallel + if (l.or..not.allocated (a)) call abort +!$omp parallel firstprivate (a, b) reduction (.or.:l) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3 + do i = 1, 6 + l = l.or.(a(i, 1).ne.3).or.(a(i, 2).ne.3) + l = l.or.(a(i, 3).ne.3).or.(b(i, 1).ne.16) + l = l.or.(b(i, 2).ne.16).or.(b(i, 3).ne.16) + end do + a(:, :) = omp_get_thread_num () + b(:, :) = omp_get_thread_num () +!$omp end parallel + if (any (a.ne.3).or.any (b.ne.16).or.l) call abort + k = .true. +!$omp parallel do firstprivate (a, b, k) lastprivate (a, b) & +!$omp & reduction (.or.:l) + do i = 1, 36 + l = l.or..not.allocated (a) + l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3 + if (k) then + do j = 1, 6 + l = l.or.(a(j, 1).ne.3).or.(a(j, 2).ne.3) + l = l.or.(a(j, 3).ne.3).or.(b(j, 1).ne.16) + l = l.or.(b(j, 2).ne.16).or.(b(j, 3).ne.16) + end do + k = .false. + end if + a(:, :) = i + 2 + b(:, :) = i + end do + if (any (a.ne.38).or.any (b.ne.36).or.l) call abort + deallocate (a) + if (allocated (a)) call abort + allocate (a (0:1, 0:3)) + a(:, :) = 0 +!$omp parallel do reduction (+:a) reduction (.or.:l) & +!$omp & num_threads(3) schedule(static) + do i = 0, 7 + l = l.or..not.allocated (a) + l = l.or.size(a).ne.8.or.size(a,1).ne.2.or.size(a,2).ne.4 + a(modulo (i, 2), i / 2) = a(modulo (i, 2), i / 2) + i + a(i / 4, modulo (i, 4)) = a(i / 4, modulo (i, 4)) + i + end do + if (l) call abort + do i = 0, 1 + do j = 0, 3 + if (a(i, j) .ne. (5*i + 3*j)) call abort + end do + end do +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable2.f90 b/libgomp/testsuite/libgomp.fortran/allocatable2.f90 new file mode 100644 index 000000000..a37616b04 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable2.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } +!$ use omp_lib + + integer, save, allocatable :: a(:, :) + integer, allocatable :: b(:, :) + integer :: n + logical :: l +!$omp threadprivate (a) + if (allocated (a)) call abort + call omp_set_dynamic (.false.) + l = .false. +!$omp parallel num_threads (4) reduction(.or.:l) + allocate (a(-1:1, 7:10)) + a(:, :) = omp_get_thread_num () + 6 + l = l.or..not.allocated (a) + l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4 +!$omp end parallel + if (l.or.any(a.ne.6)) call abort () +!$omp parallel num_threads (4) copyin (a) reduction(.or.:l) private (b) + l = l.or.allocated (b) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4 + l = l.or.any(a.ne.6) + allocate (b(1, 3)) + a(:, :) = omp_get_thread_num () + 36 + b(:, :) = omp_get_thread_num () + 66 + !$omp single + n = omp_get_thread_num () + !$omp end single copyprivate (a, b) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.12.or.size(a,1).ne.3.or.size(a,2).ne.4 + l = l.or.any(a.ne.(n + 36)) + l = l.or..not.allocated (b) + l = l.or.size(b).ne.3.or.size(b,1).ne.1.or.size(b,2).ne.3 + l = l.or.any(b.ne.(n + 66)) + deallocate (b) + l = l.or.allocated (b) +!$omp end parallel + if (n.lt.0 .or. n.ge.4) call abort + if (l.or.any(a.ne.(n + 36))) call abort +!$omp parallel num_threads (4) reduction(.or.:l) + deallocate (a) + l = l.or.allocated (a) +!$omp end parallel + if (l.or.allocated (a)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable3.f90 b/libgomp/testsuite/libgomp.fortran/allocatable3.f90 new file mode 100644 index 000000000..fe3714a2b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable3.f90 @@ -0,0 +1,21 @@ +! { dg-do run } + + integer, allocatable :: a(:) + integer :: i + logical :: l + l = .false. + if (allocated (a)) call abort +!$omp parallel private (a) reduction (.or.:l) + allocate (a (-7:-5)) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.3.or.size(a,1).ne.3 + a(:) = 0 + !$omp do private (a) + do i = 1, 7 + a(:) = i + l = l.or.any (a.ne.i) + end do + l = l.or.any (a.ne.0) + deallocate (a) +!$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable4.f90 b/libgomp/testsuite/libgomp.fortran/allocatable4.f90 new file mode 100644 index 000000000..996578c94 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable4.f90 @@ -0,0 +1,47 @@ +! { dg-do run } + + integer, allocatable :: a(:, :) + integer :: b(6, 3) + integer :: i, j + logical :: k, l + b(:, :) = 16 + l = .false. + if (allocated (a)) call abort +!$omp task private (a, b) shared (l) + l = l.or.allocated (a) + allocate (a(3, 6)) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.18.or.size(a,1).ne.3.or.size(a,2).ne.6 + a(3, 2) = 1 + b(3, 2) = 1 + deallocate (a) + l = l.or.allocated (a) +!$omp end task +!$omp taskwait + if (allocated (a).or.l) call abort + allocate (a(6, 3)) + a(:, :) = 3 + if (.not.allocated (a)) call abort + l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3 + if (l) call abort +!$omp task private (a, b) shared (l) + l = l.or..not.allocated (a) + a(3, 2) = 1 + b(3, 2) = 1 +!$omp end task +!$omp taskwait + if (l.or..not.allocated (a)) call abort +!$omp task firstprivate (a, b) shared (l) + l = l.or..not.allocated (a) + l = l.or.size(a).ne.18.or.size(a,1).ne.6.or.size(a,2).ne.3 + do i = 1, 6 + l = l.or.(a(i, 1).ne.3).or.(a(i, 2).ne.3) + l = l.or.(a(i, 3).ne.3).or.(b(i, 1).ne.16) + l = l.or.(b(i, 2).ne.16).or.(b(i, 3).ne.16) + end do + a(:, :) = 7 + b(:, :) = 8 +!$omp end task +!$omp taskwait + if (any (a.ne.3).or.any (b.ne.16).or.l) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable5.f90 b/libgomp/testsuite/libgomp.fortran/allocatable5.f90 new file mode 100644 index 000000000..418093024 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable5.f90 @@ -0,0 +1,17 @@ +! PR fortran/42866 +! { dg-do run } + +program pr42866 + integer, allocatable :: a(:) + allocate (a(16)) + a = 0 + !$omp parallel + !$omp sections reduction(+:a) + a = a + 1 + !$omp section + a = a + 2 + !$omp end sections + !$omp end parallel + if (any (a.ne.3)) call abort + deallocate (a) +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable6.f90 b/libgomp/testsuite/libgomp.fortran/allocatable6.f90 new file mode 100644 index 000000000..47b67aa56 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable6.f90 @@ -0,0 +1,45 @@ +! PR fortran/46874 +! { dg-do run } + + interface + subroutine sub (a, b, c, d, n) + integer :: n + integer, allocatable :: a(:), b(:), c(:), d(:) + end subroutine + end interface + + integer, allocatable :: a(:), b(:), c(:), d(:) + integer :: i, j + allocate (a(50), b(50), c(50), d(50)) + do i = 1, 50 + a(i) = 2 + modulo (i, 7) + b(i) = 179 - modulo (i, 11) + end do + c = 0 + d = 2147483647 + call sub (a, b, c, d, 50) + do i = 1, 50 + j = 0 + if (i .eq. 3) then + j = 8 + else if (i .gt. 1 .and. i .lt. 9) then + j = 7 + end if + if (c(i) .ne. j) call abort + j = 179 - modulo (i, 11) + if (i .gt. 1 .and. i .lt. 9) j = i + if (d(i) .ne. j) call abort + end do + deallocate (a, b, c, d) +end + +subroutine sub (a, b, c, d, n) + integer :: n + integer, allocatable :: a(:), b(:), c(:), d(:) +!$omp parallel do shared(a, b) reduction(+:c) reduction(min:d) + do i = 1, n + c(a(i)) = c(a(i)) + 1 + d(i) = min(d(i), b(i)) + d(a(i)) = min(d(a(i)), a(i)) + end do +end diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 new file mode 100644 index 000000000..3d95451ea --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } + SUBROUTINE WORK(N) + INTEGER N + END SUBROUTINE WORK + SUBROUTINE SUB3(N) + INTEGER N + CALL WORK(N) +!$OMP BARRIER + CALL WORK(N) + END SUBROUTINE SUB3 + SUBROUTINE SUB2(K) + INTEGER K +!$OMP PARALLEL SHARED(K) + CALL SUB3(K) +!$OMP END PARALLEL + END SUBROUTINE SUB2 + SUBROUTINE SUB1(N) + INTEGER N + INTEGER I +!$OMP PARALLEL PRIVATE(I) SHARED(N) +!$OMP DO + DO I = 1, N + CALL SUB2(I) + END DO +!$OMP END PARALLEL + END SUBROUTINE SUB1 + PROGRAM A15 + CALL SUB1(2) + CALL SUB2(2) + CALL SUB3(2) + END PROGRAM A15 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 new file mode 100644 index 000000000..014d4fd5a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 @@ -0,0 +1,41 @@ +! { dg-do run } + REAL FUNCTION WORK1(I) + INTEGER I + WORK1 = 1.0 * I + RETURN + END FUNCTION WORK1 + + REAL FUNCTION WORK2(I) + INTEGER I + WORK2 = 2.0 * I + RETURN + END FUNCTION WORK2 + + SUBROUTINE SUBA16(X, Y, INDEX, N) + REAL X(*), Y(*) + INTEGER INDEX(*), N + INTEGER I +!$OMP PARALLEL DO SHARED(X, Y, INDEX, N) + DO I=1,N +!$OMP ATOMIC + X(INDEX(I)) = X(INDEX(I)) + WORK1(I) + Y(I) = Y(I) + WORK2(I) + ENDDO + END SUBROUTINE SUBA16 + + PROGRAM A16 + REAL X(1000), Y(10000) + INTEGER INDEX(10000) + INTEGER I + DO I=1,10000 + INDEX(I) = MOD(I, 1000) + 1 + Y(I) = 0.0 + ENDDO + DO I = 1,1000 + X(I) = 0.0 + ENDDO + CALL SUBA16(X, Y, INDEX, 10000) + DO I = 1,10 + PRINT *, "X(", I, ") = ", X(I), ", Y(", I, ") = ", Y(I) + ENDDO + END PROGRAM A16 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 new file mode 100644 index 000000000..3321485ef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! { dg-options "-ffixed-form" } + REAL FUNCTION FN1(I) + INTEGER I + FN1 = I * 2.0 + RETURN + END FUNCTION FN1 + + REAL FUNCTION FN2(A, B) + REAL A, B + FN2 = A + B + RETURN + END FUNCTION FN2 + + PROGRAM A18 + INCLUDE "omp_lib.h" ! or USE OMP_LIB + INTEGER ISYNC(256) + REAL WORK(256) + REAL RESULT(256) + INTEGER IAM, NEIGHBOR +!$OMP PARALLEL PRIVATE(IAM, NEIGHBOR) SHARED(WORK, ISYNC) NUM_THREADS(4) + IAM = OMP_GET_THREAD_NUM() + 1 + ISYNC(IAM) = 0 +!$OMP BARRIER +! Do computation into my portion of work array + WORK(IAM) = FN1(IAM) +! Announce that I am done with my work. +! The first flush ensures that my work is made visible before +! synch. The second flush ensures that synch is made visible. +!$OMP FLUSH(WORK,ISYNC) + ISYNC(IAM) = 1 +!$OMP FLUSH(ISYNC) + +! Wait until neighbor is done. The first flush ensures that +! synch is read from memory, rather than from the temporary +! view of memory. The second flush ensures that work is read +! from memory, and is done so after the while loop exits. + IF (IAM .EQ. 1) THEN + NEIGHBOR = OMP_GET_NUM_THREADS() + ELSE + NEIGHBOR = IAM - 1 + ENDIF + DO WHILE (ISYNC(NEIGHBOR) .EQ. 0) +!$OMP FLUSH(ISYNC) + END DO +!$OMP FLUSH(WORK, ISYNC) + RESULT(IAM) = FN2(WORK(NEIGHBOR), WORK(IAM)) +!$OMP END PARALLEL + DO I=1,4 + IF (I .EQ. 1) THEN + NEIGHBOR = 4 + ELSE + NEIGHBOR = I - 1 + ENDIF + IF (RESULT(I) .NE. I * 2 + NEIGHBOR * 2) THEN + CALL ABORT + ENDIF + ENDDO + END PROGRAM A18 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 new file mode 100644 index 000000000..1fe1c4247 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 @@ -0,0 +1,60 @@ +! { dg-do run } + SUBROUTINE F1(Q) + COMMON /DATA/ P, X + INTEGER, TARGET :: X + INTEGER, POINTER :: P + INTEGER Q + Q=1 +!$OMP FLUSH + ! X, P and Q are flushed + ! because they are shared and accessible + END SUBROUTINE F1 + SUBROUTINE F2(Q) + COMMON /DATA/ P, X + INTEGER, TARGET :: X + INTEGER, POINTER :: P + INTEGER Q +!$OMP BARRIER + Q=2 +!$OMP BARRIER + ! a barrier implies a flush + ! X, P and Q are flushed + ! because they are shared and accessible + END SUBROUTINE F2 + + INTEGER FUNCTION G(N) + COMMON /DATA/ P, X + INTEGER, TARGET :: X + INTEGER, POINTER :: P + INTEGER N + INTEGER I, J, SUM + I=1 + SUM = 0 + P=1 +!$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2) + CALL F1(J) + ! I, N and SUM were not flushed + ! because they were not accessible in F1 + ! J was flushed because it was accessible + SUM = SUM + J + CALL F2(J) + ! I, N, and SUM were not flushed + ! because they were not accessible in f2 + ! J was flushed because it was accessible + SUM = SUM + I + J + P + N +!$OMP END PARALLEL + G = SUM + END FUNCTION G + + PROGRAM A19 + COMMON /DATA/ P, X + INTEGER, TARGET :: X + INTEGER, POINTER :: P + INTEGER RESULT, G + P => X + RESULT = G(10) + PRINT *, RESULT + IF (RESULT .NE. 30) THEN + CALL ABORT + ENDIF + END PROGRAM A19 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 new file mode 100644 index 000000000..2b09f5b1f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +PROGRAM A2 + INCLUDE "omp_lib.h" ! or USE OMP_LIB + INTEGER X + X=2 +!$OMP PARALLEL NUM_THREADS(2) SHARED(X) + IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN + X=5 + ELSE + ! PRINT 1: The following read of x has a race + PRINT *,"1: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X + ENDIF +!$OMP BARRIER + IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN + ! PRINT 2 + PRINT *,"2: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X + ELSE + ! PRINT 3 + PRINT *,"3: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X + ENDIF +!$OMP END PARALLEL +END PROGRAM A2 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 new file mode 100644 index 000000000..c22fa1169 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } + SUBROUTINE WORK(K) + INTEGER k +!$OMP ORDERED + WRITE(*,*) K +!$OMP END ORDERED + END SUBROUTINE WORK + SUBROUTINE SUBA21(LB, UB, STRIDE) + INTEGER LB, UB, STRIDE + INTEGER I +!$OMP PARALLEL DO ORDERED SCHEDULE(DYNAMIC) + DO I=LB,UB,STRIDE + CALL WORK(I) + END DO +!$OMP END PARALLEL DO + END SUBROUTINE SUBA21 + PROGRAM A21 + CALL SUBA21(1,100,5) + END PROGRAM A21 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 new file mode 100644 index 000000000..fff4e6d49 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + + PROGRAM A22_7_GOOD + INTEGER, ALLOCATABLE, SAVE :: A(:) + INTEGER, POINTER, SAVE :: PTR + INTEGER, SAVE :: I + INTEGER, TARGET :: TARG + LOGICAL :: FIRSTIN = .TRUE. +!$OMP THREADPRIVATE(A, I, PTR) + ALLOCATE (A(3)) + A = (/1,2,3/) + PTR => TARG + I=5 +!$OMP PARALLEL COPYIN(I, PTR) +!$OMP CRITICAL + IF (FIRSTIN) THEN + TARG = 4 ! Update target of ptr + I = I + 10 + IF (ALLOCATED(A)) A = A + 10 + FIRSTIN = .FALSE. + END IF + IF (ALLOCATED(A)) THEN + PRINT *, "a = ", A + ELSE + PRINT *, "A is not allocated" + END IF + PRINT *, "ptr = ", PTR + PRINT *, "i = ", I + PRINT * +!$OMP END CRITICAL +!$OMP END PARALLEL + END PROGRAM A22_7_GOOD diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 new file mode 100644 index 000000000..18c812ac4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + MODULE A22_MODULE8 + REAL, POINTER :: WORK(:) + SAVE WORK +!$OMP THREADPRIVATE(WORK) + END MODULE A22_MODULE8 + SUBROUTINE SUB1(N) + USE A22_MODULE8 +!$OMP PARALLEL PRIVATE(THE_SUM) + ALLOCATE(WORK(N)) + CALL SUB2(THE_SUM) + WRITE(*,*)THE_SUM +!$OMP END PARALLEL + END SUBROUTINE SUB1 + SUBROUTINE SUB2(THE_SUM) + USE A22_MODULE8 + WORK(:) = 10 + THE_SUM=SUM(WORK) + END SUBROUTINE SUB2 + PROGRAM A22_8_GOOD + N = 10 + CALL SUB1(N) + END PROGRAM A22_8_GOOD + +! { dg-final { cleanup-modules "a22_module8" } } diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 new file mode 100644 index 000000000..e9ebf87af --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 @@ -0,0 +1,11 @@ +! { dg-do run } + PROGRAM A26 + INTEGER I, J + I=1 + J=2 +!$OMP PARALLEL PRIVATE(I) FIRSTPRIVATE(J) + I=3 + J=J+2 +!$OMP END PARALLEL + PRINT *, I, J ! I and J are undefined + END PROGRAM A26 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 new file mode 100644 index 000000000..c271333a8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 @@ -0,0 +1,14 @@ +! { dg-do run } + + SUBROUTINE SUB() + COMMON /BLOCK/ X + PRINT *,X ! X is undefined + END SUBROUTINE SUB + PROGRAM A28_1 + COMMON /BLOCK/ X + X = 1.0 +!$OMP PARALLEL PRIVATE (X) + X = 2.0 + CALL SUB() +!$OMP END PARALLEL + END PROGRAM A28_1 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 new file mode 100644 index 000000000..1145e5410 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 @@ -0,0 +1,16 @@ +! { dg-do run } + + PROGRAM A28_2 + COMMON /BLOCK2/ X + X = 1.0 +!$OMP PARALLEL PRIVATE (X) + X = 2.0 + CALL SUB() +!$OMP END PARALLEL + CONTAINS + SUBROUTINE SUB() + COMMON /BLOCK2/ Y + PRINT *,X ! X is undefined + PRINT *,Y ! Y is undefined + END SUBROUTINE SUB + END PROGRAM A28_2 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 new file mode 100644 index 000000000..a337f3bc7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 @@ -0,0 +1,11 @@ +! { dg-do run } + + PROGRAM A28_3 + EQUIVALENCE (X,Y) + X = 1.0 +!$OMP PARALLEL PRIVATE(X) + PRINT *,Y ! Y is undefined + Y = 10 + PRINT *,X ! X is undefined +!$OMP END PARALLEL + END PROGRAM A28_3 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 new file mode 100644 index 000000000..c5a5cd74c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + + PROGRAM A28_4 + INTEGER I, J + INTEGER A(100), B(100) + EQUIVALENCE (A(51), B(1)) +!$OMP PARALLEL DO DEFAULT(PRIVATE) PRIVATE(I,J) LASTPRIVATE(A) + DO I=1,100 + DO J=1,100 + B(J) = J - 1 + ENDDO + DO J=1,100 + A(J) = J ! B becomes undefined at this point + ENDDO + DO J=1,50 + B(J) = B(J) + 1 ! B is undefined + ! A becomes undefined at this point + ENDDO + ENDDO +!$OMP END PARALLEL DO ! The LASTPRIVATE write for A has + ! undefined results + PRINT *, B ! B is undefined since the LASTPRIVATE + ! write of A was not defined + END PROGRAM A28_4 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 new file mode 100644 index 000000000..08de997f8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-w" } +! +! "-w" added as libgomp/testsuite seemingly cannot parse with +! dg-warning Fortran's output. Fortran warns for "call sub1(a)" +! that there is a "Rank mismatch in argument 'x'". + + SUBROUTINE SUB1(X) + DIMENSION X(10) + ! This use of X does not conform to the + ! specification. It would be legal Fortran 90, + ! but the OpenMP private directive allows the + ! compiler to break the sequence association that + ! A had with the rest of the common block. + FORALL (I = 1:10) X(I) = I + END SUBROUTINE SUB1 + PROGRAM A28_5 + COMMON /BLOCK5/ A + DIMENSION B(10) + EQUIVALENCE (A,B(1)) + ! the common block has to be at least 10 words + A=0 +!$OMP PARALLEL PRIVATE(/BLOCK5/) + ! Without the private clause, + ! we would be passing a member of a sequence + ! that is at least ten elements long. + ! With the private clause, A may no longer be + ! sequence-associated. + CALL SUB1(A) +!$OMP MASTER + PRINT *, A +!$OMP END MASTER +!$OMP END PARALLEL + END PROGRAM A28_5 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 new file mode 100644 index 000000000..0a1757272 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 @@ -0,0 +1,6 @@ +! { dg-do run } +! { dg-options "-ffixed-form" } + PROGRAM A3 +!234567890 +!$ PRINT *, "Compiled by an OpenMP-compliant implementation." + END PROGRAM A3 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 new file mode 100644 index 000000000..c03ba2adf --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 @@ -0,0 +1,14 @@ +! { dg-do run } + MODULE M + INTRINSIC MAX + END MODULE M + PROGRAM A31_4 + USE M, REN => MAX + N=0 +!$OMP PARALLEL DO REDUCTION(REN: N) ! still does MAX + DO I = 1, 100 + N = MAX(N,I) + END DO + END PROGRAM A31_4 + +! { dg-final { cleanup-modules "m" } } diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 new file mode 100644 index 000000000..d81849528 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 @@ -0,0 +1,16 @@ +! { dg-do run } + MODULE MOD + INTRINSIC MAX, MIN + END MODULE MOD + PROGRAM A31_5 + USE MOD, MIN=>MAX, MAX=>MIN + REAL :: R + R = -HUGE(0.0) + !$OMP PARALLEL DO REDUCTION(MIN: R) ! still does MAX + DO I = 1, 1000 + R = MIN(R, SIN(REAL(I))) + END DO + PRINT *, R + END PROGRAM A31_5 + +! { dg-final { cleanup-modules "mod" } } diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 new file mode 100644 index 000000000..adc493fcf --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } + + FUNCTION NEW_LOCK() + USE OMP_LIB ! or INCLUDE "omp_lib.h" + INTEGER(OMP_LOCK_KIND), POINTER :: NEW_LOCK +!$OMP SINGLE + ALLOCATE(NEW_LOCK) + CALL OMP_INIT_LOCK(NEW_LOCK) +!$OMP END SINGLE COPYPRIVATE(NEW_LOCK) + END FUNCTION NEW_LOCK diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 new file mode 100644 index 000000000..55541303c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } + + FUNCTION NEW_LOCKS() + USE OMP_LIB ! or INCLUDE "omp_lib.h" + INTEGER(OMP_LOCK_KIND), DIMENSION(1000) :: NEW_LOCKS + INTEGER I +!$OMP PARALLEL DO PRIVATE(I) + DO I=1,1000 + CALL OMP_INIT_LOCK(NEW_LOCKS(I)) + END DO +!$OMP END PARALLEL DO + END FUNCTION NEW_LOCKS diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 new file mode 100644 index 000000000..540d17f5b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 @@ -0,0 +1,26 @@ +! { dg-do run } + + SUBROUTINE SKIP(ID) + END SUBROUTINE SKIP + SUBROUTINE WORK(ID) + END SUBROUTINE WORK + PROGRAM A39 + INCLUDE "omp_lib.h" ! or USE OMP_LIB + INTEGER(OMP_LOCK_KIND) LCK + INTEGER ID + CALL OMP_INIT_LOCK(LCK) +!$OMP PARALLEL SHARED(LCK) PRIVATE(ID) + ID = OMP_GET_THREAD_NUM() + CALL OMP_SET_LOCK(LCK) + PRINT *, "My thread id is ", ID + CALL OMP_UNSET_LOCK(LCK) + DO WHILE (.NOT. OMP_TEST_LOCK(LCK)) + CALL SKIP(ID) ! We do not yet have the lock + ! so we must do something else + END DO + CALL WORK(ID) ! We now have the lock + ! and can do the work + CALL OMP_UNSET_LOCK( LCK ) +!$OMP END PARALLEL + CALL OMP_DESTROY_LOCK( LCK ) + END PROGRAM A39 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 new file mode 100644 index 000000000..3c2a74a4f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + SUBROUTINE SUBDOMAIN(X, ISTART, IPOINTS) + INTEGER ISTART, IPOINTS + REAL X(*) + INTEGER I + DO 100 I=1,IPOINTS + X(ISTART+I) = 123.456 + 100 CONTINUE + END SUBROUTINE SUBDOMAIN + SUBROUTINE SUB(X, NPOINTS) + INCLUDE "omp_lib.h" ! or USE OMP_LIB + REAL X(*) + INTEGER NPOINTS + INTEGER IAM, NT, IPOINTS, ISTART +!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(X,NPOINTS) + IAM = OMP_GET_THREAD_NUM() + NT = OMP_GET_NUM_THREADS() + IPOINTS = NPOINTS/NT + ISTART = IAM * IPOINTS + IF (IAM .EQ. NT-1) THEN + IPOINTS = NPOINTS - ISTART + ENDIF + CALL SUBDOMAIN(X,ISTART,IPOINTS) +!$OMP END PARALLEL + END SUBROUTINE SUB + PROGRAM A4 + REAL ARRAY(10000) + CALL SUB(ARRAY, 10000) + END PROGRAM A4 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 new file mode 100644 index 000000000..c5ecb3c3e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 @@ -0,0 +1,54 @@ +! { dg-do compile } +! { dg-options "-ffixed-form" } + MODULE DATA + USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND + TYPE LOCKED_PAIR + INTEGER A + INTEGER B + INTEGER (OMP_NEST_LOCK_KIND) LCK + END TYPE + END MODULE DATA + SUBROUTINE INCR_A(P, A) + ! called only from INCR_PAIR, no need to lock + USE DATA + TYPE(LOCKED_PAIR) :: P + INTEGER A + P%A = P%A + A + END SUBROUTINE INCR_A + SUBROUTINE INCR_B(P, B) + ! called from both INCR_PAIR and elsewhere, + ! so we need a nestable lock + USE OMP_LIB ! or INCLUDE "omp_lib.h" + USE DATA + TYPE(LOCKED_PAIR) :: P + INTEGER B + CALL OMP_SET_NEST_LOCK(P%LCK) + P%B = P%B + B + CALL OMP_UNSET_NEST_LOCK(P%LCK) + END SUBROUTINE INCR_B + SUBROUTINE INCR_PAIR(P, A, B) + USE OMP_LIB ! or INCLUDE "omp_lib.h" + USE DATA + TYPE(LOCKED_PAIR) :: P + INTEGER A + INTEGER B + CALL OMP_SET_NEST_LOCK(P%LCK) + CALL INCR_A(P, A) + CALL INCR_B(P, B) + CALL OMP_UNSET_NEST_LOCK(P%LCK) + END SUBROUTINE INCR_PAIR + SUBROUTINE A40(P) + USE OMP_LIB ! or INCLUDE "omp_lib.h" + USE DATA + TYPE(LOCKED_PAIR) :: P + INTEGER WORK1, WORK2, WORK3 + EXTERNAL WORK1, WORK2, WORK3 +!$OMP PARALLEL SECTIONS +!$OMP SECTION + CALL INCR_PAIR(P, WORK1(), WORK2()) +!$OMP SECTION + CALL INCR_B(P, WORK3()) +!$OMP END PARALLEL SECTIONS + END SUBROUTINE A40 + +! { dg-final { cleanup-modules "data" } } diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 new file mode 100644 index 000000000..13e451e50 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 @@ -0,0 +1,8 @@ +! { dg-do run } + PROGRAM A5 + INCLUDE "omp_lib.h" ! or USE OMP_LIB + CALL OMP_SET_DYNAMIC(.TRUE.) +!$OMP PARALLEL NUM_THREADS(10) + ! do work here +!$OMP END PARALLEL + END PROGRAM A5 diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 new file mode 100644 index 000000000..c1564bf4b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 @@ -0,0 +1,20 @@ +! { dg-do run } + SUBROUTINE WORK1() + END SUBROUTINE WORK1 + SUBROUTINE WORK2() + END SUBROUTINE WORK2 + PROGRAM A10 +!$OMP PARALLEL +!$OMP SINGLE + print *, "Beginning work1." +!$OMP END SINGLE + CALL WORK1() +!$OMP SINGLE + print *, "Finishing work1." +!$OMP END SINGLE +!$OMP SINGLE + print *, "Finished work1 and beginning work2." +!$OMP END SINGLE NOWAIT + CALL WORK2() +!$OMP END PARALLEL + END PROGRAM A10 diff --git a/libgomp/testsuite/libgomp.fortran/character1.f90 b/libgomp/testsuite/libgomp.fortran/character1.f90 new file mode 100644 index 000000000..f75ae27e8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/character1.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +!$ use omp_lib + + character (len = 8) :: h, i + character (len = 4) :: j, k + h = '01234567' + i = 'ABCDEFGH' + j = 'IJKL' + k = 'MN' + call test (h, j) +contains + subroutine test (p, q) + character (len = 8) :: p + character (len = 4) :: q, r + character (len = 16) :: f + character (len = 32) :: g + integer, dimension (18) :: s + logical :: l + integer :: m + f = 'test16' + g = 'abcdefghijklmnopqrstuvwxyz' + r = '' + l = .false. + s = -6 +!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) & +!$omp & num_threads (4) + m = omp_get_thread_num () + if (any (s .ne. -6)) l = .true. + l = l .or. f .ne. 'test16' .or. p .ne. '01234567' + l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz' + l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL' + l = l .or. k .ne. 'MN' +!$omp barrier + if (m .eq. 0) then + f = 'ffffffff0' + g = 'xyz' + i = '123' + k = '9876' + p = '_abc' + q = '_def' + r = '1_23' + else if (m .eq. 1) then + f = '__' + p = 'xxx' + r = '7575' + else if (m .eq. 2) then + f = 'ZZ' + p = 'm2' + r = 'M2' + else if (m .eq. 3) then + f = 'YY' + p = 'm3' + r = 'M3' + end if + s = m +!$omp barrier + l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876' + l = l .or. q .ne. '_def' + if (any (s .ne. m)) l = .true. + if (m .eq. 0) then + l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23' + else if (m .eq. 1) then + l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575' + else if (m .eq. 2) then + l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2' + else if (m .eq. 3) then + l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3' + end if +!$omp end parallel + if (l) call abort + end subroutine test +end diff --git a/libgomp/testsuite/libgomp.fortran/character2.f90 b/libgomp/testsuite/libgomp.fortran/character2.f90 new file mode 100644 index 000000000..d59032b57 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/character2.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +!$ use omp_lib + + character (len = 8) :: h + character (len = 9) :: i + h = '01234567' + i = 'ABCDEFGHI' + call test (h, i, 9) +contains + subroutine test (p, q, n) + character (len = *) :: p + character (len = n) :: q + character (len = n) :: r + character (len = n) :: t + character (len = n) :: u + integer, dimension (n + 4) :: s + logical :: l + integer :: m + r = '' + if (n .gt. 8) r = 'jklmnopqr' + do m = 1, n + 4 + s(m) = m + end do + u = 'abc' + l = .false. +!$omp parallel firstprivate (p, q, r) private (t, m) reduction (.or.:l) & +!$omp & num_threads (2) + do m = 1, 13 + if (s(m) .ne. m) l = .true. + end do + m = omp_get_thread_num () + l = l .or. p .ne. '01234567' .or. q .ne. 'ABCDEFGHI' + l = l .or. r .ne. 'jklmnopqr' .or. u .ne. 'abc' +!$omp barrier + if (m .eq. 0) then + p = 'A' + q = 'B' + r = 'C' + t = '123' + u = '987654321' + else if (m .eq. 1) then + p = 'D' + q = 'E' + r = 'F' + t = '456' + s = m + end if +!$omp barrier + l = l .or. u .ne. '987654321' + if (any (s .ne. 1)) l = .true. + if (m .eq. 0) then + l = l .or. p .ne. 'A' .or. q .ne. 'B' .or. r .ne. 'C' + l = l .or. t .ne. '123' + else + l = l .or. p .ne. 'D' .or. q .ne. 'E' .or. r .ne. 'F' + l = l .or. t .ne. '456' + end if +!$omp end parallel + if (l) call abort + end subroutine test +end diff --git a/libgomp/testsuite/libgomp.fortran/collapse1.f90 b/libgomp/testsuite/libgomp.fortran/collapse1.f90 new file mode 100644 index 000000000..1ecfa0c93 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/collapse1.f90 @@ -0,0 +1,26 @@ +! { dg-do run } + +program collapse1 + integer :: i, j, k, a(1:3, 4:6, 5:7) + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse(4 - 1) schedule(static, 4) + do i = 1, 3 + do j = 4, 6 + do k = 5, 7 + a(i, j, k) = i + j + k + end do + end do + end do + !$omp parallel do collapse(2) reduction(.or.:l) + do i = 1, 3 + do j = 4, 6 + do k = 5, 7 + if (a(i, j, k) .ne. (i + j + k)) l = .true. + end do + end do + end do + !$omp end parallel do + if (l) call abort +end program collapse1 diff --git a/libgomp/testsuite/libgomp.fortran/collapse2.f90 b/libgomp/testsuite/libgomp.fortran/collapse2.f90 new file mode 100644 index 000000000..77e0dee82 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/collapse2.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +program collapse2 + call test1 + call test2 +contains + subroutine test1 + integer :: i, j, k, a(1:3, 4:6, 5:7) + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse(4 - 1) schedule(static, 4) + do 164 i = 1, 3 + do 164 j = 4, 6 + do 164 k = 5, 7 + a(i, j, k) = i + j + k +164 end do + !$omp parallel do collapse(2) reduction(.or.:l) +firstdo: do i = 1, 3 + do j = 4, 6 + do k = 5, 7 + if (a(i, j, k) .ne. (i + j + k)) l = .true. + end do + end do + end do firstdo + !$omp end parallel do + if (l) call abort + end subroutine test1 + + subroutine test2 + integer :: a(3,3,3), k, kk, kkk, l, ll, lll + !$omp do collapse(3) + do 115 k=1,3 + dokk: do kk=1,3 + do kkk=1,3 + a(k,kk,kkk) = 1 + enddo + enddo dokk +115 continue + if (any(a(1:3,1:3,1:3).ne.1)) call abort + + !$omp do collapse(3) + dol: do 120 l=1,3 + doll: do ll=1,3 + do lll=1,3 + a(l,ll,lll) = 2 + enddo + enddo doll +120 end do dol + if (any(a(1:3,1:3,1:3).ne.2)) call abort + end subroutine test2 + +end program collapse2 diff --git a/libgomp/testsuite/libgomp.fortran/collapse3.f90 b/libgomp/testsuite/libgomp.fortran/collapse3.f90 new file mode 100644 index 000000000..eac9eac65 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/collapse3.f90 @@ -0,0 +1,204 @@ +! { dg-do run } + +program collapse3 + call test1 + call test2 (2, 6, -2, 4, 13, 18) + call test3 (2, 6, -2, 4, 13, 18, 1, 1, 1) + call test4 + call test5 (2, 6, -2, 4, 13, 18) + call test6 (2, 6, -2, 4, 13, 18, 1, 1, 1) +contains + subroutine test1 + integer :: i, j, k, a(1:7, -3:5, 12:19), m + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) + do i = 2, 6 + do j = -2, 4 + do k = 13, 18 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test1 + + subroutine test2(v1, v2, v3, v4, v5, v6) + integer :: i, j, k, a(1:7, -3:5, 12:19), m + integer :: v1, v2, v3, v4, v5, v6 + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) + do i = v1, v2 + do j = v3, v4 + do k = v5, v6 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test2 + + subroutine test3(v1, v2, v3, v4, v5, v6, v7, v8, v9) + integer :: i, j, k, a(1:7, -3:5, 12:19), m + integer :: v1, v2, v3, v4, v5, v6, v7, v8, v9 + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) + do i = v1, v2, v7 + do j = v3, v4, v8 + do k = v5, v6, v9 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test3 + + subroutine test4 + integer :: i, j, k, a(1:7, -3:5, 12:19), m + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) & + !$omp& schedule (dynamic, 5) + do i = 2, 6 + do j = -2, 4 + do k = 13, 18 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test4 + + subroutine test5(v1, v2, v3, v4, v5, v6) + integer :: i, j, k, a(1:7, -3:5, 12:19), m + integer :: v1, v2, v3, v4, v5, v6 + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) & + !$omp & schedule (guided) + do i = v1, v2 + do j = v3, v4 + do k = v5, v6 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test5 + + subroutine test6(v1, v2, v3, v4, v5, v6, v7, v8, v9) + integer :: i, j, k, a(1:7, -3:5, 12:19), m + integer :: v1, v2, v3, v4, v5, v6, v7, v8, v9 + logical :: l + l = .false. + a(:, :, :) = 0 + !$omp parallel do collapse (3) lastprivate (i, j, k, m) reduction (.or.:l) & + !$omp & schedule (dynamic) + do i = v1, v2, v7 + do j = v3, v4, v8 + do k = v5, v6, v9 + l = l.or.i.lt.2.or.i.gt.6.or.j.lt.-2.or.j.gt.4 + l = l.or.k.lt.13.or.k.gt.18 + if (.not.l) a(i, j, k) = a(i, j, k) + 1 + m = i * 100 + j * 10 + k + end do + end do + end do + if (i.ne.7.or.j.ne.5.or.k.ne.19) call abort + if (m.ne.(600+40+18)) call abort + do i = 1, 7 + do j = -3, 5 + do k = 12, 19 + if (i.eq.1.or.i.eq.7.or.j.eq.-3.or.j.eq.5.or.k.eq.12.or.k.eq.19) then + if (a(i, j, k).ne.0) print *, i, j, k + else + if (a(i, j, k).ne.1) print *, 'kk', i, j, k, a(i, j, k) + end if + end do + end do + end do + end subroutine test6 + +end program collapse3 diff --git a/libgomp/testsuite/libgomp.fortran/collapse4.f90 b/libgomp/testsuite/libgomp.fortran/collapse4.f90 new file mode 100644 index 000000000..f19b0f6c6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/collapse4.f90 @@ -0,0 +1,12 @@ +! { dg-do run } + + integer :: i, j, k + !$omp parallel do lastprivate (i, j, k) collapse (3) + do i = 0, 17 + do j = 0, 6 + do k = 0, 5 + end do + end do + end do + if (i .ne. 18 .or. j .ne. 7 .or. k .ne. 6) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/condinc1.f b/libgomp/testsuite/libgomp.fortran/condinc1.f new file mode 100644 index 000000000..d94fe8d0f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/condinc1.f @@ -0,0 +1,7 @@ +! { dg-options "-fopenmp" } + program condinc1 + logical l + l = .false. +!$ include 'condinc1.inc' + stop 2 + end diff --git a/libgomp/testsuite/libgomp.fortran/condinc1.inc b/libgomp/testsuite/libgomp.fortran/condinc1.inc new file mode 100644 index 000000000..4624db7c4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/condinc1.inc @@ -0,0 +1,2 @@ + if (l) stop 3 + return diff --git a/libgomp/testsuite/libgomp.fortran/condinc2.f b/libgomp/testsuite/libgomp.fortran/condinc2.f new file mode 100644 index 000000000..8123be455 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/condinc2.f @@ -0,0 +1,7 @@ +! { dg-options "-fno-openmp" } + program condinc2 + logical l + l = .true. +C$ include 'condinc1.inc' + return + end diff --git a/libgomp/testsuite/libgomp.fortran/condinc3.f90 b/libgomp/testsuite/libgomp.fortran/condinc3.f90 new file mode 100644 index 000000000..16b937a0a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/condinc3.f90 @@ -0,0 +1,7 @@ + ! { dg-options "-fopenmp" } +program condinc3 + logical l + l = .false. + !$ include 'condinc1.inc' + stop 2 +end diff --git a/libgomp/testsuite/libgomp.fortran/condinc4.f90 b/libgomp/testsuite/libgomp.fortran/condinc4.f90 new file mode 100644 index 000000000..33250256b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/condinc4.f90 @@ -0,0 +1,7 @@ +! { dg-options "-fno-openmp" } + program condinc4 + logical l + l = .true. +!$ include 'condinc1.inc' + return + end diff --git a/libgomp/testsuite/libgomp.fortran/crayptr1.f90 b/libgomp/testsuite/libgomp.fortran/crayptr1.f90 new file mode 100644 index 000000000..57c59f71f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/crayptr1.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! { dg-options "-fopenmp -fcray-pointer" } + + use omp_lib + integer :: a, b, c, p + logical :: l + pointer (ip, p) + a = 1 + b = 2 + c = 3 + l = .false. + ip = loc (a) + +!$omp parallel num_threads (2) reduction (.or.:l) + l = p .ne. 1 +!$omp barrier +!$omp master + ip = loc (b) +!$omp end master +!$omp barrier + l = l .or. p .ne. 2 +!$omp barrier + if (omp_get_thread_num () .eq. 1 .or. omp_get_num_threads () .lt. 2) & + ip = loc (c) +!$omp barrier + l = l .or. p .ne. 3 +!$omp end parallel + + if (l) call abort + + l = .false. +!$omp parallel num_threads (2) reduction (.or.:l) default (private) + ip = loc (a) + a = 3 * omp_get_thread_num () + 4 + b = a + 1 + c = a + 2 + l = p .ne. 3 * omp_get_thread_num () + 4 + ip = loc (c) + l = l .or. p .ne. 3 * omp_get_thread_num () + 6 + ip = loc (b) + l = l .or. p .ne. 3 * omp_get_thread_num () + 5 +!$omp end parallel + + if (l) call abort + +end diff --git a/libgomp/testsuite/libgomp.fortran/crayptr2.f90 b/libgomp/testsuite/libgomp.fortran/crayptr2.f90 new file mode 100644 index 000000000..4ad7cf228 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/crayptr2.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fopenmp -fcray-pointer" } +! { dg-require-effective-target tls_runtime } + + use omp_lib + integer :: a, b, c, d, p + logical :: l + pointer (ip, p) + save ip +!$omp threadprivate (ip) + a = 1 + b = 2 + c = 3 + l = .false. +!$omp parallel num_threads (3) reduction (.or.:l) + if (omp_get_thread_num () .eq. 0) then + ip = loc (a) + elseif (omp_get_thread_num () .eq. 1) then + ip = loc (b) + else + ip = loc (c) + end if + l = p .ne. omp_get_thread_num () + 1 +!$omp single + d = omp_get_thread_num () +!$omp end single copyprivate (d, ip) + l = l .or. (p .ne. d + 1) +!$omp end parallel + + if (l) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/do1.f90 b/libgomp/testsuite/libgomp.fortran/do1.f90 new file mode 100644 index 000000000..2a48c7345 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/do1.f90 @@ -0,0 +1,179 @@ +! { dg-do run } + + integer, dimension (128) :: a, b + integer :: i + a = -1 + b = -1 + do i = 1, 128 + if (i .ge. 8 .and. i .le. 15) then + b(i) = 1 * 256 + i + else if (i .ge. 19 .and. i .le. 23) then + b(i) = 2 * 256 + i + else if (i .ge. 28 .and. i .le. 38) then + if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i + else if (i .ge. 59 .and. i .le. 79) then + if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i + else if (i .ge. 101 .and. i .le. 125) then + if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i + end if + end do + +!$omp parallel num_threads (4) + +!$omp do + do i = 8, 15 + a(i) = 1 * 256 + i + end do + +!$omp do + do i = 23, 19, -1 + a(i) = 2 * 256 + i + end do + +!$omp do + do i = 28, 39, 2 + a(i) = 3 * 256 + i + end do + +!$omp do + do i = 79, 59, -4 + a(i) = 4 * 256 + i + end do + +!$omp do + do i = 125, 90, -12 + a(i) = 5 * 256 + i + end do + +!$omp end parallel + + if (any (a .ne. b)) call abort + a = -1 + +!$omp parallel num_threads (4) + +!$omp do schedule (static) + do i = 8, 15 + a(i) = 1 * 256 + i + end do + +!$omp do schedule (static, 1) + do i = 23, 19, -1 + a(i) = 2 * 256 + i + end do + +!$omp do schedule (static, 3) + do i = 28, 39, 2 + a(i) = 3 * 256 + i + end do + +!$omp do schedule (static, 6) + do i = 79, 59, -4 + a(i) = 4 * 256 + i + end do + +!$omp do schedule (static, 2) + do i = 125, 90, -12 + a(i) = 5 * 256 + i + end do + +!$omp end parallel + + if (any (a .ne. b)) call abort + a = -1 + +!$omp parallel num_threads (4) + +!$omp do schedule (dynamic) + do i = 8, 15 + a(i) = 1 * 256 + i + end do + +!$omp do schedule (dynamic, 4) + do i = 23, 19, -1 + a(i) = 2 * 256 + i + end do + +!$omp do schedule (dynamic, 1) + do i = 28, 39, 2 + a(i) = 3 * 256 + i + end do + +!$omp do schedule (dynamic, 2) + do i = 79, 59, -4 + a(i) = 4 * 256 + i + end do + +!$omp do schedule (dynamic, 3) + do i = 125, 90, -12 + a(i) = 5 * 256 + i + end do + +!$omp end parallel + + if (any (a .ne. b)) call abort + a = -1 + +!$omp parallel num_threads (4) + +!$omp do schedule (guided) + do i = 8, 15 + a(i) = 1 * 256 + i + end do + +!$omp do schedule (guided, 4) + do i = 23, 19, -1 + a(i) = 2 * 256 + i + end do + +!$omp do schedule (guided, 1) + do i = 28, 39, 2 + a(i) = 3 * 256 + i + end do + +!$omp do schedule (guided, 2) + do i = 79, 59, -4 + a(i) = 4 * 256 + i + end do + +!$omp do schedule (guided, 3) + do i = 125, 90, -12 + a(i) = 5 * 256 + i + end do + +!$omp end parallel + + if (any (a .ne. b)) call abort + a = -1 + +!$omp parallel num_threads (4) + +!$omp do schedule (runtime) + do i = 8, 15 + a(i) = 1 * 256 + i + end do + +!$omp do schedule (runtime) + do i = 23, 19, -1 + a(i) = 2 * 256 + i + end do + +!$omp do schedule (runtime) + do i = 28, 39, 2 + a(i) = 3 * 256 + i + end do + +!$omp do schedule (runtime) + do i = 79, 59, -4 + a(i) = 4 * 256 + i + end do + +!$omp do schedule (runtime) + do i = 125, 90, -12 + a(i) = 5 * 256 + i + end do + +!$omp end parallel + + if (any (a .ne. b)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/do2.f90 b/libgomp/testsuite/libgomp.fortran/do2.f90 new file mode 100644 index 000000000..b90ccddd8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/do2.f90 @@ -0,0 +1,366 @@ +! { dg-do run } + + integer, dimension (128) :: a, b + integer :: i, j + logical :: k + a = -1 + b = -1 + do i = 1, 128 + if (i .ge. 8 .and. i .le. 15) then + b(i) = 1 * 256 + i + else if (i .ge. 19 .and. i .le. 23) then + b(i) = 2 * 256 + i + else if (i .ge. 28 .and. i .le. 38) then + if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i + else if (i .ge. 59 .and. i .le. 79) then + if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i + else if (i .ge. 101 .and. i .le. 125) then + if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i + end if + end do + + k = .false. + j = 8 +!$omp parallel num_threads (4) + +!$omp do ordered + do i = 8, 15 + a(i) = 1 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 1 +!$omp end ordered + end do + +!$omp single + j = 23 +!$omp end single + +!$omp do ordered + do i = 23, 19, -1 + a(i) = 2 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 1 +!$omp end ordered + end do + +!$omp single + j = 28 +!$omp end single + +!$omp do ordered + do i = 28, 39, 2 + a(i) = 3 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 2 +!$omp end ordered + end do + +!$omp single + j = 79 +!$omp end single + +!$omp do ordered + do i = 79, 59, -4 + a(i) = 4 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 4 +!$omp end ordered + end do + +!$omp single + j = 125 +!$omp end single + +!$omp do ordered + do i = 125, 90, -12 + a(i) = 5 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 12 +!$omp end ordered + end do + +!$omp end parallel + + if (any (a .ne. b) .or. k) call abort + a = -1 + k = .false. + j = 8 +!$omp parallel num_threads (4) + +!$omp do ordered schedule (static) + do i = 8, 15 + a(i) = 1 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 1 +!$omp end ordered + end do + +!$omp single + j = 23 +!$omp end single + +!$omp do ordered schedule (static, 1) + do i = 23, 19, -1 + a(i) = 2 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 1 +!$omp end ordered + end do + +!$omp single + j = 28 +!$omp end single + +!$omp do ordered schedule (static, 3) + do i = 28, 39, 2 + a(i) = 3 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 2 +!$omp end ordered + end do + +!$omp single + j = 79 +!$omp end single + +!$omp do ordered schedule (static, 6) + do i = 79, 59, -4 + a(i) = 4 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 4 +!$omp end ordered + end do + +!$omp single + j = 125 +!$omp end single + +!$omp do ordered schedule (static, 2) + do i = 125, 90, -12 + a(i) = 5 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 12 +!$omp end ordered + end do + +!$omp end parallel + + if (any (a .ne. b) .or. k) call abort + a = -1 + k = .false. + j = 8 +!$omp parallel num_threads (4) + +!$omp do ordered schedule (dynamic) + do i = 8, 15 + a(i) = 1 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 1 +!$omp end ordered + end do + +!$omp single + j = 23 +!$omp end single + +!$omp do ordered schedule (dynamic, 4) + do i = 23, 19, -1 + a(i) = 2 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 1 +!$omp end ordered + end do + +!$omp single + j = 28 +!$omp end single + +!$omp do ordered schedule (dynamic, 1) + do i = 28, 39, 2 + a(i) = 3 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 2 +!$omp end ordered + end do + +!$omp single + j = 79 +!$omp end single + +!$omp do ordered schedule (dynamic, 2) + do i = 79, 59, -4 + a(i) = 4 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 4 +!$omp end ordered + end do + +!$omp single + j = 125 +!$omp end single + +!$omp do ordered schedule (dynamic, 3) + do i = 125, 90, -12 + a(i) = 5 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 12 +!$omp end ordered + end do + +!$omp end parallel + + if (any (a .ne. b) .or. k) call abort + a = -1 + k = .false. + j = 8 +!$omp parallel num_threads (4) + +!$omp do ordered schedule (guided) + do i = 8, 15 + a(i) = 1 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 1 +!$omp end ordered + end do + +!$omp single + j = 23 +!$omp end single + +!$omp do ordered schedule (guided, 4) + do i = 23, 19, -1 + a(i) = 2 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 1 +!$omp end ordered + end do + +!$omp single + j = 28 +!$omp end single + +!$omp do ordered schedule (guided, 1) + do i = 28, 39, 2 + a(i) = 3 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 2 +!$omp end ordered + end do + +!$omp single + j = 79 +!$omp end single + +!$omp do ordered schedule (guided, 2) + do i = 79, 59, -4 + a(i) = 4 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 4 +!$omp end ordered + end do + +!$omp single + j = 125 +!$omp end single + +!$omp do ordered schedule (guided, 3) + do i = 125, 90, -12 + a(i) = 5 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 12 +!$omp end ordered + end do + +!$omp end parallel + + if (any (a .ne. b) .or. k) call abort + a = -1 + k = .false. + j = 8 +!$omp parallel num_threads (4) + +!$omp do ordered schedule (runtime) + do i = 8, 15 + a(i) = 1 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 1 +!$omp end ordered + end do + +!$omp single + j = 23 +!$omp end single + +!$omp do ordered schedule (runtime) + do i = 23, 19, -1 + a(i) = 2 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 1 +!$omp end ordered + end do + +!$omp single + j = 28 +!$omp end single + +!$omp do ordered schedule (runtime) + do i = 28, 39, 2 + a(i) = 3 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j + 2 +!$omp end ordered + end do + +!$omp single + j = 79 +!$omp end single + +!$omp do ordered schedule (runtime) + do i = 79, 59, -4 + a(i) = 4 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 4 +!$omp end ordered + end do + +!$omp single + j = 125 +!$omp end single + +!$omp do ordered schedule (runtime) + do i = 125, 90, -12 + a(i) = 5 * 256 + i +!$omp ordered + if (i .ne. j) k = .true. + j = j - 12 +!$omp end ordered + end do + +!$omp end parallel + + if (any (a .ne. b) .or. k) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/fortran.exp b/libgomp/testsuite/libgomp.fortran/fortran.exp new file mode 100644 index 000000000..5fa42f4bb --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/fortran.exp @@ -0,0 +1,61 @@ +load_lib libgomp-dg.exp + +global shlib_ext +global ALWAYS_CFLAGS + +set shlib_ext [get_shlib_extension] +set lang_library_path "../libgfortran/.libs" +set lang_link_flags "-lgfortran" +set lang_test_file_found 0 +set quadmath_library_path "../libquadmath/.libs" + + +# Initialize dg. +dg-init + +if { $blddir != "" } { + # Look for a static libgfortran first. + if [file exists "${blddir}/${lang_library_path}/libgfortran.a"] { + set lang_test_file "${lang_library_path}/libgfortran.a" + set lang_test_file_found 1 + # We may have a shared only build, so look for a shared libgfortran. + } elseif [file exists "${blddir}/${lang_library_path}/libgfortran.${shlib_ext}"] { + set lang_test_file "${lang_library_path}/libgfortran.${shlib_ext}" + set lang_test_file_found 1 + } else { + puts "No libgfortran library found, will not execute fortran tests" + } +} elseif [info exists GFORTRAN_UNDER_TEST] { + set lang_test_file_found 1 + # Needs to exist for libgomp.exp. + set lang_test_file "" +} else { + puts "GFORTRAN_UNDER_TEST not defined, will not execute fortran tests" +} + +if { $lang_test_file_found } { + # Gather a list of all tests. + set tests [lsort [find $srcdir/$subdir *.\[fF\]{,90,95,03,08}]] + + if { $blddir != "" } { + if { [file exists "${blddir}/${quadmath_library_path}/libquadmath.a"] + || [file exists "${blddir}/${quadmath_library_path}/libquadmath.${shlib_ext}"] } { + lappend ALWAYS_CFLAGS "ldflags=-L${blddir}/${quadmath_library_path}/" + # Allow for spec subsitution. + lappend ALWAYS_CFLAGS "additional_flags=-B${blddir}/${quadmath_library_path}/" + set ld_library_path "$always_ld_library_path:${blddir}/${lang_library_path}:${blddir}/${quadmath_library_path}" + } else { + set ld_library_path "$always_ld_library_path:${blddir}/${lang_library_path}" + } + } else { + set ld_library_path "$always_ld_library_path" + } + append ld_library_path [gcc-set-multilib-library-path $GCC_UNDER_TEST] + set_ld_library_path_env_vars + + # Main loop. + gfortran-dg-runtest $tests "" +} + +# All done. +dg-finish diff --git a/libgomp/testsuite/libgomp.fortran/jacobi.f b/libgomp/testsuite/libgomp.fortran/jacobi.f new file mode 100644 index 000000000..b27e20f27 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/jacobi.f @@ -0,0 +1,261 @@ +* { dg-do run } + + program main +************************************************************ +* program to solve a finite difference +* discretization of Helmholtz equation : +* (d2/dx2)u + (d2/dy2)u - alpha u = f +* using Jacobi iterative method. +* +* Modified: Sanjiv Shah, Kuck and Associates, Inc. (KAI), 1998 +* Author: Joseph Robicheaux, Kuck and Associates, Inc. (KAI), 1998 +* +* Directives are used in this code to achieve paralleism. +* All do loops are parallized with default 'static' scheduling. +* +* Input : n - grid dimension in x direction +* m - grid dimension in y direction +* alpha - Helmholtz constant (always greater than 0.0) +* tol - error tolerance for iterative solver +* relax - Successice over relaxation parameter +* mits - Maximum iterations for iterative solver +* +* On output +* : u(n,m) - Dependent variable (solutions) +* : f(n,m) - Right hand side function +************************************************************* + implicit none + + integer n,m,mits,mtemp + include "omp_lib.h" + double precision tol,relax,alpha + + common /idat/ n,m,mits,mtemp + common /fdat/tol,alpha,relax +* +* Read info +* + write(*,*) "Input n,m - grid dimension in x,y direction " + n = 64 + m = 64 +* read(5,*) n,m + write(*,*) n, m + write(*,*) "Input alpha - Helmholts constant " + alpha = 0.5 +* read(5,*) alpha + write(*,*) alpha + write(*,*) "Input relax - Successive over-relaxation parameter" + relax = 0.9 +* read(5,*) relax + write(*,*) relax + write(*,*) "Input tol - error tolerance for iterative solver" + tol = 1.0E-12 +* read(5,*) tol + write(*,*) tol + write(*,*) "Input mits - Maximum iterations for solver" + mits = 100 +* read(5,*) mits + write(*,*) mits + + call omp_set_num_threads (2) + +* +* Calls a driver routine +* + call driver () + + stop + end + + subroutine driver ( ) +************************************************************* +* Subroutine driver () +* This is where the arrays are allocated and initialzed. +* +* Working varaibles/arrays +* dx - grid spacing in x direction +* dy - grid spacing in y direction +************************************************************* + implicit none + + integer n,m,mits,mtemp + double precision tol,relax,alpha + + common /idat/ n,m,mits,mtemp + common /fdat/tol,alpha,relax + + double precision u(n,m),f(n,m),dx,dy + +* Initialize data + + call initialize (n,m,alpha,dx,dy,u,f) + +* Solve Helmholtz equation + + call jacobi (n,m,dx,dy,alpha,relax,u,f,tol,mits) + +* Check error between exact solution + + call error_check (n,m,alpha,dx,dy,u,f) + + return + end + + subroutine initialize (n,m,alpha,dx,dy,u,f) +****************************************************** +* Initializes data +* Assumes exact solution is u(x,y) = (1-x^2)*(1-y^2) +* +****************************************************** + implicit none + + integer n,m + double precision u(n,m),f(n,m),dx,dy,alpha + + integer i,j, xx,yy + double precision PI + parameter (PI=3.1415926) + + dx = 2.0 / (n-1) + dy = 2.0 / (m-1) + +* Initilize initial condition and RHS + +!$omp parallel do private(xx,yy) + do j = 1,m + do i = 1,n + xx = -1.0 + dx * dble(i-1) ! -1 < x < 1 + yy = -1.0 + dy * dble(j-1) ! -1 < y < 1 + u(i,j) = 0.0 + f(i,j) = -alpha *(1.0-xx*xx)*(1.0-yy*yy) + & - 2.0*(1.0-xx*xx)-2.0*(1.0-yy*yy) + enddo + enddo +!$omp end parallel do + + return + end + + subroutine jacobi (n,m,dx,dy,alpha,omega,u,f,tol,maxit) +****************************************************************** +* Subroutine HelmholtzJ +* Solves poisson equation on rectangular grid assuming : +* (1) Uniform discretization in each direction, and +* (2) Dirichlect boundary conditions +* +* Jacobi method is used in this routine +* +* Input : n,m Number of grid points in the X/Y directions +* dx,dy Grid spacing in the X/Y directions +* alpha Helmholtz eqn. coefficient +* omega Relaxation factor +* f(n,m) Right hand side function +* u(n,m) Dependent variable/Solution +* tol Tolerance for iterative solver +* maxit Maximum number of iterations +* +* Output : u(n,m) - Solution +***************************************************************** + implicit none + integer n,m,maxit + double precision dx,dy,f(n,m),u(n,m),alpha, tol,omega +* +* Local variables +* + integer i,j,k,k_local + double precision error,resid,rsum,ax,ay,b + double precision error_local, uold(n,m) + + real ta,tb,tc,td,te,ta1,ta2,tb1,tb2,tc1,tc2,td1,td2 + real te1,te2 + real second + external second +* +* Initialize coefficients + ax = 1.0/(dx*dx) ! X-direction coef + ay = 1.0/(dy*dy) ! Y-direction coef + b = -2.0/(dx*dx)-2.0/(dy*dy) - alpha ! Central coeff + + error = 10.0 * tol + k = 1 + + do while (k.le.maxit .and. error.gt. tol) + + error = 0.0 + +* Copy new solution into old +!$omp parallel + +!$omp do + do j=1,m + do i=1,n + uold(i,j) = u(i,j) + enddo + enddo + +* Compute stencil, residual, & update + +!$omp do private(resid) reduction(+:error) + do j = 2,m-1 + do i = 2,n-1 +* Evaluate residual + resid = (ax*(uold(i-1,j) + uold(i+1,j)) + & + ay*(uold(i,j-1) + uold(i,j+1)) + & + b * uold(i,j) - f(i,j))/b +* Update solution + u(i,j) = uold(i,j) - omega * resid +* Accumulate residual error + error = error + resid*resid + end do + enddo +!$omp enddo nowait + +!$omp end parallel + +* Error check + + k = k + 1 + + error = sqrt(error)/dble(n*m) +* + enddo ! End iteration loop +* + print *, 'Total Number of Iterations ', k + print *, 'Residual ', error + + return + end + + subroutine error_check (n,m,alpha,dx,dy,u,f) + implicit none +************************************************************ +* Checks error between numerical and exact solution +* +************************************************************ + + integer n,m + double precision u(n,m),f(n,m),dx,dy,alpha + + integer i,j + double precision xx,yy,temp,error + + dx = 2.0 / (n-1) + dy = 2.0 / (m-1) + error = 0.0 + +!$omp parallel do private(xx,yy,temp) reduction(+:error) + do j = 1,m + do i = 1,n + xx = -1.0d0 + dx * dble(i-1) + yy = -1.0d0 + dy * dble(j-1) + temp = u(i,j) - (1.0-xx*xx)*(1.0-yy*yy) + error = error + temp*temp + enddo + enddo + + error = sqrt(error)/dble(n*m) + + print *, 'Solution Error : ',error + + return + end diff --git a/libgomp/testsuite/libgomp.fortran/lastprivate1.f90 b/libgomp/testsuite/libgomp.fortran/lastprivate1.f90 new file mode 100644 index 000000000..91bb96ca7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lastprivate1.f90 @@ -0,0 +1,126 @@ +program lastprivate + integer :: i + common /c/ i + !$omp parallel num_threads (4) + call test1 + !$omp end parallel + if (i .ne. 21) call abort + !$omp parallel num_threads (4) + call test2 + !$omp end parallel + if (i .ne. 64) call abort + !$omp parallel num_threads (4) + call test3 + !$omp end parallel + if (i .ne. 14) call abort + call test4 + call test5 + call test6 + call test7 + call test8 + call test9 + call test10 + call test11 + call test12 +contains + subroutine test1 + integer :: i + common /c/ i + !$omp do lastprivate (i) + do i = 1, 20 + end do + end subroutine test1 + subroutine test2 + integer :: i + common /c/ i + !$omp do lastprivate (i) + do i = 7, 61, 3 + end do + end subroutine test2 + function ret3 () + integer :: ret3 + ret3 = 3 + end function ret3 + subroutine test3 + integer :: i + common /c/ i + !$omp do lastprivate (i) + do i = -10, 11, ret3 () + end do + end subroutine test3 + subroutine test4 + integer :: j + !$omp parallel do lastprivate (j) num_threads (4) default (none) + do j = 1, 20 + end do + if (j .ne. 21) call abort + end subroutine test4 + subroutine test5 + integer :: j + !$omp parallel do lastprivate (j) num_threads (4) default (none) + do j = 7, 61, 3 + end do + if (j .ne. 64) call abort + end subroutine test5 + subroutine test6 + integer :: j + !$omp parallel do lastprivate (j) num_threads (4) default (none) + do j = -10, 11, ret3 () + end do + if (j .ne. 14) call abort + end subroutine test6 + subroutine test7 + integer :: i + common /c/ i + !$omp parallel do lastprivate (i) num_threads (4) default (none) + do i = 1, 20 + end do + if (i .ne. 21) call abort + end subroutine test7 + subroutine test8 + integer :: i + common /c/ i + !$omp parallel do lastprivate (i) num_threads (4) default (none) + do i = 7, 61, 3 + end do + if (i .ne. 64) call abort + end subroutine test8 + subroutine test9 + integer :: i + common /c/ i + !$omp parallel do lastprivate (i) num_threads (4) default (none) + do i = -10, 11, ret3 () + end do + if (i .ne. 14) call abort + end subroutine test9 + subroutine test10 + integer :: i + common /c/ i + !$omp parallel num_threads (4) default (none) shared (i) + !$omp do lastprivate (i) + do i = 1, 20 + end do + !$omp end parallel + if (i .ne. 21) call abort + end subroutine test10 + subroutine test11 + integer :: i + common /c/ i + !$omp parallel num_threads (4) default (none) shared (i) + !$omp do lastprivate (i) + do i = 7, 61, 3 + end do + !$omp end parallel + if (i .ne. 64) call abort + end subroutine test11 + subroutine test12 + integer :: i + common /c/ i + !$omp parallel num_threads (4) default (none) shared (i) + !$omp do lastprivate (i) + do i = -10, 11, ret3 () + end do + !$omp end parallel + if (i .ne. 14) call abort + end subroutine test12 +end program lastprivate diff --git a/libgomp/testsuite/libgomp.fortran/lastprivate2.f90 b/libgomp/testsuite/libgomp.fortran/lastprivate2.f90 new file mode 100644 index 000000000..6d7e11eab --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lastprivate2.f90 @@ -0,0 +1,141 @@ +program lastprivate + integer :: i, k + common /c/ i, k + !$omp parallel num_threads (4) + call test1 + !$omp end parallel + if (i .ne. 21 .or. k .ne. 20) call abort + !$omp parallel num_threads (4) + call test2 + !$omp end parallel + if (i .ne. 64 .or. k .ne. 61) call abort + !$omp parallel num_threads (4) + call test3 + !$omp end parallel + if (i .ne. 14 .or. k .ne. 11) call abort + call test4 + call test5 + call test6 + call test7 + call test8 + call test9 + call test10 + call test11 + call test12 +contains + subroutine test1 + integer :: i, k + common /c/ i, k + !$omp do lastprivate (i, k) + do i = 1, 20 + k = i + end do + end subroutine test1 + subroutine test2 + integer :: i, k + common /c/ i, k + !$omp do lastprivate (i, k) + do i = 7, 61, 3 + k = i + end do + end subroutine test2 + function ret3 () + integer :: ret3 + ret3 = 3 + end function ret3 + subroutine test3 + integer :: i, k + common /c/ i, k + !$omp do lastprivate (i, k) + do i = -10, 11, ret3 () + k = i + end do + end subroutine test3 + subroutine test4 + integer :: j, l + !$omp parallel do lastprivate (j, l) num_threads (4) + do j = 1, 20 + l = j + end do + if (j .ne. 21 .or. l .ne. 20) call abort + end subroutine test4 + subroutine test5 + integer :: j, l + l = 77 + !$omp parallel do lastprivate (j, l) num_threads (4) firstprivate (l) + do j = 7, 61, 3 + l = j + end do + if (j .ne. 64 .or. l .ne. 61) call abort + end subroutine test5 + subroutine test6 + integer :: j, l + !$omp parallel do lastprivate (j, l) num_threads (4) + do j = -10, 11, ret3 () + l = j + end do + if (j .ne. 14 .or. l .ne. 11) call abort + end subroutine test6 + subroutine test7 + integer :: i, k + common /c/ i, k + !$omp parallel do lastprivate (i, k) num_threads (4) + do i = 1, 20 + k = i + end do + if (i .ne. 21 .or. k .ne. 20) call abort + end subroutine test7 + subroutine test8 + integer :: i, k + common /c/ i, k + !$omp parallel do lastprivate (i, k) num_threads (4) + do i = 7, 61, 3 + k = i + end do + if (i .ne. 64 .or. k .ne. 61) call abort + end subroutine test8 + subroutine test9 + integer :: i, k + common /c/ i, k + k = 77 + !$omp parallel do lastprivate (i, k) num_threads (4) firstprivate (k) + do i = -10, 11, ret3 () + k = i + end do + if (i .ne. 14 .or. k .ne. 11) call abort + end subroutine test9 + subroutine test10 + integer :: i, k + common /c/ i, k + !$omp parallel num_threads (4) + !$omp do lastprivate (i, k) + do i = 1, 20 + k = i + end do + !$omp end parallel + if (i .ne. 21 .or. k .ne. 20) call abort + end subroutine test10 + subroutine test11 + integer :: i, k + common /c/ i, k + !$omp parallel num_threads (4) + !$omp do lastprivate (i, k) + do i = 7, 61, 3 + k = i + end do + !$omp end parallel + if (i .ne. 64 .or. k .ne. 61) call abort + end subroutine test11 + subroutine test12 + integer :: i, k + common /c/ i, k + k = 77 + !$omp parallel num_threads (4) + !$omp do lastprivate (i, k) firstprivate (k) + do i = -10, 11, ret3 () + k = i + end do + !$omp end parallel + if (i .ne. 14 .or. k .ne. 11) call abort + end subroutine test12 +end program lastprivate diff --git a/libgomp/testsuite/libgomp.fortran/lib1.f90 b/libgomp/testsuite/libgomp.fortran/lib1.f90 new file mode 100644 index 000000000..884001867 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lib1.f90 @@ -0,0 +1,76 @@ +! { dg-do run } + + use omp_lib + + double precision :: d, e + logical :: l + integer (kind = omp_lock_kind) :: lck + integer (kind = omp_nest_lock_kind) :: nlck + + d = omp_get_wtime () + + call omp_init_lock (lck) + call omp_set_lock (lck) + if (omp_test_lock (lck)) call abort + call omp_unset_lock (lck) + if (.not. omp_test_lock (lck)) call abort + if (omp_test_lock (lck)) call abort + call omp_unset_lock (lck) + call omp_destroy_lock (lck) + + call omp_init_nest_lock (nlck) + if (omp_test_nest_lock (nlck) .ne. 1) call abort + call omp_set_nest_lock (nlck) + if (omp_test_nest_lock (nlck) .ne. 3) call abort + call omp_unset_nest_lock (nlck) + call omp_unset_nest_lock (nlck) + if (omp_test_nest_lock (nlck) .ne. 2) call abort + call omp_unset_nest_lock (nlck) + call omp_unset_nest_lock (nlck) + call omp_destroy_nest_lock (nlck) + + call omp_set_dynamic (.true.) + if (.not. omp_get_dynamic ()) call abort + call omp_set_dynamic (.false.) + if (omp_get_dynamic ()) call abort + + call omp_set_nested (.true.) + if (.not. omp_get_nested ()) call abort + call omp_set_nested (.false.) + if (omp_get_nested ()) call abort + + call omp_set_num_threads (5) + if (omp_get_num_threads () .ne. 1) call abort + if (omp_get_max_threads () .ne. 5) call abort + if (omp_get_thread_num () .ne. 0) call abort + call omp_set_num_threads (3) + if (omp_get_num_threads () .ne. 1) call abort + if (omp_get_max_threads () .ne. 3) call abort + if (omp_get_thread_num () .ne. 0) call abort + l = .false. +!$omp parallel reduction (.or.:l) + l = omp_get_num_threads () .ne. 3 + l = l .or. (omp_get_thread_num () .lt. 0) + l = l .or. (omp_get_thread_num () .ge. 3) +!$omp master + l = l .or. (omp_get_thread_num () .ne. 0) +!$omp end master +!$omp end parallel + if (l) call abort + + if (omp_get_num_procs () .le. 0) call abort + if (omp_in_parallel ()) call abort +!$omp parallel reduction (.or.:l) + l = .not. omp_in_parallel () +!$omp end parallel +!$omp parallel reduction (.or.:l) if (.true.) + l = .not. omp_in_parallel () +!$omp end parallel + + e = omp_get_wtime () + if (d .gt. e) call abort + d = omp_get_wtick () + ! Negative precision is definitely wrong, + ! bigger than 1s clock resolution is also strange + if (d .le. 0 .or. d .gt. 1.) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/lib2.f b/libgomp/testsuite/libgomp.fortran/lib2.f new file mode 100644 index 000000000..755108270 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lib2.f @@ -0,0 +1,76 @@ +C { dg-do run } + + USE OMP_LIB + + DOUBLE PRECISION :: D, E + LOGICAL :: L + INTEGER (KIND = OMP_LOCK_KIND) :: LCK + INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK + + D = OMP_GET_WTIME () + + CALL OMP_INIT_LOCK (LCK) + CALL OMP_SET_LOCK (LCK) + IF (OMP_TEST_LOCK (LCK)) CALL ABORT + CALL OMP_UNSET_LOCK (LCK) + IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT + IF (OMP_TEST_LOCK (LCK)) CALL ABORT + CALL OMP_UNSET_LOCK (LCK) + CALL OMP_DESTROY_LOCK (LCK) + + CALL OMP_INIT_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT + CALL OMP_SET_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_UNSET_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_DESTROY_NEST_LOCK (NLCK) + + CALL OMP_SET_DYNAMIC (.TRUE.) + IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT + CALL OMP_SET_DYNAMIC (.FALSE.) + IF (OMP_GET_DYNAMIC ()) CALL ABORT + + CALL OMP_SET_NESTED (.TRUE.) + IF (.NOT. OMP_GET_NESTED ()) CALL ABORT + CALL OMP_SET_NESTED (.FALSE.) + IF (OMP_GET_NESTED ()) CALL ABORT + + CALL OMP_SET_NUM_THREADS (5) + IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT + IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT + IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT + CALL OMP_SET_NUM_THREADS (3) + IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT + IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT + IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT + L = .FALSE. +C$OMP PARALLEL REDUCTION (.OR.:L) + L = OMP_GET_NUM_THREADS () .NE. 3 + L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0) + L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3) +C$OMP MASTER + L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0) +C$OMP END MASTER +C$OMP END PARALLEL + IF (L) CALL ABORT + + IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT + IF (OMP_IN_PARALLEL ()) CALL ABORT +C$OMP PARALLEL REDUCTION (.OR.:L) + L = .NOT. OMP_IN_PARALLEL () +C$OMP END PARALLEL +C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.) + L = .NOT. OMP_IN_PARALLEL () +C$OMP END PARALLEL + + E = OMP_GET_WTIME () + IF (D .GT. E) CALL ABORT + D = OMP_GET_WTICK () +C Negative precision is definitely wrong, +C bigger than 1s clock resolution is also strange + IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT + END diff --git a/libgomp/testsuite/libgomp.fortran/lib3.f b/libgomp/testsuite/libgomp.fortran/lib3.f new file mode 100644 index 000000000..fa7b227c0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lib3.f @@ -0,0 +1,76 @@ +C { dg-do run } + + INCLUDE "omp_lib.h" + + DOUBLE PRECISION :: D, E + LOGICAL :: L + INTEGER (KIND = OMP_LOCK_KIND) :: LCK + INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK + + D = OMP_GET_WTIME () + + CALL OMP_INIT_LOCK (LCK) + CALL OMP_SET_LOCK (LCK) + IF (OMP_TEST_LOCK (LCK)) CALL ABORT + CALL OMP_UNSET_LOCK (LCK) + IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT + IF (OMP_TEST_LOCK (LCK)) CALL ABORT + CALL OMP_UNSET_LOCK (LCK) + CALL OMP_DESTROY_LOCK (LCK) + + CALL OMP_INIT_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT + CALL OMP_SET_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_UNSET_NEST_LOCK (NLCK) + IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_UNSET_NEST_LOCK (NLCK) + CALL OMP_DESTROY_NEST_LOCK (NLCK) + + CALL OMP_SET_DYNAMIC (.TRUE.) + IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT + CALL OMP_SET_DYNAMIC (.FALSE.) + IF (OMP_GET_DYNAMIC ()) CALL ABORT + + CALL OMP_SET_NESTED (.TRUE.) + IF (.NOT. OMP_GET_NESTED ()) CALL ABORT + CALL OMP_SET_NESTED (.FALSE.) + IF (OMP_GET_NESTED ()) CALL ABORT + + CALL OMP_SET_NUM_THREADS (5) + IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT + IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT + IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT + CALL OMP_SET_NUM_THREADS (3) + IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT + IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT + IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT + L = .FALSE. +C$OMP PARALLEL REDUCTION (.OR.:L) + L = OMP_GET_NUM_THREADS () .NE. 3 + L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0) + L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3) +C$OMP MASTER + L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0) +C$OMP END MASTER +C$OMP END PARALLEL + IF (L) CALL ABORT + + IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT + IF (OMP_IN_PARALLEL ()) CALL ABORT +C$OMP PARALLEL REDUCTION (.OR.:L) + L = .NOT. OMP_IN_PARALLEL () +C$OMP END PARALLEL +C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.) + L = .NOT. OMP_IN_PARALLEL () +C$OMP END PARALLEL + + E = OMP_GET_WTIME () + IF (D .GT. E) CALL ABORT + D = OMP_GET_WTICK () +C Negative precision is definitely wrong, +C bigger than 1s clock resolution is also strange + IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT + END diff --git a/libgomp/testsuite/libgomp.fortran/lib4.f90 b/libgomp/testsuite/libgomp.fortran/lib4.f90 new file mode 100644 index 000000000..cbb984574 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lib4.f90 @@ -0,0 +1,16 @@ +! { dg-do run } + +program lib4 + use omp_lib + integer (omp_sched_kind) :: kind + integer :: modifier + call omp_set_schedule (omp_sched_static, 32) + call omp_get_schedule (kind, modifier) + if (kind.ne.omp_sched_static.or.modifier.ne.32) call abort + call omp_set_schedule (omp_sched_dynamic, 4) + call omp_get_schedule (kind, modifier) + if (kind.ne.omp_sched_dynamic.or.modifier.ne.4) call abort + if (omp_get_thread_limit ().lt.0) call abort + call omp_set_max_active_levels (6) + if (omp_get_max_active_levels ().ne.6) call abort +end program lib4 diff --git a/libgomp/testsuite/libgomp.fortran/lock-1.f90 b/libgomp/testsuite/libgomp.fortran/lock-1.f90 new file mode 100644 index 000000000..d7d3e3fd6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lock-1.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + + use omp_lib + + integer (kind = omp_nest_lock_kind) :: lock + logical :: l + + l = .false. + call omp_init_nest_lock (lock) + if (omp_test_nest_lock (lock) .ne. 1) call abort + if (omp_test_nest_lock (lock) .ne. 2) call abort +!$omp parallel if (.false.) reduction (.or.:l) + ! In OpenMP 2.5 this was supposed to return 3, + ! but in OpenMP 3.0 the parallel region has a different + ! task and omp_*_lock_t are owned by tasks, not by threads. + if (omp_test_nest_lock (lock) .ne. 0) l = .true. +!$omp end parallel + if (l) call abort + if (omp_test_nest_lock (lock) .ne. 3) call abort + call omp_unset_nest_lock (lock) + call omp_unset_nest_lock (lock) + call omp_unset_nest_lock (lock) + call omp_destroy_nest_lock (lock) +end diff --git a/libgomp/testsuite/libgomp.fortran/lock-2.f90 b/libgomp/testsuite/libgomp.fortran/lock-2.f90 new file mode 100644 index 000000000..9965139b9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/lock-2.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + + use omp_lib + + integer (kind = omp_nest_lock_kind) :: lock + logical :: l + + l = .false. + call omp_init_nest_lock (lock) +!$omp parallel num_threads (1) reduction (.or.:l) + if (omp_test_nest_lock (lock) .ne. 1) call abort + if (omp_test_nest_lock (lock) .ne. 2) call abort +!$omp task if (.false.) shared (lock, l) + if (omp_test_nest_lock (lock) .ne. 0) l = .true. +!$omp end task +!$omp taskwait + if (omp_test_nest_lock (lock) .ne. 3) l = .true. + call omp_unset_nest_lock (lock) + call omp_unset_nest_lock (lock) + call omp_unset_nest_lock (lock) +!$omp end parallel + if (l) call abort + call omp_destroy_nest_lock (lock) +end diff --git a/libgomp/testsuite/libgomp.fortran/nested1.f90 b/libgomp/testsuite/libgomp.fortran/nested1.f90 new file mode 100644 index 000000000..98c4322d0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nested1.f90 @@ -0,0 +1,87 @@ +! { dg-do run } +program nested1 + use omp_lib + integer :: e1, e2, e3, e + integer :: tn1, tn2, tn3 + e1 = 0 + e2 = 0 + e3 = 0 + call omp_set_nested (.true.) + call omp_set_dynamic (.false.) + if (omp_in_parallel ()) call abort + if (omp_get_num_threads ().ne.1) call abort + if (omp_get_level ().ne.0) call abort + if (omp_get_ancestor_thread_num (0).ne.0) call abort + if (omp_get_ancestor_thread_num (-1).ne.-1) call abort + if (omp_get_ancestor_thread_num (1).ne.-1) call abort + if (omp_get_team_size (0).ne.1) call abort + if (omp_get_team_size (-1).ne.-1) call abort + if (omp_get_team_size (1).ne.-1) call abort + if (omp_get_active_level ().ne.0) call abort +!$omp parallel num_threads (4) private (e, tn1) + e = 0 + tn1 = omp_get_thread_num () + if (.not.omp_in_parallel ()) e = e + 1 + if (omp_get_num_threads ().ne.4) e = e + 1 + if (tn1.lt.0.or.tn1.ge.4) e = e + 1 + if (omp_get_level ().ne.1) e = e + 1 + if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1 + if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1 + if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1 + if (omp_get_ancestor_thread_num (2).ne.-1) e = e + 1 + if (omp_get_team_size (0).ne.1) e = e + 1 + if (omp_get_team_size (1).ne.4) e = e + 1 + if (omp_get_team_size (-1).ne.-1) e = e + 1 + if (omp_get_team_size (2).ne.-1) e = e + 1 + if (omp_get_active_level ().ne.1) e = e + 1 + !$omp atomic + e1 = e1 + e +!$omp parallel num_threads (5) if (.false.) firstprivate (tn1) & +!$omp& private (e, tn2) + e = 0 + tn2 = omp_get_thread_num () + if (.not.omp_in_parallel ()) e = e + 1 + if (omp_get_num_threads ().ne.1) e = e + 1 + if (tn2.ne.0) e = e + 1 + if (omp_get_level ().ne.2) e = e + 1 + if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1 + if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1 + if (omp_get_ancestor_thread_num (2).ne.tn2) e = e + 1 + if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1 + if (omp_get_ancestor_thread_num (3).ne.-1) e = e + 1 + if (omp_get_team_size (0).ne.1) e = e + 1 + if (omp_get_team_size (1).ne.4) e = e + 1 + if (omp_get_team_size (2).ne.1) e = e + 1 + if (omp_get_team_size (-1).ne.-1) e = e + 1 + if (omp_get_team_size (3).ne.-1) e = e + 1 + if (omp_get_active_level ().ne.1) e = e + 1 + !$omp atomic + e2 = e2 + e +!$omp parallel num_threads (2) firstprivate (tn1, tn2) & +!$omp& private (e, tn3) + e = 0 + tn3 = omp_get_thread_num () + if (.not.omp_in_parallel ()) e = e + 1 + if (omp_get_num_threads ().ne.2) e = e + 1 + if (tn3.lt.0.or.tn3.ge.2) e = e + 1 + if (omp_get_level ().ne.3) e = e + 1 + if (omp_get_ancestor_thread_num (0).ne.0) e = e + 1 + if (omp_get_ancestor_thread_num (1).ne.tn1) e = e + 1 + if (omp_get_ancestor_thread_num (2).ne.tn2) e = e + 1 + if (omp_get_ancestor_thread_num (3).ne.tn3) e = e + 1 + if (omp_get_ancestor_thread_num (-1).ne.-1) e = e + 1 + if (omp_get_ancestor_thread_num (4).ne.-1) e = e + 1 + if (omp_get_team_size (0).ne.1) e = e + 1 + if (omp_get_team_size (1).ne.4) e = e + 1 + if (omp_get_team_size (2).ne.1) e = e + 1 + if (omp_get_team_size (3).ne.2) e = e + 1 + if (omp_get_team_size (-1).ne.-1) e = e + 1 + if (omp_get_team_size (4).ne.-1) e = e + 1 + if (omp_get_active_level ().ne.2) e = e + 1 + !$omp atomic + e3 = e3 + e +!$omp end parallel +!$omp end parallel +!$omp end parallel + if (e1.ne.0.or.e2.ne.0.or.e3.ne.0) call abort +end program nested1 diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn1.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90 new file mode 100644 index 000000000..67dadd6df --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90 @@ -0,0 +1,43 @@ +! { dg-do run } + + integer :: a, b, c + a = 1 + b = 2 + c = 3 + call foo + if (a .ne. 7) call abort +contains + subroutine foo + use omp_lib + logical :: l + l = .false. +!$omp parallel shared (a) private (b) firstprivate (c) & +!$omp num_threads (2) reduction (.or.:l) + if (a .ne. 1 .or. c .ne. 3) l = .true. +!$omp barrier + if (omp_get_thread_num () .eq. 0) then + a = 4 + b = 5 + c = 6 + end if +!$omp barrier + if (omp_get_thread_num () .eq. 1) then + if (a .ne. 4 .or. c .ne. 3) l = .true. + a = 7 + b = 8 + c = 9 + else if (omp_get_num_threads () .eq. 1) then + a = 7 + end if +!$omp barrier + if (omp_get_thread_num () .eq. 0) then + if (a .ne. 7 .or. b .ne. 5 .or. c .ne. 6) l = .true. + end if +!$omp barrier + if (omp_get_thread_num () .eq. 1) then + if (a .ne. 7 .or. b .ne. 8 .or. c .ne. 9) l = .true. + end if +!$omp end parallel + if (l) call abort + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn2.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90 new file mode 100644 index 000000000..dfb12ae66 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90 @@ -0,0 +1,34 @@ +! { dg-do run } + + integer :: i + common /c/ i + i = -1 +!$omp parallel shared (i) num_threads (4) + call test1 +!$omp end parallel +end +subroutine test1 + integer :: vari + call test2 + call test3 +contains + subroutine test2 + use omp_lib + integer :: i + common /c/ i +!$omp single + i = omp_get_thread_num () + call test4 +!$omp end single copyprivate (vari) + end subroutine test2 + subroutine test3 + integer :: i + common /c/ i + if (i .lt. 0 .or. i .ge. 4) call abort + if (i + 10 .ne. vari) call abort + end subroutine test3 + subroutine test4 + use omp_lib + vari = omp_get_thread_num () + 10 + end subroutine test4 +end subroutine test1 diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn3.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn3.f90 new file mode 100644 index 000000000..454749c54 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn3.f90 @@ -0,0 +1,24 @@ +! PR middle-end/28790 +! { dg-do run } + +program nestomp + integer :: j + j = 8 + call bar + if (j.ne.10) call abort +contains + subroutine foo (i) + integer :: i + !$omp atomic + j = j + i - 5 + end subroutine + subroutine bar + use omp_lib + integer :: i + i = 6 + call omp_set_dynamic (.false.) + !$omp parallel num_threads (2) + call foo(i) + !$omp end parallel + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn4.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn4.f90 new file mode 100644 index 000000000..c987bf440 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/nestedfn4.f90 @@ -0,0 +1,41 @@ +program foo + integer :: i, j, k + integer :: a(10), c(10) + k = 2 + a(:) = 0 + call test1 + call test2 + do i = 1, 10 + if (a(i) .ne. 10 * i) call abort + end do + !$omp parallel do reduction (+:c) + do i = 1, 10 + c = c + a + end do + do i = 1, 10 + if (c(i) .ne. 10 * a(i)) call abort + end do + !$omp parallel do lastprivate (j) + do j = 1, 10, k + end do + if (j .ne. 11) call abort +contains + subroutine test1 + integer :: i + integer :: b(10) + do i = 1, 10 + b(i) = i + end do + c(:) = 0 + !$omp parallel do reduction (+:a) + do i = 1, 10 + a = a + b + end do + end subroutine test1 + subroutine test2 + !$omp parallel do lastprivate (j) + do j = 1, 10, k + end do + if (j .ne. 11) call abort + end subroutine test2 +end program foo diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90 new file mode 100644 index 000000000..f9ce94b9a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + integer (kind = 4) :: a + integer (kind = 2) :: b + real :: c, f + double precision :: d + integer, dimension (10) :: e + a = 1 + b = 2 + c = 3 + d = 4 + e = 5 + f = 6 +!$omp atomic + a = a + 4 +!$omp atomic + b = 4 - b +!$omp atomic + c = c * 2 +!$omp atomic + d = 2 / d + if (a .ne. 5 .or. b .ne. 2 .or. c .ne. 6 .or. d .ne. 0.5) call abort + d = 1.2 +!$omp atomic + a = a + c + d +!$omp atomic + b = b - (a + c + d) + if (a .ne. 12 .or. b .ne. -17) call abort +!$omp atomic + a = c + d + a +!$omp atomic + b = a + c + d - b + if (a .ne. 19 .or. b .ne. 43) call abort +!$omp atomic + b = (a + c + d) - b + a = 32 +!$omp atomic + a = a / 3.4 + if (a .ne. 9 .or. b .ne. -16) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90 new file mode 100644 index 000000000..1dea2c8eb --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90 @@ -0,0 +1,54 @@ +! { dg-do run } + real, dimension (20) :: r + integer, dimension (20) :: d + integer :: i, j, k, n + integer (kind = 2) :: a, b, c + + do 10 i = 1, 20 + r(i) = i +10 d(i) = 21 - i + + n = 20 + call foo (r, d, n) + + if (n .ne. 22) call abort + if (any (r .ne. 33)) call abort + + i = 1 + j = 18 + k = 23 +!$omp atomic + i = min (i, j, k, n) + if (i .ne. 1) call abort +!$omp atomic + i = max (j, n, k, i) + if (i .ne. 23) call abort + + a = 1 + b = 18 + c = 23 +!$omp atomic + a = min (a, b, c) + if (a .ne. 1) call abort +!$omp atomic + a = max (a, b, c) + if (a .ne. 23) call abort + +contains + function bar (i) + real bar + integer i + bar = 12.0 + i + end function bar + + subroutine foo (x, y, n) + integer i, y (*), n + real x (*) + do i = 1, n +!$omp atomic + x(y(i)) = x(y(i)) + bar (i) + end do +!$omp atomic + n = n + 2 + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond1.f b/libgomp/testsuite/libgomp.fortran/omp_cond1.f new file mode 100644 index 000000000..b557d9080 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_cond1.f @@ -0,0 +1,22 @@ +C Test conditional compilation in fixed form if -fopenmp +! { dg-options "-fopenmp" } + 10 foo = 2 + &56 + if (foo.ne.256) call abort + bar = 26 +!$2 0 ba +c$ +r = 42 + !$ bar = 62 +!$ bar = bar + 1 + if (bar.ne.43) call abort + baz = bar +*$ 0baz = 5 +C$ +12! Comment +c$ !4 +!$ +!Another comment +*$ &2 +!$ X baz = 0 ! Not valid OpenMP conditional compilation lines +! $ baz = 1 +c$ 10&baz = 2 + if (baz.ne.51242) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond2.f b/libgomp/testsuite/libgomp.fortran/omp_cond2.f new file mode 100644 index 000000000..6df891c6c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_cond2.f @@ -0,0 +1,22 @@ +c Test conditional compilation in fixed form if -fno-openmp +! { dg-options "-fno-openmp" } + 10 foo = 2 + &56 + if (foo.ne.256) call abort + bar = 26 +!$2 0 ba +c$ +r = 42 + !$ bar = 62 +!$ bar = bar + 1 + if (bar.ne.26) call abort + baz = bar +*$ 0baz = 5 +C$ +12! Comment +c$ !4 +!$ +!Another comment +*$ &2 +!$ X baz = 0 ! Not valid OpenMP conditional compilation lines +! $ baz = 1 +c$ 10&baz = 2 + if (baz.ne.26) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond3.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90 new file mode 100644 index 000000000..6c4e36e22 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90 @@ -0,0 +1,24 @@ +! Test conditional compilation in free form if -fopenmp +! { dg-options "-fopenmp" } + 10 foo = 2& + &56 + if (foo.ne.256) call abort + bar = 26 + !$ 20 ba& +!$ &r = 4& + !$2 + !$bar = 62 + !$ bar = bar + 2 +#ifdef _OPENMP +bar = bar - 1 +#endif + if (bar.ne.43) call abort + baz = bar +!$ 30 baz = 5& ! Comment +!$12 & + !$ + 2 +!$X baz = 0 ! Not valid OpenMP conditional compilation lines +! $ baz = 1 +baz = baz + 1 !$ baz = 2 + if (baz.ne.515) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond4.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90 new file mode 100644 index 000000000..aa4c5cb76 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90 @@ -0,0 +1,24 @@ +! Test conditional compilation in free form if -fno-openmp +! { dg-options "-fno-openmp" } + 10 foo = 2& + &56 + if (foo.ne.256) call abort + bar = 26 + !$ 20 ba& +!$ &r = 4& + !$2 + !$bar = 62 + !$ bar = bar + 2 +#ifdef _OPENMP +bar = bar - 1 +#endif + if (bar.ne.26) call abort + baz = bar +!$ 30 baz = 5& ! Comment +!$12 & + !$ + 2 +!$X baz = 0 ! Not valid OpenMP conditional compilation lines +! $ baz = 1 +baz = baz + 1 !$ baz = 2 + if (baz.ne.27) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/omp_hello.f b/libgomp/testsuite/libgomp.fortran/omp_hello.f new file mode 100644 index 000000000..ba4453126 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_hello.f @@ -0,0 +1,36 @@ +C****************************************************************************** +C FILE: omp_hello.f +C DESCRIPTION: +C OpenMP Example - Hello World - Fortran Version +C In this simple example, the master thread forks a parallel region. +C All threads in the team obtain their unique thread number and print it. +C The master thread only prints the total number of threads. Two OpenMP +C library routines are used to obtain the number of threads and each +C thread's number. +C AUTHOR: Blaise Barney 5/99 +C LAST REVISED: +C****************************************************************************** + + PROGRAM HELLO + + INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, + + OMP_GET_THREAD_NUM + +C Fork a team of threads giving them their own copies of variables +!$OMP PARALLEL PRIVATE(NTHREADS, TID) + + +C Obtain thread number + TID = OMP_GET_THREAD_NUM() + PRINT *, 'Hello World from thread = ', TID + +C Only master thread does this + IF (TID .EQ. 0) THEN + NTHREADS = OMP_GET_NUM_THREADS() + PRINT *, 'Number of threads = ', NTHREADS + END IF + +C All threads join master thread and disband +!$OMP END PARALLEL + + END diff --git a/libgomp/testsuite/libgomp.fortran/omp_orphan.f b/libgomp/testsuite/libgomp.fortran/omp_orphan.f new file mode 100644 index 000000000..7653c78d2 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_orphan.f @@ -0,0 +1,44 @@ +C****************************************************************************** +C FILE: omp_orphan.f +C DESCRIPTION: +C OpenMP Example - Parallel region with an orphaned directive - Fortran +C Version +C This example demonstrates a dot product being performed by an orphaned +C loop reduction construct. Scoping of the reduction variable is critical. +C AUTHOR: Blaise Barney 5/99 +C LAST REVISED: +C****************************************************************************** + + PROGRAM ORPHAN + COMMON /DOTDATA/ A, B, SUM + INTEGER I, VECLEN + PARAMETER (VECLEN = 100) + REAL*8 A(VECLEN), B(VECLEN), SUM + + DO I=1, VECLEN + A(I) = 1.0 * I + B(I) = A(I) + ENDDO + SUM = 0.0 +!$OMP PARALLEL + CALL DOTPROD +!$OMP END PARALLEL + WRITE(*,*) "Sum = ", SUM + END + + + + SUBROUTINE DOTPROD + COMMON /DOTDATA/ A, B, SUM + INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN + PARAMETER (VECLEN = 100) + REAL*8 A(VECLEN), B(VECLEN), SUM + + TID = OMP_GET_THREAD_NUM() +!$OMP DO REDUCTION(+:SUM) + DO I=1, VECLEN + SUM = SUM + (A(I)*B(I)) + PRINT *, ' TID= ',TID,'I= ',I + ENDDO + RETURN + END diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse1.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90 new file mode 100644 index 000000000..9cd8cc2ba --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90 @@ -0,0 +1,185 @@ +! { dg-do run } +use omp_lib + call test_parallel + call test_do + call test_sections + call test_single + +contains + subroutine test_parallel + integer :: a, b, c, e, f, g, i, j + integer, dimension (20) :: d + logical :: h + a = 6 + b = 8 + c = 11 + d(:) = -1 + e = 13 + f = 24 + g = 27 + h = .false. + i = 1 + j = 16 +!$omp para& +!$omp&llel & +!$omp if (a .eq. 6) private (b, c) shared (d) private (e) & + !$omp firstprivate(f) num_threads (a - 1) first& +!$ompprivate(g)default (shared) reduction (.or. : h) & +!$omp reduction(*:i) + if (i .ne. 1) h = .true. + i = 2 + if (f .ne. 24) h = .true. + if (g .ne. 27) h = .true. + e = 7 + b = omp_get_thread_num () + if (b .eq. 0) j = 24 + f = b + g = f + c = omp_get_num_threads () + if (c .gt. a - 1 .or. c .le. 0) h = .true. + if (b .ge. c) h = .true. + d(b + 1) = c + if (f .ne. g .or. f .ne. b) h = .true. +!$omp endparallel + if (h) call abort + if (a .ne. 6) call abort + if (j .ne. 24) call abort + if (d(1) .eq. -1) call abort + e = 1 + do g = 1, d(1) + if (d(g) .ne. d(1)) call abort + e = e * 2 + end do + if (e .ne. i) call abort + end subroutine test_parallel + + subroutine test_do_orphan + integer :: k, l +!$omp parallel do private (l) + do 600 k = 1, 16, 2 +600 l = k + end subroutine test_do_orphan + + subroutine test_do + integer :: i, j, k, l, n + integer, dimension (64) :: d + logical :: m + + j = 16 + d(:) = -1 + m = .true. + n = 24 +!$omp parallel num_threads (4) shared (i, k, d) private (l) & +!$omp&reduction (.and. : m) + if (omp_get_thread_num () .eq. 0) then + k = omp_get_num_threads () + end if + call test_do_orphan +!$omp do schedule (static) firstprivate (n) + do 200 i = 1, j + if (i .eq. 1 .and. n .ne. 24) call abort + n = i +200 d(n) = omp_get_thread_num () +!$omp enddo nowait + +!$omp do lastprivate (i) schedule (static, 5) + do 201 i = j + 1, 2 * j +201 d(i) = omp_get_thread_num () + 1024 + ! Implied omp end do here + + if (i .ne. 33) m = .false. + +!$omp do private (j) schedule (dynamic) + do i = 33, 48 + d(i) = omp_get_thread_num () + 2048 + end do +!$omp end do nowait + +!$omp do schedule (runtime) + do i = 49, 4 * j + d(i) = omp_get_thread_num () + 4096 + end do + ! Implied omp end do here +!$omp end parallel + if (.not. m) call abort + + j = 0 + do i = 1, 64 + if (d(i) .lt. j .or. d(i) .ge. j + k) call abort + if (i .eq. 16) j = 1024 + if (i .eq. 32) j = 2048 + if (i .eq. 48) j = 4096 + end do + end subroutine test_do + + subroutine test_sections + integer :: i, j, k, l, m, n + i = 9 + j = 10 + k = 11 + l = 0 + m = 0 + n = 30 + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) +!$omp parallel num_threads (4) +!$omp sections private (i) firstprivate (j, k) lastprivate (j) & +!$omp& reduction (+ : l, m) +!$omp section + i = 24 + if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1 + m = m + 4 +!$omp section + i = 25 + if (j .ne. 10 .or. k .ne. 11) l = 1 + m = m + 6 +!$omp section + i = 26 + if (j .ne. 10 .or. k .ne. 11) l = 1 + m = m + 8 +!$omp section + i = 27 + if (j .ne. 10 .or. k .ne. 11) l = 1 + m = m + 10 + j = 271 +!$omp end sections nowait +!$omp sections lastprivate (n) +!$omp section + n = 6 +!$omp section + n = 7 +!$omp endsections +!$omp end parallel + if (j .ne. 271 .or. l .ne. 0) call abort + if (m .ne. 4 + 6 + 8 + 10) call abort + if (n .ne. 7) call abort + end subroutine test_sections + + subroutine test_single + integer :: i, j, k, l + logical :: m + i = 200 + j = 300 + k = 400 + l = 500 + m = .false. +!$omp parallel num_threads (4), private (i, j), reduction (.or. : m) + i = omp_get_thread_num () + j = omp_get_thread_num () +!$omp single private (k) + k = 64 +!$omp end single nowait +!$omp single private (k) firstprivate (l) + if (i .ne. omp_get_thread_num () .or. i .ne. j) then + j = -1 + else + j = -2 + end if + if (l .ne. 500) j = -1 + l = 265 +!$omp end single copyprivate (j) + if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true. +!$omp endparallel + if (m) call abort + end subroutine test_single +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 new file mode 100644 index 000000000..da54a9872 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 @@ -0,0 +1,102 @@ +! { dg-do run } +use omp_lib + call test_master + call test_critical + call test_barrier + call test_atomic + +contains + subroutine test_master + logical :: i, j + i = .false. + j = .false. +!$omp parallel num_threads (4) +!$omp master + i = .true. + j = omp_get_thread_num () .eq. 0 +!$omp endmaster +!$omp end parallel + if (.not. (i .or. j)) call abort + end subroutine test_master + + subroutine test_critical_1 (i, j) + integer :: i, j +!$omp critical(critical_foo) + i = i + 1 +!$omp end critical (critical_foo) +!$omp critical + j = j + 1 +!$omp end critical + end subroutine test_critical_1 + + subroutine test_critical + integer :: i, j, n + n = -1 + i = 0 + j = 0 +!$omp parallel num_threads (4) + if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads () + call test_critical_1 (i, j) + call test_critical_1 (i, j) +!$omp critical + j = j + 1 +!$omp end critical +!$omp critical (critical_foo) + i = i + 1 +!$omp endcritical (critical_foo) +!$omp end parallel + if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort + end subroutine test_critical + + subroutine test_barrier + integer :: i + logical :: j + i = 23 + j = .false. +!$omp parallel num_threads (4) + if (omp_get_thread_num () .eq. 0) i = 5 +!$omp flush (i) +!$omp barrier + if (i .ne. 5) then +!$omp atomic + j = j .or. .true. + end if +!$omp end parallel + if (i .ne. 5 .or. j) call abort + end subroutine test_barrier + + subroutine test_atomic + integer :: a, b, c, d, e, f, g + a = 0 + b = 1 + c = 0 + d = 1024 + e = 1024 + f = -1 + g = -1 +!$omp parallel num_threads (8) +!$omp atomic + a = a + 2 + 4 +!$omp atomic + b = 3 * b +!$omp atomic + c = 8 - c +!$omp atomic + d = d / 2 +!$omp atomic + e = min (e, omp_get_thread_num ()) +!$omp atomic + f = max (omp_get_thread_num (), f) + if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads () +!$omp end parallel + if (g .le. 0 .or. g .gt. 8) call abort + if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort + if (iand (g, 1) .eq. 1) then + if (c .ne. 8) call abort + else if (c .ne. 0) then + call abort + end if + if (d .ne. 1024 / (2 ** g)) call abort + if (e .ne. 0 .or. f .ne. g - 1) call abort + end subroutine test_atomic +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse3.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90 new file mode 100644 index 000000000..a39ff103e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90 @@ -0,0 +1,96 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } +use omp_lib + common /tlsblock/ x, y + integer :: x, y, z + save z +!$omp threadprivate (/tlsblock/, z) + + call test_flush + call test_ordered + call test_threadprivate + +contains + subroutine test_flush + integer :: i, j + i = 0 + j = 0 +!$omp parallel num_threads (4) + if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads () + if (omp_get_thread_num () .eq. 0) j = j + 1 +!$omp flush (i, j) +!$omp barrier + if (omp_get_thread_num () .eq. 1) j = j + 2 +!$omp flush +!$omp barrier + if (omp_get_thread_num () .eq. 2) j = j + 3 +!$omp flush (i) +!$omp flush (j) +!$omp barrier + if (omp_get_thread_num () .eq. 3) j = j + 4 +!$omp end parallel + end subroutine test_flush + + subroutine test_ordered + integer :: i, j + integer, dimension (100) :: d + d(:) = -1 +!$omp parallel do ordered schedule (dynamic) num_threads (4) + do i = 1, 100, 5 +!$omp ordered + d(i) = i +!$omp end ordered + end do + j = 1 + do 100 i = 1, 100 + if (i .eq. j) then + if (d(i) .ne. i) call abort + j = i + 5 + else + if (d(i) .ne. -1) call abort + end if +100 d(i) = -1 + end subroutine test_ordered + + subroutine test_threadprivate + common /tlsblock/ x, y +!$omp threadprivate (/tlsblock/) + integer :: i, j, x, y + logical :: m, n + call omp_set_num_threads (4) + call omp_set_dynamic (.false.) + i = -1 + x = 6 + y = 7 + z = 8 + n = .false. + m = .false. +!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) & +!$omp& num_threads (4) + if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads () + if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort + x = omp_get_thread_num () + y = omp_get_thread_num () + 1024 + z = omp_get_thread_num () + 4096 +!$omp end parallel + if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort +!$omp parallel num_threads (4), private (j) reduction (.or.:n) + if (omp_get_num_threads () .eq. i) then + j = omp_get_thread_num () + if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) & +& call abort + end if +!$omp end parallel + m = m .or. n + n = .false. +!$omp parallel num_threads (4), copyin (z) reduction (.or. : n) & +!$omp&private (j) + if (z .ne. 4096) n = .true. + if (omp_get_num_threads () .eq. i) then + j = omp_get_thread_num () + if (x .ne. j .or. y .ne. j + 1024) call abort + end if +!$omp end parallel + if (m .or. n) call abort + end subroutine test_threadprivate +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse4.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90 new file mode 100644 index 000000000..ba35bcb2a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +!$ use omp_lib + call test_workshare + +contains + subroutine test_workshare + integer :: i, j, k, l, m + double precision, dimension (64) :: d, e + integer, dimension (10) :: f, g + integer, dimension (16, 16) :: a, b, c + integer, dimension (16) :: n + d(:) = 1 + e = 7 + f = 10 + l = 256 + m = 512 + g(1:3) = -1 + g(4:6) = 0 + g(7:8) = 5 + g(9:10) = 10 + forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j + forall (j = 1:16) n (j) = j +!$omp parallel num_threads (4) private (j, k) +!$omp barrier +!$omp workshare + i = 6 + e(:) = d(:) + where (g .lt. 0) + f = 100 + elsewhere (g .eq. 0) + f = 200 + f + elsewhere + where (g .gt. 6) f = f + sum (g) + f = 300 + f + end where + where (f .gt. 210) g = 0 +!$omp end workshare nowait +!$omp workshare + forall (j = 1:16, k = 1:16) b (k, j) = a (j, k) + forall (k = 1:16) c (k, 1:16) = a (1:16, k) + forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j)) + n (j) = n (j - 1) * n (j) + end forall +!$omp endworkshare +!$omp workshare +!$omp atomic + i = i + 8 + 6 +!$omp critical +!$omp critical (critical_foox) + l = 128 +!$omp end critical (critical_foox) +!$omp endcritical +!$omp parallel num_threads (2) +!$ if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads () +!$omp atomic + l = 1 + l +!$omp end parallel +!$omp end workshare +!$omp end parallel + + if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) & +& call abort + if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) call abort + if (i .ne. 20) call abort +!$ if (l .ne. 128 + m) call abort + if (any (d .ne. 1 .or. e .ne. 1)) call abort + if (any (b .ne. transpose (a))) call abort + if (any (c .ne. b)) call abort + if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, & +& 110, 132, 13, 182, 210, 240/))) call abort + end subroutine test_workshare +end diff --git a/libgomp/testsuite/libgomp.fortran/omp_reduction.f b/libgomp/testsuite/libgomp.fortran/omp_reduction.f new file mode 100644 index 000000000..0560bd896 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_reduction.f @@ -0,0 +1,33 @@ +C****************************************************************************** +C FILE: omp_reduction.f +C DESCRIPTION: +C OpenMP Example - Combined Parallel Loop Reduction - Fortran Version +C This example demonstrates a sum reduction within a combined parallel loop +C construct. Notice that default data element scoping is assumed - there +C are no clauses specifying shared or private variables. OpenMP will +C automatically make loop index variables private within team threads, and +C global variables shared. +C AUTHOR: Blaise Barney 5/99 +C LAST REVISED: +C****************************************************************************** + + PROGRAM REDUCTION + + INTEGER I, N + REAL A(100), B(100), SUM + +! Some initializations + N = 100 + DO I = 1, N + A(I) = I *1.0 + B(I) = A(I) + ENDDO + SUM = 0.0 + +!$OMP PARALLEL DO REDUCTION(+:SUM) + DO I = 1, N + SUM = SUM + (A(I) * B(I)) + ENDDO + + PRINT *, ' Sum = ', SUM + END diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare1.f b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f new file mode 100644 index 000000000..8aef69406 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f @@ -0,0 +1,48 @@ +C****************************************************************************** +C FILE: omp_workshare1.f +C DESCRIPTION: +C OpenMP Example - Loop Work-sharing - Fortran Version +C In this example, the iterations of a loop are scheduled dynamically +C across the team of threads. A thread will perform CHUNK iterations +C at a time before being scheduled for the next CHUNK of work. +C AUTHOR: Blaise Barney 5/99 +C LAST REVISED: 01/09/04 +C****************************************************************************** + + PROGRAM WORKSHARE1 + + INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, + + OMP_GET_THREAD_NUM, N, CHUNKSIZE, CHUNK, I + PARAMETER (N=100) + PARAMETER (CHUNKSIZE=10) + REAL A(N), B(N), C(N) + +! Some initializations + DO I = 1, N + A(I) = I * 1.0 + B(I) = A(I) + ENDDO + CHUNK = CHUNKSIZE + +!$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(I,TID) + + TID = OMP_GET_THREAD_NUM() + IF (TID .EQ. 0) THEN + NTHREADS = OMP_GET_NUM_THREADS() + PRINT *, 'Number of threads =', NTHREADS + END IF + PRINT *, 'Thread',TID,' starting...' + +!$OMP DO SCHEDULE(DYNAMIC,CHUNK) + DO I = 1, N + C(I) = A(I) + B(I) + WRITE(*,100) TID,I,C(I) + 100 FORMAT(' Thread',I2,': C(',I3,')=',F8.2) + ENDDO +!$OMP END DO NOWAIT + + PRINT *, 'Thread',TID,' done.' + +!$OMP END PARALLEL + + END diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare2.f b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f new file mode 100644 index 000000000..9e61da91e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f @@ -0,0 +1,56 @@ +C****************************************************************************** +C FILE: omp_workshare2.f +C DESCRIPTION: +C OpenMP Example - Sections Work-sharing - Fortran Version +C In this example, the OpenMP SECTION directive is used to assign +C different array operations to threads that execute a SECTION. Each +C thread receives its own copy of the result array to work with. +C AUTHOR: Blaise Barney 5/99 +C LAST REVISED: 01/09/04 +C****************************************************************************** + + PROGRAM WORKSHARE2 + + INTEGER N, I, NTHREADS, TID, OMP_GET_NUM_THREADS, + + OMP_GET_THREAD_NUM + PARAMETER (N=50) + REAL A(N), B(N), C(N) + +! Some initializations + DO I = 1, N + A(I) = I * 1.0 + B(I) = A(I) + ENDDO + +!$OMP PARALLEL SHARED(A,B,NTHREADS), PRIVATE(C,I,TID) + TID = OMP_GET_THREAD_NUM() + IF (TID .EQ. 0) THEN + NTHREADS = OMP_GET_NUM_THREADS() + PRINT *, 'Number of threads =', NTHREADS + END IF + PRINT *, 'Thread',TID,' starting...' + +!$OMP SECTIONS + +!$OMP SECTION + PRINT *, 'Thread',TID,' doing section 1' + DO I = 1, N + C(I) = A(I) + B(I) + WRITE(*,100) TID,I,C(I) + 100 FORMAT(' Thread',I2,': C(',I2,')=',F8.2) + ENDDO + +!$OMP SECTION + PRINT *, 'Thread',TID,' doing section 2' + DO I = 1+N/2, N + C(I) = A(I) * B(I) + WRITE(*,100) TID,I,C(I) + ENDDO + +!$OMP END SECTIONS NOWAIT + + PRINT *, 'Thread',TID,' done.' + +!$OMP END PARALLEL + + END diff --git a/libgomp/testsuite/libgomp.fortran/pr25162.f b/libgomp/testsuite/libgomp.fortran/pr25162.f new file mode 100644 index 000000000..a868ea4c9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr25162.f @@ -0,0 +1,40 @@ +C PR fortran/25162 +C { dg-do run } +C { dg-require-effective-target tls_runtime } + PROGRAM PR25162 + CALL TEST1 + CALL TEST2 + END + SUBROUTINE TEST1 + DOUBLE PRECISION BPRIM + COMMON /TESTCOM/ BPRIM(100) +C$OMP THREADPRIVATE(/TESTCOM/) + INTEGER I + DO I = 1, 100 + BPRIM( I ) = DBLE( I ) + END DO + RETURN + END + SUBROUTINE TEST2 + DOUBLE PRECISION BPRIM + COMMON /TESTCOM/ BPRIM(100) +C$OMP THREADPRIVATE(/TESTCOM/) + INTEGER I, IDUM(50) + DO I = 1, 50 + IDUM(I) = I + END DO +C$OMP PARALLEL COPYIN(/TESTCOM/) NUM_THREADS(4) + CALL TEST3 +C$OMP END PARALLEL + RETURN + END + SUBROUTINE TEST3 + DOUBLE PRECISION BPRIM + COMMON /TESTCOM/ BPRIM(100) +C$OMP THREADPRIVATE(/TESTCOM/) + INTEGER K + DO K = 1, 10 + IF (K.NE.BPRIM(K)) CALL ABORT + END DO + RETURN + END diff --git a/libgomp/testsuite/libgomp.fortran/pr25219.f90 b/libgomp/testsuite/libgomp.fortran/pr25219.f90 new file mode 100644 index 000000000..7fe1a53aa --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr25219.f90 @@ -0,0 +1,15 @@ +! PR fortran/25219 + + implicit none + save + integer :: i, k + k = 3 +!$omp parallel +!$omp do lastprivate (k) + do i = 1, 100 + k = i + end do +!$omp end do +!$omp end parallel + if (k .ne. 100) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/pr27395-1.f90 b/libgomp/testsuite/libgomp.fortran/pr27395-1.f90 new file mode 100644 index 000000000..380a10776 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr27395-1.f90 @@ -0,0 +1,31 @@ +! PR fortran/27395 +! { dg-do run } + +program pr27395_1 + implicit none + integer, parameter :: n=10,m=1001 + integer :: i + integer, dimension(n) :: sumarray + call foo(n,m,sumarray) + do i=1,n + if (sumarray(i).ne.m*i) call abort + end do +end program pr27395_1 + +subroutine foo(n,m,sumarray) + use omp_lib, only : omp_get_thread_num + implicit none + integer, intent(in) :: n,m + integer, dimension(n), intent(out) :: sumarray + integer :: i,j + sumarray(:)=0 +!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(4) +!$OMP DO PRIVATE(j,i), REDUCTION(+:sumarray) + do j=1,m + do i=1,n + sumarray(i)=sumarray(i)+i + end do + end do +!$OMP END DO +!$OMP END PARALLEL +end subroutine foo diff --git a/libgomp/testsuite/libgomp.fortran/pr27395-2.f90 b/libgomp/testsuite/libgomp.fortran/pr27395-2.f90 new file mode 100644 index 000000000..b3cb255f6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr27395-2.f90 @@ -0,0 +1,30 @@ +! PR fortran/27395 +! { dg-do run } + +program pr27395_2 + implicit none + integer, parameter :: n=10,m=1001 + integer :: i + call foo(n,m) +end program pr27395_2 + +subroutine foo(n,m) + use omp_lib, only : omp_get_thread_num + implicit none + integer, intent(in) :: n,m + integer :: i,j + integer, dimension(n) :: sumarray + sumarray(:)=0 +!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(4) +!$OMP DO PRIVATE(j,i), REDUCTION(+:sumarray) + do j=1,m + do i=1,n + sumarray(i)=sumarray(i)+i + end do + end do +!$OMP END DO +!$OMP END PARALLEL + do i=1,n + if (sumarray(i).ne.m*i) call abort + end do +end subroutine foo diff --git a/libgomp/testsuite/libgomp.fortran/pr27416-1.f90 b/libgomp/testsuite/libgomp.fortran/pr27416-1.f90 new file mode 100644 index 000000000..d42e1ef19 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr27416-1.f90 @@ -0,0 +1,19 @@ +! PR middle-end/27416 +! { dg-do run } + + integer :: j + j = 6 +!$omp parallel num_threads (4) + call foo (j) +!$omp end parallel + if (j.ne.6+16) call abort +end + +subroutine foo (j) + integer :: i, j + +!$omp do firstprivate (j) lastprivate (j) + do i = 1, 16 + if (i.eq.16) j = j + i + end do +end subroutine foo diff --git a/libgomp/testsuite/libgomp.fortran/pr27916-1.f90 b/libgomp/testsuite/libgomp.fortran/pr27916-1.f90 new file mode 100644 index 000000000..7f6b51d08 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr27916-1.f90 @@ -0,0 +1,26 @@ +! PR fortran/27916 +! Test whether allocatable privatized arrays has "not currently allocated" +! status at the start of OpenMP constructs. +! { dg-do run } + +program pr27916 + integer :: n, i + logical :: r + integer, dimension(:), allocatable :: a + + r = .false. +!$omp parallel do num_threads (4) private (n, a, i) & +!$omp & reduction (.or.: r) schedule (static) + do n = 1, 16 + r = r .or. allocated (a) + allocate (a (16)) + r = r .or. .not. allocated (a) + do i = 1, 16 + a (i) = i + end do + deallocate (a) + r = r .or. allocated (a) + end do + !$omp end parallel do + if (r) call abort +end program pr27916 diff --git a/libgomp/testsuite/libgomp.fortran/pr27916-2.f90 b/libgomp/testsuite/libgomp.fortran/pr27916-2.f90 new file mode 100644 index 000000000..aa8bb0aec --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr27916-2.f90 @@ -0,0 +1,26 @@ +! PR fortran/27916 +! Test whether allocatable privatized arrays has "not currently allocated" +! status at the start of OpenMP constructs. +! { dg-do run } + +program pr27916 + integer :: n, i + logical :: r + integer, dimension(:), allocatable :: a + + r = .false. +!$omp parallel do num_threads (4) default (private) & +!$omp & reduction (.or.: r) schedule (static) + do n = 1, 16 + r = r .or. allocated (a) + allocate (a (16)) + r = r .or. .not. allocated (a) + do i = 1, 16 + a (i) = i + end do + deallocate (a) + r = r .or. allocated (a) + end do + !$omp end parallel do + if (r) call abort +end program pr27916 diff --git a/libgomp/testsuite/libgomp.fortran/pr28390.f b/libgomp/testsuite/libgomp.fortran/pr28390.f new file mode 100644 index 000000000..68fc32b6f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr28390.f @@ -0,0 +1,8 @@ +! PR fortran/28390 + program pr28390 + integer i +!$omp parallel do lastprivate(i) + do i=1,100 + end do + if (i.ne.101) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/pr29629.f90 b/libgomp/testsuite/libgomp.fortran/pr29629.f90 new file mode 100644 index 000000000..9ccddffb0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr29629.f90 @@ -0,0 +1,20 @@ +! PR fortran/29629 +! { dg-do run } + +program pr29629 + integer :: n + n = 10000 + if (any (func(n).ne.10000)) call abort + contains + function func(n) + integer, intent(in) :: n + integer, dimension(n) :: func + integer :: k + func = 0 +!$omp parallel do private(k), reduction(+:func), num_threads(4) + do k = 1, n + func = func + 1 + end do +!$omp end parallel do + end function +end program diff --git a/libgomp/testsuite/libgomp.fortran/pr32359.f90 b/libgomp/testsuite/libgomp.fortran/pr32359.f90 new file mode 100644 index 000000000..e48a8a704 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr32359.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! +! PR fortran/32359 +! Contributed by Bill Long <longb@cray.com> + +subroutine test + use omp_lib + implicit none + integer, parameter :: NT = 4 + integer :: a + save +!$omp threadprivate(a) + a = 1 + +!$ call omp_set_num_threads(NT) +!$omp parallel + print *, omp_get_thread_num(), a +!$omp end parallel + +end subroutine test + +! Derived from OpenMP test omp1/F2_6_2_8_5i.f90 + use omp_lib + implicit none + integer, parameter :: NT = 4 + integer :: a = 1 +!$omp threadprivate(a) + +!$ call omp_set_num_threads(NT) +!$omp parallel + print *, omp_get_thread_num(), a +!$omp end parallel + + END diff --git a/libgomp/testsuite/libgomp.fortran/pr32550.f90 b/libgomp/testsuite/libgomp.fortran/pr32550.f90 new file mode 100644 index 000000000..2c95cc6e0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr32550.f90 @@ -0,0 +1,21 @@ +! PR fortran/32550 +! { dg-do run } +! { dg-require-effective-target tls_runtime } + + integer, pointer, save :: ptr + integer, target :: targ + integer :: e +!$omp threadprivate(ptr) + e = 0 + targ = 42 +!$omp parallel shared(targ) +!$omp single + ptr => targ +!$omp end single copyprivate(ptr) + if (ptr.ne.42) then +!$omp atomic + e = e + 1 + end if +!$omp end parallel + if (e.ne.0) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/pr33880.f90 b/libgomp/testsuite/libgomp.fortran/pr33880.f90 new file mode 100644 index 000000000..679cab682 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr33880.f90 @@ -0,0 +1,18 @@ +! PR middle-end/33880 +! { dg-do run } + +program pr33880 + integer :: i, j + call something () + !$omp parallel do + do i = 1, 1000 + !$omp atomic + j = j + 1 + end do + if (j .ne. 1000) call abort +contains + subroutine something() + i = 0 + j = 0 + end subroutine something +end program pr33880 diff --git a/libgomp/testsuite/libgomp.fortran/pr34020.f90 b/libgomp/testsuite/libgomp.fortran/pr34020.f90 new file mode 100644 index 000000000..3bb14f5fe --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr34020.f90 @@ -0,0 +1,19 @@ +! PR fortran/34020 +! { dg-do run } + + subroutine atomic_add(lhs, rhs) + real lhs, rhs +!$omp atomic + lhs = rhs + lhs + end + + real lhs, rhs + integer i + lhs = 0 + rhs = 1 +!$omp parallel do num_threads(8) shared(lhs, rhs) + do i = 1, 300000 + call atomic_add(lhs, rhs) + enddo + if (lhs .ne. 300000) call abort + end diff --git a/libgomp/testsuite/libgomp.fortran/pr35130.f90 b/libgomp/testsuite/libgomp.fortran/pr35130.f90 new file mode 100644 index 000000000..50ff35152 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr35130.f90 @@ -0,0 +1,20 @@ +! PR middle-end/35130 + +program pr35130 + implicit none + real, dimension(20) :: a + integer :: k + a(:) = 0.0 +!$omp parallel do private(k) + do k=1,size(a) + call inner(k) + end do +!$omp end parallel do + if (any (a.ne.42)) call abort +contains + subroutine inner(i) + implicit none + integer :: i + a(i) = 42 + end subroutine inner +end program pr35130 diff --git a/libgomp/testsuite/libgomp.fortran/pr42162.f90 b/libgomp/testsuite/libgomp.fortran/pr42162.f90 new file mode 100644 index 000000000..dbcc3b71d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr42162.f90 @@ -0,0 +1,53 @@ +! PR fortran/42162 +! { dg-do run } + +subroutine sub1(k, a) + implicit none + integer :: k, a(3) + !$omp do + do k=1,3 + a(k) = a(k) + 1 + enddo + !$omp end do +end subroutine sub1 + +subroutine sub2(k, a) + implicit none + integer :: k, a(3) + !$omp do private (k) + do k=1,3 + a(k) = a(k) + 1 + enddo + !$omp end do +end subroutine sub2 + +subroutine sub3(k, a) + implicit none + integer :: k, a(3) + !$omp do lastprivate (k) + do k=1,3 + a(k) = a(k) + 1 + enddo + !$omp end do +end subroutine sub3 + +program pr42162 + implicit none + integer :: k, a(3), b(3), c(3) + a = 1 + b = 2 + c = 3 + k = 3 + !$omp parallel num_threads(3) + call sub1 (k, a) + !$omp end parallel + k = 4 + !$omp parallel num_threads(3) + call sub2 (k, b) + !$omp end parallel + k = 10 + !$omp parallel num_threads(3) + call sub3 (k, c) + !$omp end parallel + if (k.ne.4.or.any(a.ne.2).or.any(b.ne.3).or.any(c.ne.4)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/pr46753.f90 b/libgomp/testsuite/libgomp.fortran/pr46753.f90 new file mode 100644 index 000000000..f4833abc8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr46753.f90 @@ -0,0 +1,17 @@ +! PR fortran/46753 +! { dg-do run } + + integer :: i, j + j = 0 +!$omp parallel do reduction(+:j) + do i = 2147483636, 2147483646 + j = j + 1 + end do + if (j.ne.11) call abort + j = 0 +!$omp parallel do reduction(+:j) + do i = -2147483637, -2147483647, -1 + j = j + 1 + end do + if (j.ne.11) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/pr48894.f90 b/libgomp/testsuite/libgomp.fortran/pr48894.f90 new file mode 100644 index 000000000..af35112ad --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr48894.f90 @@ -0,0 +1,23 @@ +! PR fortran/48894 +! { dg-do run } +! { dg-options "-fdefault-integer-8" } + + use omp_lib + integer, parameter :: zero = 0 + integer :: err + logical :: l + err = 0 + !$omp parallel + !$omp parallel private (l) + l = omp_get_ancestor_thread_num (-HUGE (zero)) .ne. -1 + l = l .or. (omp_get_ancestor_thread_num (HUGE (zero)) .ne. -1) + l = l .or. (omp_get_team_size (-HUGE (zero)) .ne. -1) + l = l .or. (omp_get_team_size (HUGE (zero)) .ne. -1) + if (l) then + !$omp atomic + err = err + 1 + endif + !$omp end parallel + !$omp end parallel + if (err .ne. 0) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/pr49792-1.f90 b/libgomp/testsuite/libgomp.fortran/pr49792-1.f90 new file mode 100644 index 000000000..cf2bb66fc --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr49792-1.f90 @@ -0,0 +1,18 @@ +! PR fortran/49792 +! { dg-do run } + +subroutine reverse(n, a) + integer :: n + real(kind=8) :: a(n) +!$omp parallel workshare + a(:) = a(n:1:-1) +!$omp end parallel workshare +end subroutine reverse + +program pr49792 + real(kind=8) :: a(16) = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16] + real(kind=8) :: b(16) + b(:) = a(16:1:-1) + call reverse (16,a) + if (any (a.ne.b)) call abort +end program pr49792 diff --git a/libgomp/testsuite/libgomp.fortran/pr49792-2.f90 b/libgomp/testsuite/libgomp.fortran/pr49792-2.f90 new file mode 100644 index 000000000..2101028a9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr49792-2.f90 @@ -0,0 +1,22 @@ +! PR fortran/49792 +! { dg-do run } +! { dg-options "-std=f2003 -fall-intrinsics" } + +subroutine reverse(n, a) + integer :: n + real(kind=8) :: a(n) +!$omp parallel workshare + a(:) = a(n:1:-1) +!$omp end parallel workshare +end subroutine reverse + +program pr49792 + integer :: b(16) + integer, allocatable :: a(:) + b = 1 +!$omp parallel workshare + a = b +!$omp end parallel workshare + if (size(a).ne.size(b)) call abort() + if (any (a.ne.b)) call abort() +end program pr49792 diff --git a/libgomp/testsuite/libgomp.fortran/recursion1.f90 b/libgomp/testsuite/libgomp.fortran/recursion1.f90 new file mode 100644 index 000000000..35cb8786e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/recursion1.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-fopenmp -fcheck=recursion" } +! +! PR 42517: Bogus runtime error with -fopenmp -fcheck=recursion +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +implicit none +integer :: i,s + +s=0 +!$omp parallel do private(i) shared(s) +do i=1,10 + call sub(i) +end do +!$omp end parallel do +if (s/=55) call abort() + +contains + + subroutine sub (n) + integer :: n +!$omp atomic + s = s + n + print '(A,i3)',"loop =",n + end subroutine + +end diff --git a/libgomp/testsuite/libgomp.fortran/reduction1.f90 b/libgomp/testsuite/libgomp.fortran/reduction1.f90 new file mode 100644 index 000000000..d6ceb0814 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction1.f90 @@ -0,0 +1,181 @@ +! { dg-do run } +!$ use omp_lib + + integer :: i, ia (6), n, cnt + real :: r, ra (4) + double precision :: d, da (5) + complex :: c, ca (3) + logical :: v + + i = 1 + ia = 2 + r = 3 + ra = 4 + d = 5.5 + da = 6.5 + c = cmplx (7.5, 1.5) + ca = cmplx (8.5, -3.0) + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (+:i, ia, r, ra, d, da, c, ca) +!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true. +!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true. +!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true. +!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = 4 + ia(3:5) = -2 + r = 5 + ra(1:2) = 6.5 + d = -2.5 + da(2:4) = 8.5 + c = cmplx (2.5, -3.5) + ca(1) = cmplx (4.5, 5) + else if (n .eq. 1) then + i = 2 + ia(4:6) = 5 + r = 1 + ra(2:4) = -1.5 + d = 8.5 + da(1:3) = 2.5 + c = cmplx (0.5, -3) + ca(2:3) = cmplx (-1, 6) + else + i = 1 + ia = 1 + r = -1 + ra = -1 + d = 1 + da = -1 + c = 1 + ca = cmplx (-1, 0) + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort + if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort + if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort + if (c .ne. cmplx (11.5, -5)) call abort + if (ca(1) .ne. cmplx (12, 2)) call abort + if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort + end if + + i = 1 + ia = 2 + r = 3 + ra = 4 + d = 5.5 + da = 6.5 + c = cmplx (7.5, 1.5) + ca = cmplx (8.5, -3.0) + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (-:i, ia, r, ra, d, da, c, ca) +!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true. +!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true. +!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true. +!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = 4 + ia(3:5) = -2 + r = 5 + ra(1:2) = 6.5 + d = -2.5 + da(2:4) = 8.5 + c = cmplx (2.5, -3.5) + ca(1) = cmplx (4.5, 5) + else if (n .eq. 1) then + i = 2 + ia(4:6) = 5 + r = 1 + ra(2:4) = -1.5 + d = 8.5 + da(1:3) = 2.5 + c = cmplx (0.5, -3) + ca(2:3) = cmplx (-1, 6) + else + i = 1 + ia = 1 + r = -1 + ra = -1 + d = 1 + da = -1 + c = 1 + ca = cmplx (-1, 0) + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort + if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort + if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort + if (c .ne. cmplx (11.5, -5)) call abort + if (ca(1) .ne. cmplx (12, 2)) call abort + if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort + end if + + i = 1 + ia = 2 + r = 4 + ra = 8 + d = 16 + da = 32 + c = 2 + ca = cmplx (0, 2) + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (*:i, ia, r, ra, d, da, c, ca) +!$ if (i .ne. 1 .or. any (ia .ne. 1)) v = .true. +!$ if (r .ne. 1 .or. any (ra .ne. 1)) v = .true. +!$ if (d .ne. 1 .or. any (da .ne. 1)) v = .true. +!$ if (c .ne. cmplx (1) .or. any (ca .ne. cmplx (1))) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = 3 + ia(3:5) = 2 + r = 0.5 + ra(1:2) = 2 + d = -1 + da(2:4) = -2 + c = 2.5 + ca(1) = cmplx (-5, 0) + else if (n .eq. 1) then + i = 2 + ia(4:6) = -2 + r = 8 + ra(2:4) = -0.5 + da(1:3) = -1 + c = -3 + ca(2:3) = cmplx (0, -1) + else + ia = 2 + r = 0.5 + ra = 0.25 + d = 2.5 + da = -1 + c = cmplx (0, -1) + ca = cmplx (-1, 0) + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (i .ne. 6 .or. any (ia .ne. (/4, 4, 8, -16, -16, -8/))) call abort + if (r .ne. 8 .or. any (ra .ne. (/4., -2., -1., -1./))) call abort + if (d .ne. -40 .or. any (da .ne. (/32., -64., -64., 64., -32./))) call abort + if (c .ne. cmplx (0, 15)) call abort + if (ca(1) .ne. cmplx (0, 10)) call abort + if (ca(2) .ne. cmplx (-2, 0) .or. ca(2) .ne. ca(3)) call abort + end if +end diff --git a/libgomp/testsuite/libgomp.fortran/reduction2.f90 b/libgomp/testsuite/libgomp.fortran/reduction2.f90 new file mode 100644 index 000000000..9bdeb77de --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction2.f90 @@ -0,0 +1,73 @@ +! { dg-do run } +!$ use omp_lib + + logical :: l, la (4), m, ma (4), v + integer :: n, cnt + + l = .true. + la = (/.true., .false., .true., .true./) + m = .false. + ma = (/.false., .false., .false., .true./) + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (.and.:l, la) reduction (.or.:m, ma) +!$ if (.not. l .or. any (.not. la)) v = .true. +!$ if (m .or. any (ma)) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + l = .false. + la(3) = .false. + ma(2) = .true. + else if (n .eq. 1) then + l = .false. + la(4) = .false. + ma(1) = .true. + else + la(3) = .false. + m = .true. + ma(1) = .true. + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (l .or. any (la .neqv. (/.true., .false., .false., .false./))) call abort + if (.not. m .or. any (ma .neqv. (/.true., .true., .false., .true./))) call abort + end if + + l = .true. + la = (/.true., .false., .true., .true./) + m = .false. + ma = (/.false., .false., .false., .true./) + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (.eqv.:l, la) reduction (.neqv.:m, ma) +!$ if (.not. l .or. any (.not. la)) v = .true. +!$ if (m .or. any (ma)) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + l = .false. + la(3) = .false. + ma(2) = .true. + else if (n .eq. 1) then + l = .false. + la(4) = .false. + ma(1) = .true. + else + la(3) = .false. + m = .true. + ma(1) = .true. + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (.not. l .or. any (la .neqv. (/.true., .false., .true., .false./))) call abort + if (.not. m .or. any (ma .neqv. (/.false., .true., .false., .true./))) call abort + end if + +end diff --git a/libgomp/testsuite/libgomp.fortran/reduction3.f90 b/libgomp/testsuite/libgomp.fortran/reduction3.f90 new file mode 100644 index 000000000..89b9d1af6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction3.f90 @@ -0,0 +1,103 @@ +! { dg-do run } +!$ use omp_lib + + integer (kind = 4) :: i, ia (6), n, cnt + real :: r, ra (4) + double precision :: d, da (5) + logical :: v + + i = 1 + ia = 2 + r = 3 + ra = 4 + d = 5.5 + da = 6.5 + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (max:i, ia, r, ra, d, da) +!$ if (i .ne. -huge(i)-1 .or. any (ia .ne. -huge(ia)-1)) v = .true. +!$ if (r .ge. -1.0d38 .or. any (ra .ge. -1.0d38)) v = .true. +!$ if (d .ge. -1.0d300 .or. any (da .ge. -1.0d300)) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = 4 + ia(3:5) = -2 + ia(1) = 7 + r = 5 + ra(1:2) = 6.5 + d = -2.5 + da(2:4) = 8.5 + else if (n .eq. 1) then + i = 2 + ia(4:6) = 5 + r = 1 + ra(2:4) = -1.5 + d = 8.5 + da(1:3) = 2.5 + else + i = 1 + ia = 1 + r = -1 + ra = -1 + d = 1 + da = -1 + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (i .ne. 4 .or. any (ia .ne. (/7, 2, 2, 5, 5, 5/))) call abort + if (r .ne. 5 .or. any (ra .ne. (/6.5, 6.5, 4., 4./))) call abort + if (d .ne. 8.5 .or. any (da .ne. (/6.5, 8.5, 8.5, 8.5, 6.5/))) call abort + end if + + i = 1 + ia = 2 + r = 3 + ra = 4 + d = 5.5 + da = 6.5 + v = .false. + cnt = -1 + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (min:i, ia, r, ra, d, da) +!$ if (i .ne. 2147483647 .or. any (ia .ne. 2147483647)) v = .true. +!$ if (r .le. 1.0d38 .or. any (ra .le. 1.0d38)) v = .true. +!$ if (d .le. 1.0d300 .or. any (da .le. 1.0d300)) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = 4 + ia(3:5) = -2 + ia(1) = 7 + r = 5 + ra(1:2) = 6.5 + d = -2.5 + da(2:4) = 8.5 + else if (n .eq. 1) then + i = 2 + ia(4:6) = 5 + r = 1 + ra(2:4) = -1.5 + d = 8.5 + da(1:3) = 2.5 + else + i = 1 + ia = 1 + r = -1 + ra = 7 + ra(3) = -8.5 + d = 1 + da(1:4) = 6 + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + if (i .ne. 1 .or. any (ia .ne. (/1, 1, -2, -2, -2, 1/))) call abort + if (r .ne. -1 .or. any (ra .ne. (/4., -1.5, -8.5, -1.5/))) call abort + if (d .ne. -2.5 .or. any (da .ne. (/2.5, 2.5, 2.5, 6., 6.5/))) call abort + end if +end diff --git a/libgomp/testsuite/libgomp.fortran/reduction4.f90 b/libgomp/testsuite/libgomp.fortran/reduction4.f90 new file mode 100644 index 000000000..bb1ed0e20 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction4.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +!$ use omp_lib + + integer (kind = 4) :: i, ia (6), j, ja (6), k, ka (6), ta (6), n, cnt, x + logical :: v + + i = Z'ffff0f' + ia = Z'f0ff0f' + j = Z'0f0000' + ja = Z'0f5a00' + k = Z'055aa0' + ka = Z'05a5a5' + v = .false. + cnt = -1 + x = not(0) + +!$omp parallel num_threads (3) private (n) reduction (.or.:v) & +!$omp & reduction (iand:i, ia) reduction (ior:j, ja) reduction (ieor:k, ka) +!$ if (i .ne. x .or. any (ia .ne. x)) v = .true. +!$ if (j .ne. 0 .or. any (ja .ne. 0)) v = .true. +!$ if (k .ne. 0 .or. any (ka .ne. 0)) v = .true. + n = omp_get_thread_num () + if (n .eq. 0) then + cnt = omp_get_num_threads () + i = Z'ff7fff' + ia(3:5) = Z'fffff1' + j = Z'078000' + ja(1:3) = 1 + k = Z'78' + ka(3:6) = Z'f0f' + else if (n .eq. 1) then + i = Z'ffff77' + ia(2:5) = Z'ffafff' + j = Z'007800' + ja(2:5) = 8 + k = Z'57' + ka(3:4) = Z'f0108' + else + i = Z'777fff' + ia(1:2) = Z'fffff3' + j = Z'000780' + ja(5:6) = Z'f00' + k = Z'1000' + ka(6:6) = Z'777' + end if +!$omp end parallel + if (v) call abort + if (cnt .eq. 3) then + ta = (/Z'f0ff03', Z'f0af03', Z'f0af01', Z'f0af01', Z'f0af01', Z'f0ff0f'/) + if (i .ne. Z'777f07' .or. any (ia .ne. ta)) call abort + ta = (/Z'f5a01', Z'f5a09', Z'f5a09', Z'f5a08', Z'f5f08', Z'f5f00'/) + if (j .ne. Z'fff80' .or. any (ja .ne. ta)) call abort + ta = (/Z'5a5a5', Z'5a5a5', Z'aaba2', Z'aaba2', Z'5aaaa', Z'5addd'/) + if (k .ne. Z'54a8f' .or. any (ka .ne. ta)) call abort + end if +end diff --git a/libgomp/testsuite/libgomp.fortran/reduction5.f90 b/libgomp/testsuite/libgomp.fortran/reduction5.f90 new file mode 100644 index 000000000..24c2ff612 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction5.f90 @@ -0,0 +1,43 @@ +! { dg-do run } + +module reduction5 + intrinsic ior, min, max +end module reduction5 + + call test1 + call test2 +contains + subroutine test1 + use reduction5, bitwise_or => ior + integer :: n + n = Z'f' +!$omp parallel sections num_threads (3) reduction (bitwise_or: n) + n = ior (n, Z'20') +!$omp section + n = bitwise_or (Z'410', n) +!$omp section + n = bitwise_or (n, Z'2000') +!$omp end parallel sections + if (n .ne. Z'243f') call abort + end subroutine + subroutine test2 + use reduction5, min => max, max => min + integer :: m, n + m = 8 + n = 4 +!$omp parallel sections num_threads (3) reduction (min: n) & +!$omp & reduction (max: m) + if (m .gt. 13) m = 13 + if (n .lt. 11) n = 11 +!$omp section + if (m .gt. 5) m = 5 + if (n .lt. 15) n = 15 +!$omp section + if (m .gt. 3) m = 3 + if (n .lt. -1) n = -1 +!$omp end parallel sections + if (m .ne. 3 .or. n .ne. 15) call abort + end subroutine test2 +end + +! { dg-final { cleanup-modules "reduction5" } } diff --git a/libgomp/testsuite/libgomp.fortran/reduction6.f90 b/libgomp/testsuite/libgomp.fortran/reduction6.f90 new file mode 100644 index 000000000..9f3ec6ca8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reduction6.f90 @@ -0,0 +1,32 @@ +! { dg-do run } + + integer, dimension (6, 6) :: a + character (36) :: c + integer nthreads + a = 9 + nthreads = -1 + call foo (a (2:4, 3:5), nthreads) + if (nthreads .eq. 3) then + write (c, '(36i1)') a + if (c .ne. '999999999999966699966699966699999999') call abort + end if +contains + subroutine foo (b, nthreads) + use omp_lib + integer, dimension (3:, 5:) :: b + integer :: err, nthreads + b = 0 + err = 0 +!$omp parallel num_threads (3) reduction (+:b) + if (any (b .ne. 0)) then +!$omp atomic + err = err + 1 + end if +!$omp master + nthreads = omp_get_num_threads () +!$omp end master + b = 2 +!$omp end parallel + if (err .gt. 0) call abort + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/reference1.f90 b/libgomp/testsuite/libgomp.fortran/reference1.f90 new file mode 100644 index 000000000..b959e2716 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reference1.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +!$ use omp_lib + + integer :: i, j, k + double precision :: d + i = 6 + j = 19 + k = 0 + d = 24.5 + call test (i, j, k, d) + if (i .ne. 38) call abort + if (iand (k, 255) .ne. 0) call abort + if (iand (k, 65280) .eq. 0) then + if (k .ne. 65536 * 4) call abort + end if +contains + subroutine test (i, j, k, d) + integer :: i, j, k + double precision :: d + +!$omp parallel firstprivate (d) private (j) num_threads (4) reduction (+:k) + if (i .ne. 6 .or. d .ne. 24.5 .or. k .ne. 0) k = k + 1 + if (omp_get_num_threads () .ne. 4) k = k + 256 + d = d / 2 + j = 8 + k = k + 65536 +!$omp barrier + if (d .ne. 12.25 .or. j .ne. 8) k = k + 1 +!$omp single + i = i + 32 +!$omp end single nowait +!$omp end parallel + end subroutine test +end diff --git a/libgomp/testsuite/libgomp.fortran/reference2.f90 b/libgomp/testsuite/libgomp.fortran/reference2.f90 new file mode 100644 index 000000000..1232b6926 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/reference2.f90 @@ -0,0 +1,21 @@ +! { dg-do run } + real, dimension (5) :: b + b = 5 + call foo (b) +contains + subroutine foo (a) + real, dimension (5) :: a + logical :: l + l = .false. +!$omp parallel private (a) reduction (.or.:l) + a = 15 + l = bar (a) +!$omp end parallel + if (l) call abort + end subroutine + function bar (a) + real, dimension (5) :: a + logical :: bar + bar = any (a .ne. 15) + end function +end diff --git a/libgomp/testsuite/libgomp.fortran/retval1.f90 b/libgomp/testsuite/libgomp.fortran/retval1.f90 new file mode 100644 index 000000000..8bb07f8fc --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/retval1.f90 @@ -0,0 +1,120 @@ +! { dg-do run } + +function f1 () + use omp_lib + real :: f1 + logical :: l + f1 = 6.5 + l = .false. +!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l) + l = f1 .ne. 6.5 + if (omp_get_thread_num () .eq. 0) f1 = 8.5 + if (omp_get_thread_num () .eq. 1) f1 = 14.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5) + l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5) +!$omp end parallel + if (l) call abort + f1 = -2.5 +end function f1 +function f2 () + use omp_lib + real :: f2, e2 + logical :: l +entry e2 () + f2 = 6.5 + l = .false. +!$omp parallel firstprivate (e2) num_threads (2) reduction (.or.:l) + l = e2 .ne. 6.5 + if (omp_get_thread_num () .eq. 0) e2 = 8.5 + if (omp_get_thread_num () .eq. 1) e2 = 14.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. e2 .ne. 8.5) + l = l .or. (omp_get_thread_num () .eq. 1 .and. e2 .ne. 14.5) +!$omp end parallel + if (l) call abort + e2 = 7.5 +end function f2 +function f3 () + use omp_lib + real :: f3, e3 + logical :: l +entry e3 () + f3 = 6.5 + l = .false. +!$omp parallel firstprivate (f3, e3) num_threads (2) reduction (.or.:l) + l = e3 .ne. 6.5 + l = l .or. f3 .ne. 6.5 + if (omp_get_thread_num () .eq. 0) e3 = 8.5 + if (omp_get_thread_num () .eq. 1) e3 = 14.5 + f3 = e3 - 4.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. e3 .ne. 8.5) + l = l .or. (omp_get_thread_num () .eq. 1 .and. e3 .ne. 14.5) + l = l .or. f3 .ne. e3 - 4.5 +!$omp end parallel + if (l) call abort + e3 = 0.5 +end function f3 +function f4 () result (r4) + use omp_lib + real :: r4, s4 + logical :: l +entry e4 () result (s4) + r4 = 6.5 + l = .false. +!$omp parallel firstprivate (r4, s4) num_threads (2) reduction (.or.:l) + l = s4 .ne. 6.5 + l = l .or. r4 .ne. 6.5 + if (omp_get_thread_num () .eq. 0) s4 = 8.5 + if (omp_get_thread_num () .eq. 1) s4 = 14.5 + r4 = s4 - 4.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. s4 .ne. 8.5) + l = l .or. (omp_get_thread_num () .eq. 1 .and. s4 .ne. 14.5) + l = l .or. r4 .ne. s4 - 4.5 +!$omp end parallel + if (l) call abort + s4 = -0.5 +end function f4 +function f5 (is_f5) + use omp_lib + real :: f5 + integer :: e5 + logical :: l, is_f5 +entry e5 (is_f5) + if (is_f5) then + f5 = 6.5 + else + e5 = 8 + end if + l = .false. +!$omp parallel firstprivate (f5, e5) shared (is_f5) num_threads (2) & +!$omp reduction (.or.:l) + l = .not. is_f5 .and. e5 .ne. 8 + l = l .or. (is_f5 .and. f5 .ne. 6.5) + if (omp_get_thread_num () .eq. 0) e5 = 8 + if (omp_get_thread_num () .eq. 1) e5 = 14 + f5 = e5 - 4.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. e5 .ne. 8) + l = l .or. (omp_get_thread_num () .eq. 1 .and. e5 .ne. 14) + l = l .or. f5 .ne. e5 - 4.5 +!$omp end parallel + if (l) call abort + if (is_f5) f5 = -2.5 + if (.not. is_f5) e5 = 8 +end function f5 + + real :: f1, f2, e2, f3, e3, f4, e4, f5 + integer :: e5 + if (f1 () .ne. -2.5) call abort + if (f2 () .ne. 7.5) call abort + if (e2 () .ne. 7.5) call abort + if (f3 () .ne. 0.5) call abort + if (e3 () .ne. 0.5) call abort + if (f4 () .ne. -0.5) call abort + if (e4 () .ne. -0.5) call abort + if (f5 (.true.) .ne. -2.5) call abort + if (e5 (.false.) .ne. 8) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/retval2.f90 b/libgomp/testsuite/libgomp.fortran/retval2.f90 new file mode 100644 index 000000000..92da15f58 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/retval2.f90 @@ -0,0 +1,27 @@ +! { dg-do run } + +function f1 () + real :: f1 + f1 = 6.5 + call sub1 +contains + subroutine sub1 + use omp_lib + logical :: l + l = .false. +!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l) + l = f1 .ne. 6.5 + if (omp_get_thread_num () .eq. 0) f1 = 8.5 + if (omp_get_thread_num () .eq. 1) f1 = 14.5 +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5) + l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5) +!$omp end parallel + if (l) call abort + f1 = -2.5 + end subroutine sub1 +end function f1 + + real :: f1 + if (f1 () .ne. -2.5) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/sharing1.f90 b/libgomp/testsuite/libgomp.fortran/sharing1.f90 new file mode 100644 index 000000000..063e7db83 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/sharing1.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + + use omp_lib + integer :: i, j, k + logical :: l + common /b/ i, j + i = 4 + j = 8 + l = .false. +!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) & +!$omp& reduction (.or.:l) + if (i .ne. 4 .or. j .ne. 8) l = .true. +!$omp barrier + k = omp_get_thread_num () + if (k .eq. 0) then + i = 14 + j = 15 + end if +!$omp barrier + if (k .eq. 1) then + if (i .ne. 4 .or. j .ne. 15) l = .true. + i = 24 + j = 25 + end if +!$omp barrier + if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true. +!$omp end parallel + if (l .or. j .ne. 25) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/sharing2.f90 b/libgomp/testsuite/libgomp.fortran/sharing2.f90 new file mode 100644 index 000000000..266dd46fa --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/sharing2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } + + use omp_lib + integer :: i, j, k, m, n + logical :: l + equivalence (i, m) + equivalence (j, n) + i = 4 + j = 8 + l = .false. +!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) & +!$omp& reduction (.or.:l) + l = l .or. i .ne. 4 + l = l .or. j .ne. 8 +!$omp barrier + k = omp_get_thread_num () + if (k .eq. 0) then + i = 14 + j = 15 + end if +!$omp barrier + if (k .eq. 1) then + if (i .ne. 4 .or. j .ne. 15) l = .true. + i = 24 + j = 25 + end if +!$omp barrier + if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true. +!$omp end parallel + if (l) call abort + if (j .ne. 25) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/stack.f90 b/libgomp/testsuite/libgomp.fortran/stack.f90 new file mode 100644 index 000000000..b27673d01 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/stack.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +program stack + implicit none + integer id + integer ilocs(2) + integer omp_get_thread_num, foo + call omp_set_num_threads (2) +!$omp parallel private (id) + id = omp_get_thread_num() + 1 + ilocs(id) = foo() +!$omp end parallel + ! Check that the two threads are not sharing a location for + ! the array x in foo() + if (ilocs(1) .eq. ilocs(2)) call abort +end program stack + +integer function foo () + implicit none + real x(100,100) + foo = loc(x) +end function foo diff --git a/libgomp/testsuite/libgomp.fortran/strassen.f90 b/libgomp/testsuite/libgomp.fortran/strassen.f90 new file mode 100644 index 000000000..b44982665 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/strassen.f90 @@ -0,0 +1,75 @@ +! { dg-options "-O2" } + +program strassen_matmul + use omp_lib + integer, parameter :: N = 1024 + double precision, save :: A(N,N), B(N,N), C(N,N), D(N,N) + double precision :: start, end + + call random_seed + call random_number (A) + call random_number (B) + start = omp_get_wtime () + C = matmul (A, B) + end = omp_get_wtime () + write(*,'(a, f10.6)') ' Time for matmul = ', end - start + D = 0 + start = omp_get_wtime () + call strassen (A, B, D, N) + end = omp_get_wtime () + write(*,'(a, f10.6)') ' Time for Strassen = ', end - start + if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort + D = 0 + start = omp_get_wtime () +!$omp parallel +!$omp single + call strassen (A, B, D, N) +!$omp end single nowait +!$omp end parallel + end = omp_get_wtime () + write(*,'(a, f10.6)') ' Time for Strassen MP = ', end - start + if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort + +contains + + recursive subroutine strassen (A, B, C, N) + integer, intent(in) :: N + double precision, intent(in) :: A(N,N), B(N,N) + double precision, intent(out) :: C(N,N) + double precision :: T(N/2,N/2,7) + integer :: K, L + + if (iand (N,1) .ne. 0 .or. N < 64) then + C = matmul (A, B) + return + end if + K = N / 2 + L = N / 2 + 1 +!$omp task shared (A, B, T) + call strassen (A(:K,:K) + A(L:,L:), B(:K,:K) + B(L:,L:), T(:,:,1), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(L:,:K) + A(L:,L:), B(:K,:K), T(:,:,2), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(:K,:K), B(:K,L:) - B(L:,L:), T(:,:,3), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(L:,L:), B(L:,:K) - B(:K,:K), T(:,:,4), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(:K,:K) + A(:K,L:), B(L:,L:), T(:,:,5), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(L:,:K) - A(:K,:K), B(:K,:K) + B(:K,L:), T(:,:,6), K) +!$omp end task +!$omp task shared (A, B, T) + call strassen (A(:K,L:) - A(L:,L:), B(L:,:K) + B(L:,L:), T(:,:,7), K) +!$omp end task +!$omp taskwait + C(:K,:K) = T(:,:,1) + T(:,:,4) - T(:,:,5) + T(:,:,7) + C(L:,:K) = T(:,:,2) + T(:,:,4) + C(:K,L:) = T(:,:,3) + T(:,:,5) + C(L:,L:) = T(:,:,1) - T(:,:,2) + T(:,:,3) + T(:,:,6) + end subroutine strassen +end diff --git a/libgomp/testsuite/libgomp.fortran/tabs1.f90 b/libgomp/testsuite/libgomp.fortran/tabs1.f90 new file mode 100644 index 000000000..4f3d4f5b4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/tabs1.f90 @@ -0,0 +1,12 @@ + if (b().ne.2) call abort +contains +subroutine a +!$omp parallel + !$omp end parallel + end subroutine a +function b() + integer :: b + b = 1 + !$ b = 2 +end function b + end diff --git a/libgomp/testsuite/libgomp.fortran/tabs2.f b/libgomp/testsuite/libgomp.fortran/tabs2.f new file mode 100644 index 000000000..7aed5498d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/tabs2.f @@ -0,0 +1,13 @@ +! { dg-options "-ffixed-form" } + if (b().ne.2) call abort + contains + subroutine a +!$omp parallel +!$omp end parallel + end subroutine a + function b() + integer :: b + b = 1 +!$ b = 2 + end function b + end diff --git a/libgomp/testsuite/libgomp.fortran/task1.f90 b/libgomp/testsuite/libgomp.fortran/task1.f90 new file mode 100644 index 000000000..df57cb831 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/task1.f90 @@ -0,0 +1,27 @@ +! { dg-do run } + +program tasktest + use omp_lib + integer :: i, j + common /tasktest_j/ j + j = 0 + !$omp parallel private (i) + i = omp_get_thread_num () + if (i.lt.2) then + !$omp task if (.false.) default(firstprivate) + call subr (i + 1) + !$omp end task + end if + !$omp end parallel + if (j.gt.0) call abort +contains + subroutine subr (i) + use omp_lib + integer :: i, j + common /tasktest_j/ j + if (omp_get_thread_num ().ne.(i - 1)) then + !$omp atomic + j = j + 1 + end if + end subroutine subr +end program tasktest diff --git a/libgomp/testsuite/libgomp.fortran/task2.f90 b/libgomp/testsuite/libgomp.fortran/task2.f90 new file mode 100644 index 000000000..24ffee53a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/task2.f90 @@ -0,0 +1,142 @@ + integer :: err + err = 0 +!$omp parallel num_threads (4) default (none) shared (err) +!$omp single + call test +!$omp end single +!$omp end parallel + if (err.ne.0) call abort +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) = '///|||!' +!$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) & +!$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err) + l = .false. + 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 + 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) + if (l) then +!$omp atomic + err = err + 1 + end if +!$omp end task + c = '' + d = '' + e(:, :, :) = 199 + f(:, :, :) = 198 + g(:, :) = '' + h(:, :) = '' + i(:, :, :) = 7.0 + j(:, :, :) = 8.0 + k(:, :, :) = 9 + s = '' + t(:, :, :) = 10 + u(:, :, :) = 11 + v(:, :) = '' + 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 diff --git a/libgomp/testsuite/libgomp.fortran/task3.f90 b/libgomp/testsuite/libgomp.fortran/task3.f90 new file mode 100644 index 000000000..30ff9803e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/task3.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-options "-fopenmp" } +! +! PR fortran/47886 +! +! Test case contributed by Bill Long + +! derived from OpenMP test OMP3f/F03_2_7_1d.F90 +program F03_2_7_1d + use omp_lib + implicit none + integer, parameter :: NT = 4 + integer :: sum = 0 + + call omp_set_num_threads(NT); + + !$omp parallel + !$omp task if(omp_get_num_threads() > 0) + !$omp atomic + sum = sum + 1 + !$omp end task + !$omp end parallel + if (sum /= NT) then + print *, "FAIL - sum == ", sum, " (expected ", NT, ")" + call abort + end if +end program F03_2_7_1d diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate1.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90 new file mode 100644 index 000000000..32161426b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + +module threadprivate1 + double precision :: d +!$omp threadprivate (d) +end module threadprivate1 + +!$ use omp_lib + use threadprivate1 + logical :: l + l = .false. +!$omp parallel num_threads (4) reduction (.or.:l) + d = omp_get_thread_num () + 6.5 +!$omp barrier + if (d .ne. omp_get_thread_num () + 6.5) l = .true. +!$omp end parallel + if (l) call abort () +end + +! { dg-final { cleanup-modules "threadprivate1" } } diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate2.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90 new file mode 100644 index 000000000..fb3f7ae8f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90 @@ -0,0 +1,96 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + +module threadprivate2 + integer, dimension(:,:), allocatable :: foo +!$omp threadprivate (foo) +end module threadprivate2 + + use omp_lib + use threadprivate2 + + integer, dimension(:), pointer :: bar1 + integer, dimension(2), target :: bar2 + common /thrc/ bar1, bar2 +!$omp threadprivate (/thrc/) + + integer, dimension(:), pointer, save :: bar3 => NULL() +!$omp threadprivate (bar3) + + logical :: l + type tt + integer :: a + integer :: b = 32 + end type tt + type (tt), save :: baz +!$omp threadprivate (baz) + + l = .false. + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) + +!$omp parallel num_threads (4) reduction (.or.:l) + l = allocated (foo) + allocate (foo (6 + omp_get_thread_num (), 3)) + l = l.or..not.allocated (foo) + l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ()) + foo = omp_get_thread_num () + 1 + + bar2 = omp_get_thread_num () + l = l.or.associated (bar3) + bar1 => bar2 + l = l.or..not.associated (bar1) + l = l.or..not.associated (bar1, bar2) + l = l.or.any (bar1.ne.omp_get_thread_num ()) + nullify (bar1) + l = l.or.associated (bar1) + allocate (bar3 (4)) + l = l.or..not.associated (bar3) + bar3 = omp_get_thread_num () - 2 + + l = l.or.(baz%b.ne.32) + baz%a = omp_get_thread_num () * 2 + baz%b = omp_get_thread_num () * 2 + 1 +!$omp end parallel + + if (l) call abort + if (.not.allocated (foo)) call abort + if (size (foo).ne.18) call abort + if (any (foo.ne.1)) call abort + + if (associated (bar1)) call abort + if (.not.associated (bar3)) call abort + if (any (bar3 .ne. -2)) call abort + deallocate (bar3) + if (associated (bar3)) call abort + +!$omp parallel num_threads (4) reduction (.or.:l) + l = l.or..not.allocated (foo) + l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ()) + l = l.or.any (foo.ne.(omp_get_thread_num () + 1)) + if (omp_get_thread_num () .ne. 0) then + deallocate (foo) + l = l.or.allocated (foo) + end if + + l = l.or.associated (bar1) + if (omp_get_thread_num () .ne. 0) then + l = l.or..not.associated (bar3) + l = l.or.any (bar3 .ne. omp_get_thread_num () - 2) + deallocate (bar3) + end if + l = l.or.associated (bar3) + + l = l.or.(baz%a.ne.(omp_get_thread_num () * 2)) + l = l.or.(baz%b.ne.(omp_get_thread_num () * 2 + 1)) +!$omp end parallel + + if (l) call abort + if (.not.allocated (foo)) call abort + if (size (foo).ne.18) call abort + if (any (foo.ne.1)) call abort + deallocate (foo) + if (allocated (foo)) call abort +end + +! { dg-final { cleanup-modules "threadprivate2" } } diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate3.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90 new file mode 100644 index 000000000..7edfbf680 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90 @@ -0,0 +1,108 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + +module threadprivate3 + integer, dimension(:,:), pointer :: foo => NULL() +!$omp threadprivate (foo) +end module threadprivate3 + + use omp_lib + use threadprivate3 + + integer, dimension(:), pointer :: bar1 + integer, dimension(2), target :: bar2, var + common /thrc/ bar1, bar2 +!$omp threadprivate (/thrc/) + + integer, dimension(:), pointer, save :: bar3 => NULL() +!$omp threadprivate (bar3) + + logical :: l + type tt + integer :: a + integer :: b = 32 + end type tt + type (tt), save :: baz +!$omp threadprivate (baz) + + l = .false. + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) + var = 6 + +!$omp parallel num_threads (4) reduction (.or.:l) + bar2 = omp_get_thread_num () + l = associated (bar3) + bar1 => bar2 + l = l.or..not.associated (bar1) + l = l.or..not.associated (bar1, bar2) + l = l.or.any (bar1.ne.omp_get_thread_num ()) + nullify (bar1) + l = l.or.associated (bar1) + allocate (bar3 (4)) + l = l.or..not.associated (bar3) + bar3 = omp_get_thread_num () - 2 + if (omp_get_thread_num () .ne. 0) then + deallocate (bar3) + if (associated (bar3)) call abort + else + bar1 => var + end if + bar2 = omp_get_thread_num () * 6 + 130 + + l = l.or.(baz%b.ne.32) + baz%a = omp_get_thread_num () * 2 + baz%b = omp_get_thread_num () * 2 + 1 +!$omp end parallel + + if (l) call abort + if (.not.associated (bar1)) call abort + if (any (bar1.ne.6)) call abort + if (.not.associated (bar3)) call abort + if (any (bar3 .ne. -2)) call abort + deallocate (bar3) + if (associated (bar3)) call abort + + allocate (bar3 (10)) + bar3 = 17 + +!$omp parallel copyin (bar1, bar2, bar3, baz) num_threads (4) & +!$omp& reduction (.or.:l) + l = l.or..not.associated (bar1) + l = l.or.any (bar1.ne.6) + l = l.or.any (bar2.ne.130) + l = l.or..not.associated (bar3) + l = l.or.size (bar3).ne.10 + l = l.or.any (bar3.ne.17) + allocate (bar1 (4)) + bar1 = omp_get_thread_num () + bar2 = omp_get_thread_num () + 8 + + l = l.or.(baz%a.ne.0) + l = l.or.(baz%b.ne.1) + baz%a = omp_get_thread_num () * 3 + 4 + baz%b = omp_get_thread_num () * 3 + 5 + +!$omp barrier + if (omp_get_thread_num () .eq. 0) then + deallocate (bar3) + end if + bar3 => bar2 +!$omp barrier + + l = l.or..not.associated (bar1) + l = l.or..not.associated (bar3) + l = l.or.any (bar1.ne.omp_get_thread_num ()) + l = l.or.size (bar1).ne.4 + l = l.or.any (bar2.ne.omp_get_thread_num () + 8) + l = l.or.any (bar3.ne.omp_get_thread_num () + 8) + l = l.or.size (bar3).ne.2 + + l = l.or.(baz%a .ne. omp_get_thread_num () * 3 + 4) + l = l.or.(baz%b .ne. omp_get_thread_num () * 3 + 5) +!$omp end parallel + + if (l) call abort +end + +! { dg-final { cleanup-modules "threadprivate3" } } diff --git a/libgomp/testsuite/libgomp.fortran/vla1.f90 b/libgomp/testsuite/libgomp.fortran/vla1.f90 new file mode 100644 index 000000000..c22165ee0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla1.f90 @@ -0,0 +1,185 @@ +! { 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 diff --git a/libgomp/testsuite/libgomp.fortran/vla2.f90 b/libgomp/testsuite/libgomp.fortran/vla2.f90 new file mode 100644 index 000000000..a9510fd38 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla2.f90 @@ -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 diff --git a/libgomp/testsuite/libgomp.fortran/vla3.f90 b/libgomp/testsuite/libgomp.fortran/vla3.f90 new file mode 100644 index 000000000..bfafc4f7d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla3.f90 @@ -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 diff --git a/libgomp/testsuite/libgomp.fortran/vla4.f90 b/libgomp/testsuite/libgomp.fortran/vla4.f90 new file mode 100644 index 000000000..cdd4849b6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla4.f90 @@ -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 ! { dg-warning "may not be closely nested" } + 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 diff --git a/libgomp/testsuite/libgomp.fortran/vla5.f90 b/libgomp/testsuite/libgomp.fortran/vla5.f90 new file mode 100644 index 000000000..9b6115052 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla5.f90 @@ -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 ! { dg-warning "may not be closely nested" } + 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 diff --git a/libgomp/testsuite/libgomp.fortran/vla6.f90 b/libgomp/testsuite/libgomp.fortran/vla6.f90 new file mode 100644 index 000000000..bb9c4916d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla6.f90 @@ -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 diff --git a/libgomp/testsuite/libgomp.fortran/vla7.f90 b/libgomp/testsuite/libgomp.fortran/vla7.f90 new file mode 100644 index 000000000..29a669644 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla7.f90 @@ -0,0 +1,143 @@ +! { dg-do run } +! { dg-options "-w" } + + character (6) :: c, f2 + character (6) :: d(2) + c = f1 (6) + if (c .ne. 'opqrst') call abort + c = f2 (6) + if (c .ne. '_/!!/_') call abort + d = f3 (6) + if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort + d = f4 (6) + if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort +contains + function f1 (n) + use omp_lib + character (n) :: f1 + logical :: l + f1 = 'abcdef' + l = .false. +!$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2) + l = f1 .ne. 'abcdef' + if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn' + if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN' +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn') + l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN') +!$omp end parallel + f1 = 'zZzz_z' +!$omp parallel shared (f1) reduction (.or.:l) num_threads (2) + l = l .or. f1 .ne. 'zZzz_z' +!$omp barrier +!$omp master + f1 = 'abc' +!$omp end master +!$omp barrier + l = l .or. f1 .ne. 'abc' +!$omp barrier + if (omp_get_thread_num () .eq. 1) f1 = 'def' +!$omp barrier + l = l .or. f1 .ne. 'def' +!$omp end parallel + if (l) call abort + f1 = 'opqrst' + end function f1 + function f3 (n) + use omp_lib + character (n), dimension (2) :: f3 + logical :: l + f3 = 'abcdef' + l = .false. +!$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2) + l = any (f3 .ne. 'abcdef') + if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn' + if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN' +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn')) + l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN')) +!$omp end parallel + f3 = 'zZzz_z' +!$omp parallel shared (f3) reduction (.or.:l) num_threads (2) + l = l .or. any (f3 .ne. 'zZzz_z') +!$omp barrier +!$omp master + f3 = 'abc' +!$omp end master +!$omp barrier + l = l .or. any (f3 .ne. 'abc') +!$omp barrier + if (omp_get_thread_num () .eq. 1) f3 = 'def' +!$omp barrier + l = l .or. any (f3 .ne. 'def') +!$omp end parallel + if (l) call abort + f3(1) = 'opqrst' + f3(2) = 'a' + end function f3 + function f4 (n) + use omp_lib + character (n), dimension (n - 4) :: f4 + logical :: l + f4 = 'abcdef' + l = .false. +!$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2) + l = any (f4 .ne. 'abcdef') + if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn' + if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN' +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn')) + l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN')) + l = l .or. size (f4) .ne. 2 +!$omp end parallel + f4 = 'zZzz_z' +!$omp parallel shared (f4) reduction (.or.:l) num_threads (2) + l = l .or. any (f4 .ne. 'zZzz_z') +!$omp barrier +!$omp master + f4 = 'abc' +!$omp end master +!$omp barrier + l = l .or. any (f4 .ne. 'abc') +!$omp barrier + if (omp_get_thread_num () .eq. 1) f4 = 'def' +!$omp barrier + l = l .or. any (f4 .ne. 'def') + l = l .or. size (f4) .ne. 2 +!$omp end parallel + if (l) call abort + f4(1) = 'Opqrst' + f4(2) = 'A' + end function f4 +end +function f2 (n) + use omp_lib + character (*) :: f2 + logical :: l + f2 = 'abcdef' + l = .false. +!$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2) + l = f2 .ne. 'abcdef' + if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn' + if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN' +!$omp barrier + l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn') + l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN') +!$omp end parallel + f2 = 'zZzz_z' +!$omp parallel shared (f2) reduction (.or.:l) num_threads (2) + l = l .or. f2 .ne. 'zZzz_z' +!$omp barrier +!$omp master + f2 = 'abc' +!$omp end master +!$omp barrier + l = l .or. f2 .ne. 'abc' +!$omp barrier + if (omp_get_thread_num () .eq. 1) f2 = 'def' +!$omp barrier + l = l .or. f2 .ne. 'def' +!$omp end parallel + if (l) call abort + f2 = '_/!!/_' +end function f2 diff --git a/libgomp/testsuite/libgomp.fortran/vla8.f90 b/libgomp/testsuite/libgomp.fortran/vla8.f90 new file mode 100644 index 000000000..b06a6f4be --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/vla8.f90 @@ -0,0 +1,255 @@ +! { dg-do run } +! { dg-timeout-factor 2.0 } + + 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 + 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 123, p = 1, 2 + do 123, q = 3, 7 + do 123, 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) +123 continue + do 124, p = 3, 5 + do 124, q = 2, 6 + do 124, 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 +124 continue + do 125, p = 1, 5 + do 125, q = 4, 6 + l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q +125 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 diff --git a/libgomp/testsuite/libgomp.fortran/workshare1.f90 b/libgomp/testsuite/libgomp.fortran/workshare1.f90 new file mode 100644 index 000000000..a0e6ff919 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/workshare1.f90 @@ -0,0 +1,30 @@ +function foo () + integer :: foo + logical :: foo_seen + common /foo_seen/ foo_seen + foo_seen = .true. + foo = 3 +end +function bar () + integer :: bar + logical :: bar_seen + common /bar_seen/ bar_seen + bar_seen = .true. + bar = 3 +end + integer :: a (10), b (10), foo, bar + logical :: foo_seen, bar_seen + common /foo_seen/ foo_seen + common /bar_seen/ bar_seen + + foo_seen = .false. + bar_seen = .false. +!$omp parallel workshare if (foo () .gt. 2) num_threads (bar () + 1) + a = 10 + b = 20 + a(1:5) = max (a(1:5), b(1:5)) +!$omp end parallel workshare + if (any (a(1:5) .ne. 20)) call abort + if (any (a(6:10) .ne. 10)) call abort + if (.not. foo_seen .or. .not. bar_seen) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/workshare2.f90 b/libgomp/testsuite/libgomp.fortran/workshare2.f90 new file mode 100644 index 000000000..1b749a6cf --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/workshare2.f90 @@ -0,0 +1,37 @@ +subroutine f1 + integer a(20:50,70:90) +!$omp parallel workshare + a(:,:) = 17 +!$omp end parallel workshare + if (any (a.ne.17)) call abort +end subroutine f1 +subroutine f2 + integer a(20:50,70:90),d(15),e(15),f(15) + integer b, c, i +!$omp parallel workshare + c = 5 + a(:,:) = 17 + b = 4 + d = (/ 0, 1, 2, 3, 4, 0, 6, 7, 8, 9, 10, 0, 0, 13, 14 /) + forall (i=1:15, d(i) /= 0) + d(i) = 0 + end forall + e = (/ 4, 5, 2, 6, 4, 5, 2, 6, 4, 5, 2, 6, 4, 5, 2 /) + f = 7 + where (e.ge.5) f = f + 1 +!$omp end parallel workshare + if (any (a.ne.17)) call abort + if (c.ne.5.or.b.ne.4) call abort + if (any(d.ne.0)) call abort + do i = 1, 15 + if (e(i).ge.5) then + if (f(i).ne.8) call abort + else + if (f(i).ne.7) call abort + end if + end do +end subroutine f2 + + call f1 + call f2 +end |