1! { dg-do compile }
2! This program tests the patch for PRs 20881, 23308, 25538 & 25710
3! Assembled from PRs by Paul Thomas  <pault@gcc.gnu.org>
4module m
5contains
6  subroutine g(x)   ! Local entity
7    REAL :: x
8    x = 1.0
9  end subroutine g
10end module m
11! Error only appears once but testsuite associates with both lines.
12function f(x)       ! { dg-error "is already being used as a FUNCTION" }
13  REAL :: f, x
14  f = x
15end function f
16
17function g(x)       ! Global entity
18  REAL :: g, x
19  g = x
20
21! PR25710==========================================================
22! Lahey -2607-S: "SOURCE.F90", line 26:
23! Function 'f' cannot be referenced as a subroutine. The previous
24! definition is in 'line 12'.
25
26  call f(g) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" }
27end function g
28! Error only appears once but testsuite associates with both lines.
29function h(x)       ! { dg-error "is already being used as a FUNCTION" }
30  REAL :: h, x
31  h = x
32end function h
33
34SUBROUTINE TT()
35  CHARACTER(LEN=10), EXTERNAL :: j ! { dg-error "Return type mismatch" }
36  CHARACTER(LEN=10)          :: T
37! PR20881===========================================================
38! Error only appears once but testsuite associates with both lines.
39  T = j (1.0) ! { dg-error "is already being used as a SUBROUTINE" }
40  print *, T
41END SUBROUTINE TT
42
43  use m             ! Main program
44  real x
45  integer a(10)
46
47! PR23308===========================================================
48! Lahey - 2604-S: "SOURCE.F90", line 52:
49! The name 'foo' cannot be specified as both external procedure name
50! and common block name. The previous appearance is in 'line 68'.
51! Error only appears once but testsuite associates with both lines.
52  common /foo/ a    ! { dg-error "is already being used as a COMMON" }
53
54  call f (x)        ! OK - reference to local entity
55  call g (x)        !             -ditto-
56
57! PR25710===========================================================
58! Lahey - 2607-S: "SOURCE.F90", line 62:
59! Function 'h' cannot be referenced as a subroutine. The previous
60! definition is in 'line 29'.
61
62  call h (x) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" }
63
64! PR23308===========================================================
65! Lahey - 2521-S: "SOURCE.F90", line 68: Intrinsic procedure name or
66! external procedure name same as common block name 'foo'.
67
68  call foo () ! { dg-error "is already being used as a COMMON" }
69
70contains
71  SUBROUTINE f (x)  ! Local entity
72    real x
73    x = 2
74  end SUBROUTINE f
75end
76
77! PR20881===========================================================
78! Lahey - 2636-S: "SOURCE.F90", line 81:
79! Subroutine 'j' is previously referenced as a function in 'line 39'.
80
81SUBROUTINE j (x)    ! { dg-error "is already being used as a SUBROUTINE" }
82  integer a(10)
83  common /bar/ a    ! Global entity foo
84  real x
85  x = bar(1.0)      ! OK for local procedure to have common block name
86contains
87  function bar (x)
88    real bar, x
89    bar = 2.0*x
90  end function bar
91END SUBROUTINE j
92
93! PR25538===========================================================
94! would ICE with entry and procedure having same names.
95  subroutine link2 (namef) ! { dg-error "is already being used as a SUBROUTINE" }
96    entry link2 (nameg)    ! { dg-error "is already being used as a SUBROUTINE" }
97    return
98  end
99