URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/tags/gnu-dev/fsf-gcc-snapshot-1-mar-12/or1k-gcc/libgomp/testsuite/libgomp.fortran/appendix-a
- from Rev 735 to Rev 783
- ↔ Reverse comparison
Rev 735 → Rev 783
/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 |
/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 |
/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" } } |
/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 |
/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" } } |
/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 |
/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 |
/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 |
/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" } } |
/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 |
/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 |
/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 |
/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 |
/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 |
/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 |
/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" } } |
/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 |
/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 |
/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 |
/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 |
/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 |
/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 |
/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 |
/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 |