OpenCores
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-src/gcc-4.5.1/gcc-4.5.1-or32-1.0rc4/libgomp/testsuite/libgomp.fortran/appendix-a
    from Rev 273 to Rev 519
    ↔ Reverse comparison
  •

Rev 273 → Rev 519

/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.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.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.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.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.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.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.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.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.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.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.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.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.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,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
/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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.