xref: /llvm-project/flang/test/Semantics/dosemantics03.f90 (revision 502e7690c3c9698a6982a490f6bf92b0fd24d10f)
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2!
3! C1120 -- DO variable (and associated expressions) must be INTEGER.
4! This is extended by allowing REAL and DOUBLE PRECISION
5!
6! The standard requires the DO variable and the initial, final, and step
7! expressions to be INTEGER. As an extension, we do however allow them to be
8! REAL or DOUBLE PRECISION. This test turns on the option for standard
9! conformance checking to test that we get portability warnings for these
10! cases. We also check that other types, such as CHARACTER and LOGICAL, yield
11! errors when used in the DO controls.
12
13MODULE share
14  INTEGER :: intvarshare
15  REAL :: realvarshare
16  DOUBLE PRECISION :: dpvarshare
17END MODULE share
18
19PROGRAM do_issue_458
20  USE share
21  IMPLICIT NONE
22  INTEGER :: ivar
23  REAL :: rvar
24  DOUBLE PRECISION :: dvar
25  LOGICAL :: lvar
26  COMPLEX :: cvar
27  CHARACTER :: chvar
28  INTEGER, DIMENSION(3) :: avar
29  TYPE derived
30    REAL :: first
31    INTEGER :: second
32  END TYPE derived
33  TYPE(derived) :: devar
34  INTEGER, POINTER :: pivar
35  REAL, POINTER :: prvar
36  DOUBLE PRECISION, POINTER :: pdvar
37  LOGICAL, POINTER :: plvar
38  INTERFACE
39    SUBROUTINE sub()
40    END SUBROUTINE sub
41    FUNCTION ifunc()
42    END FUNCTION ifunc
43  END INTERFACE
44  PROCEDURE(ifunc), POINTER :: pifunc => NULL()
45
46! DO variables
47! INTEGER DO variable
48  DO ivar = 1, 10, 3
49    PRINT *, "ivar is: ", ivar
50  END DO
51
52! REAL DO variable
53!PORTABILITY: DO controls should be INTEGER
54  DO rvar = 1, 10, 3
55    PRINT *, "rvar is: ", rvar
56  END DO
57
58! DOUBLE PRECISISON DO variable
59!PORTABILITY: DO controls should be INTEGER
60  DO dvar = 1, 10, 3
61    PRINT *, "dvar is: ", dvar
62  END DO
63
64! Pointer to INTEGER DO variable
65  ALLOCATE(pivar)
66  DO pivar = 1, 10, 3
67    PRINT *, "pivar is: ", pivar
68  END DO
69
70! Pointer to REAL DO variable
71  ALLOCATE(prvar)
72!PORTABILITY: DO controls should be INTEGER
73  DO prvar = 1, 10, 3
74    PRINT *, "prvar is: ", prvar
75  END DO
76
77! Pointer to DOUBLE PRECISION DO variable
78  ALLOCATE(pdvar)
79!PORTABILITY: DO controls should be INTEGER
80  DO pdvar = 1, 10, 3
81    PRINT *, "pdvar is: ", pdvar
82  END DO
83
84! CHARACTER DO variable
85!ERROR: DO controls should be INTEGER
86  DO chvar = 1, 10, 3
87    PRINT *, "chvar is: ", chvar
88  END DO
89
90! LOGICAL DO variable
91!ERROR: DO controls should be INTEGER
92  DO lvar = 1, 10, 3
93    PRINT *, "lvar is: ", lvar
94  END DO
95
96! COMPLEX DO variable
97!ERROR: DO controls should be INTEGER
98  DO cvar = 1, 10, 3
99    PRINT *, "cvar is: ", cvar
100  END DO
101
102! Derived type DO variable
103!ERROR: DO controls should be INTEGER
104  DO devar = 1, 10, 3
105    PRINT *, "devar is: ", devar
106  END DO
107
108! Pointer to LOGICAL DO variable
109  ALLOCATE(plvar)
110!ERROR: DO controls should be INTEGER
111  DO plvar = 1, 10, 3
112    PRINT *, "plvar is: ", plvar
113  END DO
114
115! SUBROUTINE DO variable
116!ERROR: DO control must be an INTEGER variable
117  DO sub = 1, 10, 3
118    PRINT *, "ivar is: ", ivar
119  END DO
120
121! FUNCTION DO variable
122!ERROR: DO control must be an INTEGER variable
123  DO ifunc = 1, 10, 3
124    PRINT *, "ivar is: ", ivar
125  END DO
126
127! POINTER to FUNCTION DO variable
128!ERROR: DO control must be an INTEGER variable
129  DO pifunc = 1, 10, 3
130    PRINT *, "ivar is: ", ivar
131  END DO
132
133! Array DO variable
134!ERROR: Must be a scalar value, but is a rank-1 array
135  DO avar = 1, 10, 3
136    PRINT *, "plvar is: ", plvar
137  END DO
138
139! Undeclared DO variable
140!ERROR: No explicit type declared for 'undeclared'
141  DO undeclared = 1, 10, 3
142    PRINT *, "plvar is: ", plvar
143  END DO
144
145! Shared association INTEGER DO variable
146  DO intvarshare = 1, 10, 3
147    PRINT *, "ivar is: ", ivar
148  END DO
149
150! Shared association REAL DO variable
151!PORTABILITY: DO controls should be INTEGER
152  DO realvarshare = 1, 10, 3
153    PRINT *, "ivar is: ", ivar
154  END DO
155
156! Shared association DOUBLE PRECISION DO variable
157!PORTABILITY: DO controls should be INTEGER
158  DO dpvarshare = 1, 10, 3
159    PRINT *, "ivar is: ", ivar
160  END DO
161
162! Initial expressions
163! REAL initial expression
164!PORTABILITY: DO controls should be INTEGER
165  DO ivar = rvar, 10, 3
166    PRINT *, "ivar is: ", ivar
167  END DO
168
169! DOUBLE PRECISION initial expression
170!PORTABILITY: DO controls should be INTEGER
171  DO ivar = dvar, 10, 3
172    PRINT *, "ivar is: ", ivar
173  END DO
174
175! Pointer to INTEGER initial expression
176  DO ivar = pivar, 10, 3
177    PRINT *, "ivar is: ", ivar
178  END DO
179
180! Pointer to REAL initial expression
181!PORTABILITY: DO controls should be INTEGER
182  DO ivar = prvar, 10, 3
183    PRINT *, "ivar is: ", ivar
184  END DO
185
186! Pointer to DOUBLE PRECISION initial expression
187!PORTABILITY: DO controls should be INTEGER
188  DO ivar = pdvar, 10, 3
189    PRINT *, "ivar is: ", ivar
190  END DO
191
192! LOGICAL initial expression
193!ERROR: DO controls should be INTEGER
194  DO ivar = lvar, 10, 3
195    PRINT *, "ivar is: ", ivar
196  END DO
197
198! COMPLEX initial expression
199!ERROR: DO controls should be INTEGER
200  DO ivar = cvar, 10, 3
201    PRINT *, "ivar is: ", ivar
202  END DO
203
204! Derived type initial expression
205!ERROR: DO controls should be INTEGER
206  DO ivar = devar, 10, 3
207    PRINT *, "ivar is: ", ivar
208  END DO
209
210! Pointer to LOGICAL initial expression
211!ERROR: DO controls should be INTEGER
212  DO ivar = plvar, 10, 3
213    PRINT *, "ivar is: ", ivar
214  END DO
215
216! Invalid initial expression
217!ERROR: Integer literal is too large for INTEGER(KIND=4)
218  DO ivar = -2147483649_4, 10, 3
219    PRINT *, "ivar is: ", ivar
220  END DO
221
222! Final expression
223! REAL final expression
224!PORTABILITY: DO controls should be INTEGER
225  DO ivar = 1, rvar, 3
226    PRINT *, "ivar is: ", ivar
227  END DO
228
229! DOUBLE PRECISION final expression
230!PORTABILITY: DO controls should be INTEGER
231  DO ivar = 1, dvar, 3
232    PRINT *, "ivar is: ", ivar
233  END DO
234
235! Pointer to INTEGER final expression
236  DO ivar = 1, pivar, 3
237    PRINT *, "ivar is: ", ivar
238  END DO
239
240! Pointer to REAL final expression
241!PORTABILITY: DO controls should be INTEGER
242  DO ivar = 1, prvar, 3
243    PRINT *, "ivar is: ", ivar
244  END DO
245
246! Pointer to DOUBLE PRECISION final expression
247!PORTABILITY: DO controls should be INTEGER
248  DO ivar = pdvar, 10, 3
249    PRINT *, "ivar is: ", ivar
250  END DO
251
252! COMPLEX final expression
253!ERROR: DO controls should be INTEGER
254  DO ivar = 1, cvar, 3
255    PRINT *, "ivar is: ", ivar
256  END DO
257
258! Invalid final expression
259!ERROR: Integer literal is too large for INTEGER(KIND=4)
260  DO ivar = 1, -2147483649_4, 3
261    PRINT *, "ivar is: ", ivar
262  END DO
263
264! Step expression
265! REAL step expression
266!PORTABILITY: DO controls should be INTEGER
267  DO ivar = 1, 10, rvar
268    PRINT *, "ivar is: ", ivar
269  END DO
270
271! DOUBLE PRECISION step expression
272!PORTABILITY: DO controls should be INTEGER
273  DO ivar = 1, 10, dvar
274    PRINT *, "ivar is: ", ivar
275  END DO
276
277! Pointer to INTEGER step expression
278  DO ivar = 1, 10, pivar
279    PRINT *, "ivar is: ", ivar
280  END DO
281
282! Pointer to REAL step expression
283!PORTABILITY: DO controls should be INTEGER
284  DO ivar = 1, 10, prvar
285    PRINT *, "ivar is: ", ivar
286  END DO
287
288! Pointer to DOUBLE PRECISION step expression
289!PORTABILITY: DO controls should be INTEGER
290  DO ivar = 1, 10, pdvar
291    PRINT *, "ivar is: ", ivar
292  END DO
293
294! COMPLEX Step expression
295!ERROR: DO controls should be INTEGER
296  DO ivar = 1, 10, cvar
297    PRINT *, "ivar is: ", ivar
298  END DO
299
300! Invalid step expression
301!ERROR: Integer literal is too large for INTEGER(KIND=4)
302  DO ivar = 1, 10, -2147483649_4
303    PRINT *, "ivar is: ", ivar
304  END DO
305
306END PROGRAM do_issue_458
307