1! RUN: %S/test_errors.sh %s %t %flang -fopenmp
2! REQUIRES: shell
3! OpenMP Version 4.5
4! Various checks with the ordered construct
5
6SUBROUTINE WORK(I)
7  INTEGER I
8END SUBROUTINE WORK
9
10SUBROUTINE ORDERED_GOOD(N)
11  INTEGER N, I, A(10), B(10), C(10)
12  !$OMP SIMD
13  DO I = 1,N
14    IF (I <= 10) THEN
15      !$OMP ORDERED SIMD
16      CALL WORK(I)
17      !$OMP END ORDERED
18    ENDIF
19  END DO
20  !$OMP END SIMD
21END SUBROUTINE ORDERED_GOOD
22
23SUBROUTINE ORDERED_BAD(N)
24  INTEGER N, I, A(10), B(10), C(10)
25
26  !$OMP DO SIMD
27  DO I = 1,N
28    IF (I <= 10) THEN
29      !ERROR: The only OpenMP constructs that can be encountered during execution of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, the `SIMD` construct and the `ORDERED` construct with the `SIMD` clause.
30      !ERROR: The ORDERED clause must be present on the loop construct if any ORDERED region ever binds to a loop region arising from the loop construct.
31      !$OMP ORDERED
32      CALL WORK(I)
33      !$OMP END ORDERED
34    ENDIF
35  END DO
36  !$OMP END DO SIMD
37
38  !$OMP PARALLEL DO
39  DO I = 1,N
40    IF (I <= 10) THEN
41      !ERROR: The ORDERED clause must be present on the loop construct if any ORDERED region ever binds to a loop region arising from the loop construct.
42      !$OMP ORDERED
43      CALL WORK(I)
44      !$OMP END ORDERED
45    ENDIF
46  END DO
47  !$OMP END PARALLEL DO
48
49  !$OMP CRITICAL
50  DO I = 1,N
51    IF (I <= 10) THEN
52      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
53      !$OMP ORDERED
54      CALL WORK(I)
55      !$OMP END ORDERED
56    ENDIF
57  END DO
58  !$OMP END CRITICAL
59
60  !$OMP CRITICAL
61    WRITE(*,*) I
62    !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
63    !$OMP ORDERED
64    CALL WORK(I)
65    !$OMP END ORDERED
66  !$OMP END CRITICAL
67
68  !$OMP ORDERED
69    WRITE(*,*) I
70    IF (I <= 10) THEN
71      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
72      !$OMP ORDERED
73      CALL WORK(I)
74      !$OMP END ORDERED
75    ENDIF
76  !$OMP END ORDERED
77
78  !$OMP TASK
79    C =  C - A * B
80    !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
81    !$OMP ORDERED
82    CALL WORK(I)
83    !$OMP END ORDERED
84  !$OMP END TASK
85
86  !$OMP TASKLOOP
87  DO I = 1,N
88    IF (I <= 10) THEN
89      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
90      !$OMP ORDERED
91      CALL WORK(I)
92      !$OMP END ORDERED
93    ENDIF
94  END DO
95  !$OMP END TASKLOOP
96
97  !$OMP CRITICAL
98    C =  C - A * B
99    !$OMP MASTER
100    DO I = 1,N
101      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
102      !$OMP ORDERED
103      CALL WORK(I)
104      !$OMP END ORDERED
105    END DO
106    !$OMP END MASTER
107  !$OMP END CRITICAL
108
109  !$OMP ORDERED
110    C =  C - A * B
111    !$OMP MASTER
112    DO I = 1,N
113      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
114      !$OMP ORDERED
115      CALL WORK(I)
116      !$OMP END ORDERED
117    END DO
118    !$OMP END MASTER
119  !$OMP END ORDERED
120
121  !$OMP TASK
122    C =  C - A * B
123    !ERROR: `MASTER` region may not be closely nested inside of `WORKSHARING`, `LOOP`, `TASK`, `TASKLOOP`, or `ATOMIC` region.
124    !$OMP MASTER
125    DO I = 1,N
126      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
127      !$OMP ORDERED
128      CALL WORK(I)
129      !$OMP END ORDERED
130    END DO
131    !$OMP END MASTER
132  !$OMP END TASK
133
134  !$OMP TASKLOOP
135  DO J= 1,N
136    C =  C - A * B
137    !ERROR: `MASTER` region may not be closely nested inside of `WORKSHARING`, `LOOP`, `TASK`, `TASKLOOP`, or `ATOMIC` region.
138    !$OMP MASTER
139    DO I = 1,N
140      !ERROR: `ORDERED` region may not be closely nested inside of `CRITICAL`, `ORDERED`, explicit `TASK` or `TASKLOOP` region.
141      !$OMP ORDERED
142      CALL WORK(I)
143      !$OMP END ORDERED
144    END DO
145    !$OMP END MASTER
146  END DO
147  !$OMP END TASKLOOP
148
149END SUBROUTINE ORDERED_BAD
150