diff options
Diffstat (limited to 'gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a')
24 files changed, 591 insertions, 0 deletions
diff --git a/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 new file mode 100644 index 000000000..3d95451ea --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 new file mode 100644 index 000000000..014d4fd5a --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 new file mode 100644 index 000000000..3321485ef --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 new file mode 100644 index 000000000..1fe1c4247 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 new file mode 100644 index 000000000..2b09f5b1f --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 new file mode 100644 index 000000000..c22fa1169 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 new file mode 100644 index 000000000..fff4e6d49 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 new file mode 100644 index 000000000..18c812ac4 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 new file mode 100644 index 000000000..e9ebf87af --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 new file mode 100644 index 000000000..c271333a8 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 new file mode 100644 index 000000000..1145e5410 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 new file mode 100644 index 000000000..a337f3bc7 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 new file mode 100644 index 000000000..c5a5cd74c --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 new file mode 100644 index 000000000..e3775822f --- /dev/null +++ b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } + + 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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 new file mode 100644 index 000000000..0a1757272 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 new file mode 100644 index 000000000..c03ba2adf --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 new file mode 100644 index 000000000..d81849528 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 new file mode 100644 index 000000000..adc493fcf --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 new file mode 100644 index 000000000..55541303c --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 new file mode 100644 index 000000000..540d17f5b --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 new file mode 100644 index 000000000..3c2a74a4f --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 new file mode 100644 index 000000000..c5ecb3c3e --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 new file mode 100644 index 000000000..13e451e50 --- /dev/null +++ b/gcc-4.4.3/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/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 b/gcc-4.4.3/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 new file mode 100644 index 000000000..c1564bf4b --- /dev/null +++ b/gcc-4.4.3/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 |