1! { dg-do compile }
2! { dg-options "-std=f95" }
3
4! Test for a special case of the used-before-typed errors, when the symbols
5! not-yet-typed are indices.
6
7SUBROUTINE test (n, arr1, m, arr2) ! { dg-error "has no IMPLICIT type" }
8  IMPLICIT NONE
9
10  INTEGER :: myarr(42)
11
12  INTEGER :: arr1(SIZE (myarr(1:n))) ! { dg-error "'n' is used before" }
13  INTEGER :: n
14
15  INTEGER :: arr2(LEN ("hello"(1:m))) ! { dg-error "'m' is used before" }
16  INTEGER :: m
17
18  WRITE (*,*) SIZE (arr1)
19  WRITE (*,*) SIZE (arr2)
20END SUBROUTINE test
21
22PROGRAM main
23  IMPLICIT NONE
24  INTEGER :: arr1(42), arr2(42)
25  CALL test (3, arr1, 2, arr2) ! { dg-warning "Type mismatch in argument" }
26END PROGRAM main
27