xref: /openbsd-src/gnu/gcc/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 (revision 404b540a9034ac75a6199ad1a32d1bbc7a0d4210)
1*404b540aSrobert! { dg-do run }
2*404b540aSrobert        SUBROUTINE F1(Q)
3*404b540aSrobert        COMMON /DATA/ P, X
4*404b540aSrobert        INTEGER, TARGET :: X
5*404b540aSrobert        INTEGER, POINTER :: P
6*404b540aSrobert        INTEGER Q
7*404b540aSrobert        Q=1
8*404b540aSrobert!$OMP FLUSH
9*404b540aSrobert        ! X, P and Q are flushed
10*404b540aSrobert        ! because they are shared and accessible
11*404b540aSrobert      END SUBROUTINE F1
12*404b540aSrobert      SUBROUTINE F2(Q)
13*404b540aSrobert        COMMON /DATA/ P, X
14*404b540aSrobert        INTEGER, TARGET :: X
15*404b540aSrobert        INTEGER, POINTER :: P
16*404b540aSrobert        INTEGER Q
17*404b540aSrobert!$OMP BARRIER
18*404b540aSrobert          Q=2
19*404b540aSrobert!$OMP BARRIER
20*404b540aSrobert          ! a barrier implies a flush
21*404b540aSrobert          ! X, P and Q are flushed
22*404b540aSrobert          ! because they are shared and accessible
23*404b540aSrobert        END SUBROUTINE F2
24*404b540aSrobert
25*404b540aSrobert      INTEGER FUNCTION G(N)
26*404b540aSrobert          COMMON /DATA/ P, X
27*404b540aSrobert          INTEGER, TARGET :: X
28*404b540aSrobert          INTEGER, POINTER :: P
29*404b540aSrobert          INTEGER N
30*404b540aSrobert          INTEGER I, J, SUM
31*404b540aSrobert          I=1
32*404b540aSrobert          SUM = 0
33*404b540aSrobert          P=1
34*404b540aSrobert!$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2)
35*404b540aSrobert          CALL F1(J)
36*404b540aSrobert                ! I, N and SUM were not flushed
37*404b540aSrobert                !   because they were not accessible in F1
38*404b540aSrobert                ! J was flushed because it was accessible
39*404b540aSrobert          SUM = SUM + J
40*404b540aSrobert          CALL F2(J)
41*404b540aSrobert                ! I, N, and SUM were not flushed
42*404b540aSrobert                ! because they were not accessible in f2
43*404b540aSrobert                ! J was flushed because it was accessible
44*404b540aSrobert          SUM = SUM + I + J + P + N
45*404b540aSrobert!$OMP END PARALLEL
46*404b540aSrobert          G = SUM
47*404b540aSrobert      END FUNCTION G
48*404b540aSrobert
49*404b540aSrobert      PROGRAM A19
50*404b540aSrobert        COMMON /DATA/ P, X
51*404b540aSrobert        INTEGER, TARGET :: X
52*404b540aSrobert        INTEGER, POINTER :: P
53*404b540aSrobert        INTEGER RESULT, G
54*404b540aSrobert        P => X
55*404b540aSrobert        RESULT = G(10)
56*404b540aSrobert        PRINT *, RESULT
57*404b540aSrobert        IF (RESULT .NE. 30) THEN
58*404b540aSrobert          CALL ABORT
59*404b540aSrobert        ENDIF
60*404b540aSrobert      END PROGRAM A19
61