| 1 |
302 |
jeremybenn |
! { dg-do compile }
|
| 2 |
|
|
! This program tests the patch for PRs 20881, 23308, 25538 & 25710
|
| 3 |
|
|
! Assembled from PRs by Paul Thomas
|
| 4 |
|
|
module m
|
| 5 |
|
|
contains
|
| 6 |
|
|
subroutine g(x) ! Local entity
|
| 7 |
|
|
REAL :: x
|
| 8 |
|
|
x = 1.0
|
| 9 |
|
|
end subroutine g
|
| 10 |
|
|
end module m
|
| 11 |
|
|
! Error only appears once but testsuite associates with both lines.
|
| 12 |
|
|
function f(x) ! { dg-error "is already being used as a FUNCTION" }
|
| 13 |
|
|
REAL :: f, x
|
| 14 |
|
|
f = x
|
| 15 |
|
|
end function f
|
| 16 |
|
|
|
| 17 |
|
|
function 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" }
|
| 27 |
|
|
end function g
|
| 28 |
|
|
! Error only appears once but testsuite associates with both lines.
|
| 29 |
|
|
function h(x) ! { dg-error "is already being used as a FUNCTION" }
|
| 30 |
|
|
REAL :: h, x
|
| 31 |
|
|
h = x
|
| 32 |
|
|
end function h
|
| 33 |
|
|
|
| 34 |
|
|
SUBROUTINE TT()
|
| 35 |
|
|
CHARACTER(LEN=10), EXTERNAL :: j
|
| 36 |
|
|
CHARACTER(LEN=10) :: T
|
| 37 |
|
|
! PR20881===========================================================
|
| 38 |
|
|
! Error only appears once but testsuite associates with both lines.
|
| 39 |
|
|
T = j () ! { dg-error "is already being used as a FUNCTION" }
|
| 40 |
|
|
print *, T
|
| 41 |
|
|
END 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" }
|
| 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 |
|
|
|
| 70 |
|
|
contains
|
| 71 |
|
|
SUBROUTINE f (x) ! Local entity
|
| 72 |
|
|
real x
|
| 73 |
|
|
x = 2
|
| 74 |
|
|
end SUBROUTINE f
|
| 75 |
|
|
end
|
| 76 |
|
|
|
| 77 |
|
|
! PR20881===========================================================
|
| 78 |
|
|
! Lahey - 2636-S: "SOURCE.F90", line 81:
|
| 79 |
|
|
! Subroutine 'j' is previously referenced as a function in 'line 39'.
|
| 80 |
|
|
|
| 81 |
|
|
SUBROUTINE j (x) ! { dg-error "is already being used as a FUNCTION" }
|
| 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
|
| 86 |
|
|
contains
|
| 87 |
|
|
function bar (x)
|
| 88 |
|
|
real bar, x
|
| 89 |
|
|
bar = 2.0*x
|
| 90 |
|
|
end function bar
|
| 91 |
|
|
END 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 |
|
|
|
| 100 |
|
|
! { dg-final { cleanup-modules "m" } }
|