summaryrefslogtreecommitdiff
path: root/libgomp/testsuite/libgomp.fortran/appendix-a
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /libgomp/testsuite/libgomp.fortran/appendix-a
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.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/appendix-a')
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f9031
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f9041
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f9059
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f9060
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f9022
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f9019
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f9033
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f9026
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f9011
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f9014
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f9016
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f9011
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f9034
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f906
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f9014
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f9016
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f9010
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f9012
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f9026
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f9029
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f9054
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f908
-rw-r--r--libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f9020
24 files changed, 596 insertions, 0 deletions
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