1! { dg-do compile }
2!
3! PR fortran/34760
4! The problem with implict typing is that it is unclear
5! whether an existing symbol is a variable or a function.
6! Thus it remains long FL_UNKNOWN, which causes extra
7! problems; it was failing here since ISTAT was not
8! FL_VARIABLE but still FL_UNKNOWN.
9!
10! Test case contributed by Dick Hendrickson.
11!
12     MODULE TESTS
13       PRIVATE :: ISTAT
14       PUBLIC :: ISTAT2
15     CONTAINS
16     SUBROUTINE AD0001
17     REAL RLA1(:)
18     ALLOCATABLE RLA1
19     ISTAT = -314
20     ALLOCATE (RLA1(NF10), STAT = ISTAT)
21     ALLOCATE (RLA1(NF10), STAT = ISTAT2)
22     END SUBROUTINE
23     END MODULE
24
25     MODULE TESTS2
26       PRIVATE :: ISTAT2
27     CONTAINS
28     function istat2()
29       istat2 = 0
30     end function istat2
31     SUBROUTINE AD0001
32       REAL RLA1(:)
33       ALLOCATABLE RLA1
34       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
35     END SUBROUTINE
36     END MODULE tests2
37