1! PR 101334
2! PR 101337
3! { dg-do compile}
4! { dg-additional-options "-fcoarray=single" }
5!
6! TS 29113
7! C535b An assumed-rank variable name shall not appear in a designator
8! or expression except as an actual argument corresponding to a dummy
9! argument that is assumed-rank, the argument of the C_LOC function
10! in the ISO_C_BINDING intrinsic module, or the first argument in a
11! reference to an intrinsic inquiry function.
12!
13! This has been renamed C838 in the Fortran 2018 standard, with C_SIZEOF
14! and SELECT_RANK additionally added.
15!
16! This test file contains tests that are expected to issue diagnostics
17! for invalid code.
18
19! Check that passing an assumed-rank variable as an actual argument
20! corresponding to a non-assumed-rank dummy gives a diagnostic.
21
22module m
23  interface
24    subroutine f (a, b)
25      implicit none
26      integer :: a
27      integer :: b
28    end subroutine
29    subroutine g (a, b)
30      implicit none
31      integer :: a(..)
32      integer :: b(..)
33    end subroutine
34    subroutine h (a, b)
35      implicit none
36      integer :: a(*)
37      integer :: b(*)
38    end subroutine
39    subroutine i (a, b)
40      implicit none
41      integer :: a(:)
42      integer :: b(:)
43    end subroutine
44    subroutine j (a, b)
45      implicit none
46      integer :: a(3,3)
47      integer :: b(3,3)
48    end subroutine
49  end interface
50end module
51
52subroutine test_calls (x, y)
53  use m
54  implicit none
55  integer :: x(..), y(..)
56
57  ! Make sure each invalid argument produces a diagnostic.
58  ! scalar dummies
59  call f (x, &  ! { dg-error "(A|a)ssumed.rank" }
60          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
61  ! assumed-rank dummies
62  call g (x, y)  ! OK
63  ! assumed-size dummies
64  call h (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" }
65          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
66  ! assumed-shape dummies
67  call i (x, &  ! { dg-error "(A|a)ssumed.rank" }
68          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
69 ! fixed-size array dummies
70  call j (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" }
71          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
72end subroutine
73
74! Check that you can't use an assumed-rank array variable in an array
75! element or section designator.
76
77subroutine test_designators (x)
78  use m
79  implicit none
80  integer :: x(..)
81
82  call f (x(1), 1)  ! { dg-error "(A|a)ssumed.rank" }
83  call g (x(1:3:1), &  ! { dg-error "(A|a)ssumed.rank" }
84          x)
85end subroutine
86
87! Check that you can't use an assumed-rank array variable in elemental
88! expressions.  Make sure binary operators produce the error for either or
89! both operands.
90
91subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
92  implicit none
93  integer :: a(..), b(..), c(..)
94  logical :: l(..), m(..), n(..)
95  integer :: x(s), y(s), z(s)
96  logical :: p(s), q(s), r(s)
97  integer :: s
98  integer :: i
99  logical :: j
100
101  ! Assignment
102
103  z = x  ! OK
104  c &  ! { dg-error "(A|a)ssumed.rank" }
105    = a  ! { dg-error "(A|a)ssumed.rank" }
106  z = i  ! OK
107  c = i  ! { dg-error "(A|a)ssumed.rank" }
108
109  r = p  ! OK
110  n &  ! { dg-error "(A|a)ssumed.rank" }
111    = l  ! { dg-error "(A|a)ssumed.rank" }
112  r = j  ! OK
113  n = j  ! { dg-error "(A|a)ssumed.rank" }
114
115  ! Arithmetic
116
117  z = -x  ! OK
118  c &  ! { dg-error "(A|a)ssumed.rank" }
119    = -a  ! { dg-error "(A|a)ssumed.rank" }
120  z = -i  ! OK
121  c = -i  ! { dg-error "(A|a)ssumed.rank" }
122
123  z = x + y  ! OK
124  c &  ! { dg-error "(A|a)ssumed.rank" }
125    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
126    + b  ! { dg-error "(A|a)ssumed.rank" }
127  z = x + i  ! OK
128  c &  ! { dg-error "(A|a)ssumed.rank" }
129    = a + i  ! { dg-error "(A|a)ssumed.rank" }
130  z = i + y  ! OK
131  c &  ! { dg-error "(A|a)ssumed.rank" }
132    = i + b  ! { dg-error "(A|a)ssumed.rank" }
133
134  z = x - y  ! OK
135  c &  ! { dg-error "(A|a)ssumed.rank" }
136    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
137    - b  ! { dg-error "(A|a)ssumed.rank" }
138  z = x - i  ! OK
139  c &  ! { dg-error "(A|a)ssumed.rank" }
140    = a - i  ! { dg-error "(A|a)ssumed.rank" }
141  z = i - y  ! OK
142  c &  ! { dg-error "(A|a)ssumed.rank" }
143    = i - b  ! { dg-error "(A|a)ssumed.rank" }
144
145  z = x * y  ! OK
146  c &  ! { dg-error "(A|a)ssumed.rank" }
147    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
148    * b  ! { dg-error "(A|a)ssumed.rank" }
149  z = x * i  ! OK
150  c &  ! { dg-error "(A|a)ssumed.rank" }
151    = a * i  ! { dg-error "(A|a)ssumed.rank" }
152  z = i * y  ! OK
153  c &  ! { dg-error "(A|a)ssumed.rank" }
154    = i * b  ! { dg-error "(A|a)ssumed.rank" }
155
156  z = x / y  ! OK
157  c &  ! { dg-error "(A|a)ssumed.rank" }
158    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
159    / b  ! { dg-error "(A|a)ssumed.rank" }
160  z = x / i  ! OK
161  c &  ! { dg-error "(A|a)ssumed.rank" }
162    = a / i  ! { dg-error "(A|a)ssumed.rank" }
163  z = i / y  ! OK
164  c &  ! { dg-error "(A|a)ssumed.rank" }
165    = i / b  ! { dg-error "(A|a)ssumed.rank" }
166
167  z = x ** y  ! OK
168  c &  ! { dg-error "(A|a)ssumed.rank" }
169    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
170    ** b  ! { dg-error "(A|a)ssumed.rank" }
171  z = x ** i  ! OK
172  c &  ! { dg-error "(A|a)ssumed.rank" }
173    = a ** i  ! { dg-error "(A|a)ssumed.rank" }
174  z = i ** y  ! OK
175  c &  ! { dg-error "(A|a)ssumed.rank" }
176    = i ** b  ! { dg-error "(A|a)ssumed.rank" }
177
178  ! Comparisons
179
180  r = x .eq. y  ! OK
181  n &  ! { dg-error "(A|a)ssumed.rank" }
182    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
183    .eq. b  ! { dg-error "(A|a)ssumed.rank" }
184  r = x .eq. i  ! OK
185  n &  ! { dg-error "(A|a)ssumed.rank" }
186    = a .eq. i  ! { dg-error "(A|a)ssumed.rank" }
187  r = i .eq. y  ! OK
188  n &  ! { dg-error "(A|a)ssumed.rank" }
189    = i .eq. b  ! { dg-error "(A|a)ssumed.rank" }
190
191  r = x .ne. y  ! OK
192  n &  ! { dg-error "(A|a)ssumed.rank" }
193    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
194    .ne. b  ! { dg-error "(A|a)ssumed.rank" }
195  r = x .ne. i  ! OK
196  n &  ! { dg-error "(A|a)ssumed.rank" }
197    = a .ne. i  ! { dg-error "(A|a)ssumed.rank" }
198  r = i .ne. y  ! OK
199  n &  ! { dg-error "(A|a)ssumed.rank" }
200    = i .ne. b  ! { dg-error "(A|a)ssumed.rank" }
201
202  r = x .lt. y  ! OK
203  n &  ! { dg-error "(A|a)ssumed.rank" }
204    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
205    .lt. b  ! { dg-error "(A|a)ssumed.rank" }
206  r = x .lt. i  ! OK
207  n &  ! { dg-error "(A|a)ssumed.rank" }
208    = a .lt. i  ! { dg-error "(A|a)ssumed.rank" }
209  r = i .lt. y  ! OK
210  n &  ! { dg-error "(A|a)ssumed.rank" }
211    = i .lt. b  ! { dg-error "(A|a)ssumed.rank" }
212
213  r = x .le. y  ! OK
214  n &  ! { dg-error "(A|a)ssumed.rank" }
215    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
216    .le. b  ! { dg-error "(A|a)ssumed.rank" }
217  r = x .le. i  ! OK
218  n &  ! { dg-error "(A|a)ssumed.rank" }
219    = a .le. i  ! { dg-error "(A|a)ssumed.rank" }
220  r = i .le. y  ! OK
221  n &  ! { dg-error "(A|a)ssumed.rank" }
222    = i .le. b  ! { dg-error "(A|a)ssumed.rank" }
223
224  r = x .gt. y  ! OK
225  n &  ! { dg-error "(A|a)ssumed.rank" }
226    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
227    .gt. b  ! { dg-error "(A|a)ssumed.rank" }
228  r = x .gt. i  ! OK
229  n &  ! { dg-error "(A|a)ssumed.rank" }
230    = a .gt. i  ! { dg-error "(A|a)ssumed.rank" }
231  r = i .gt. y  ! OK
232  n &  ! { dg-error "(A|a)ssumed.rank" }
233    = i .gt. b  ! { dg-error "(A|a)ssumed.rank" }
234
235  r = x .ge. y  ! OK
236  n &  ! { dg-error "(A|a)ssumed.rank" }
237    = a &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
238    .ge. b  ! { dg-error "(A|a)ssumed.rank" }
239  r = x .ge. i  ! OK
240  n &  ! { dg-error "(A|a)ssumed.rank" }
241    = a .ge. i  ! { dg-error "(A|a)ssumed.rank" }
242  r = i .ge. y  ! OK
243  n &  ! { dg-error "(A|a)ssumed.rank" }
244    = i .ge. b  ! { dg-error "(A|a)ssumed.rank" }
245
246  ! Logical operators
247
248  r = .not. p  ! OK
249  n &  ! { dg-error "(A|a)ssumed.rank" }
250    = .not. l  ! { dg-error "(A|a)ssumed.rank" }
251  r = .not. j  ! OK
252  n = .not. j  ! { dg-error "(A|a)ssumed.rank" }
253
254  r = p .and. q  ! OK
255  n &  ! { dg-error "(A|a)ssumed.rank" }
256    = l &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
257    .and. m  ! { dg-error "(A|a)ssumed.rank" }
258  r = p .and. j  ! OK
259  n &  ! { dg-error "(A|a)ssumed.rank" }
260    = l .and. j  ! { dg-error "(A|a)ssumed.rank" }
261  r = j .and. q  ! OK
262  n &  ! { dg-error "(A|a)ssumed.rank" }
263    = j .and. m  ! { dg-error "(A|a)ssumed.rank" }
264
265  r = p .or. q  ! OK
266  n &  ! { dg-error "(A|a)ssumed.rank" }
267    = l &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
268    .or. m  ! { dg-error "(A|a)ssumed.rank" }
269  r = p .or. j  ! OK
270  n &  ! { dg-error "(A|a)ssumed.rank" }
271    = l .or. j  ! { dg-error "(A|a)ssumed.rank" }
272  r = j .or. q  ! OK
273  n &  ! { dg-error "(A|a)ssumed.rank" }
274    = j .or. m  ! { dg-error "(A|a)ssumed.rank" }
275
276  r = p .eqv. q  ! OK
277  n &  ! { dg-error "(A|a)ssumed.rank" }
278    = l &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
279    .eqv. m  ! { dg-error "(A|a)ssumed.rank" }
280  r = p .eqv. j  ! OK
281  n &  ! { dg-error "(A|a)ssumed.rank" }
282    = l .eqv. j  ! { dg-error "(A|a)ssumed.rank" }
283  r = j .eqv. q  ! OK
284  n &  ! { dg-error "(A|a)ssumed.rank" }
285    = j .eqv. m  ! { dg-error "(A|a)ssumed.rank" }
286
287  r = p .neqv. q  ! OK
288  n &  ! { dg-error "(A|a)ssumed.rank" }
289    = l &  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
290    .neqv. m  ! { dg-error "(A|a)ssumed.rank" }
291  r = p .neqv. j  ! OK
292  n &  ! { dg-error "(A|a)ssumed.rank" }
293    = l .neqv. j  ! { dg-error "(A|a)ssumed.rank" }
294  r = j .neqv. q  ! OK
295  n &  ! { dg-error "(A|a)ssumed.rank" }
296    = j .neqv. m  ! { dg-error "(A|a)ssumed.rank" }
297
298end subroutine
299
300! Check that calls to disallowed intrinsic functions produce a diagnostic.
301! There are 100+ "elemental" intrinsics defined in the standard, and
302! 25+ "transformational" intrinsics that accept array operands, and that
303! doesn't include intrinsics in the standard modules.  To keep the length of
304! this test to something sane, check only a handful of these functions on
305! the theory that related functions are probably implemented similarly and
306! probably share the same argument-processing code.
307
308subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
309  implicit none
310  integer :: i1(..), i2(..)
311  real :: r1(..), r2(..)
312  complex :: c1(..), c2(..)
313  logical :: l1(..), l2(..)
314  character :: s1(..), s2(..)
315
316  integer :: i
317  real :: r
318  logical :: l
319
320  ! trig, hyperbolic, other math functions
321  r1 &  ! { dg-error "(A|a)ssumed.rank" }
322    = atan2 (r1, &  ! { dg-error "(A|a)ssumed.rank" }
323             r2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
324  r1 &  ! { dg-error "(A|a)ssumed.rank" }
325    = atan (r2)  ! { dg-error "(A|a)ssumed.rank" }
326  c1 &  ! { dg-error "(A|a)ssumed.rank" }
327    = atan (c2)  ! { dg-error "(A|a)ssumed.rank" }
328  r1 &  ! { dg-error "(A|a)ssumed.rank" }
329    = cos (r2)  ! { dg-error "(A|a)ssumed.rank" }
330  r1 &  ! { dg-error "(A|a)ssumed.rank" }
331    = exp (r2)  ! { dg-error "(A|a)ssumed.rank" }
332  r1 &  ! { dg-error "(A|a)ssumed.rank" }
333    = sinh (r2)  ! { dg-error "(A|a)ssumed.rank" }
334
335  ! bit operations
336  l1 &  ! { dg-error "(A|a)ssumed.rank" }
337    = blt (i1, &  ! { dg-error "(A|a)ssumed.rank" }
338           i2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
339  l1 &  ! { dg-error "(A|a)ssumed.rank" }
340    = btest (i1, 0)  ! { dg-error "(A|a)ssumed.rank" }
341  i1 &  ! { dg-error "(A|a)ssumed.rank" }
342    = not (i2)  ! { dg-error "(A|a)ssumed.rank" }
343  i1 &  ! { dg-error "(A|a)ssumed.rank" }
344    = popcnt (i2)  ! { dg-error "(A|a)ssumed.rank" }
345
346  ! type conversions
347  s1 &  ! { dg-error "(A|a)ssumed.rank" }
348    = char (i1)  ! { dg-error "(A|a)ssumed.rank" }
349  c1 &  ! { dg-error "(A|a)ssumed.rank" }
350    = cmplx (r1, &  ! { dg-error "(A|a)ssumed.rank" }
351             r2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
352  i1 &  ! { dg-error "(A|a)ssumed.rank" }
353    = floor (r1)  ! { dg-error "(A|a)ssumed.rank" }
354  r1 &  ! { dg-error "(A|a)ssumed.rank" }
355    = real (c1)  ! { dg-error "(A|a)ssumed.rank" }
356
357  ! reductions
358  l = any (l2)  ! { dg-error "(A|a)ssumed.rank" }
359  r = dot_product (r1, &  ! { dg-error "(A|a)ssumed.rank" }
360                   r2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
361  i = iall (i2, &  ! { dg-error "(A|a)ssumed.rank" }
362            l2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
363
364  ! string operations
365  s1 &  ! { dg-error "(A|a)ssumed.rank" }
366    = adjustr (s2)  ! { dg-error "(A|a)ssumed.rank" }
367  i1 &  ! { dg-error "(A|a)ssumed.rank" }
368    = index (c1, &  ! { dg-error "(A|a)ssumed.rank" }
369             c2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
370
371  ! misc
372  i1 &  ! { dg-error "(A|a)ssumed.rank" }
373    = cshift (i2, 4)  ! { dg-error "(A|a)ssumed.rank" }
374  i = findloc (r1, 0.0)  ! { dg-error "(A|a)ssumed.rank" }
375  r1 &  ! { dg-error "(A|a)ssumed.rank" }
376    = matmul (r1, &  ! { dg-error "(A|a)ssumed.rank" }
377              r2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
378  r1 &  ! { dg-error "(A|a)ssumed.rank" }
379    = reshape (r2, [10, 3])  ! { dg-error "(A|a)ssumed.rank" }
380  i1 &  ! { dg-error "(A|a)ssumed.rank" }
381    = sign (i1, &  ! { dg-error "(A|a)ssumed.rank" }
382            i2)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
383  s1 &  ! { dg-error "(A|a)ssumed.rank" }
384    = transpose (s2)  ! { dg-error "(A|a)ssumed.rank" }
385
386end subroutine
387