1! { dg-do compile }
2! { dg-options "-std=f95" }
3
4! PR fortran/32095
5! PR fortran/34228
6! Check that standards-conforming mode rejects uses of variables that
7! are used before they are typed.
8
9SUBROUTINE test1 (n, arr, m, arr2, k, arr3, a) ! { dg-error "has no IMPLICIT" }
10  IMPLICIT NONE
11
12  INTEGER :: arr(n) ! { dg-error "used before it is typed" }
13  INTEGER :: n
14  INTEGER :: m, arr2(m) ! { dg-bogus "used before it is typed" }
15  INTEGER, DIMENSION(k) :: arr3 ! { dg-error "used before it is typed" }
16  INTEGER :: k
17  CHARACTER(len=LEN(a)) :: a ! { dg-error "'a' is used before it is typed" }
18
19  REAL(KIND=l) :: x ! { dg-error "has no IMPLICIT type" }
20  REAL(KIND=KIND(y)) :: y ! { dg-error "has no IMPLICIT type" }
21
22  DATA str/'abc'/ ! { dg-error "used before it is typed" }
23  CHARACTER(len=3) :: str, str2
24  DATA str2/'abc'/ ! { dg-bogus "used before it is typed" }
25END SUBROUTINE test1
26
27SUBROUTINE test2 (n, arr, m, arr2)
28  IMPLICIT INTEGER(a-z)
29
30  INTEGER :: arr(n)
31  REAL :: n ! { dg-error "already has basic type" }
32  INTEGER :: m, arr2(m) ! { dg-bogus "already has an IMPLICIT type" }
33END SUBROUTINE test2
34
35SUBROUTINE test3 (n, arr, m, arr2)
36  IMPLICIT REAL(a-z)
37
38  INTEGER :: arr(n) ! { dg-error "must be of INTEGER type" }
39  INTEGER :: m, arr2(m) ! { dg-bogus "must be of INTEGER type" }
40END SUBROUTINE test3
41