1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
! RUN: %S/test_errors.sh %s %t %f18
! Tests valid and invalid ENTRY statements
module m1
!ERROR: ENTRY may appear only in a subroutine or function
entry badentryinmodule
interface
module subroutine separate
end subroutine
end interface
contains
subroutine modproc
entry entryinmodproc ! ok
block
!ERROR: ENTRY may not appear in an executable construct
entry badentryinblock ! C1571
end block
if (.true.) then
!ERROR: ENTRY may not appear in an executable construct
entry ibadconstr() ! C1571
end if
contains
subroutine internal
!ERROR: ENTRY may not appear in an internal subprogram
entry badentryininternal ! C1571
end subroutine
end subroutine
end module
submodule(m1) m1s1
contains
module procedure separate
!ERROR: ENTRY may not appear in a separate module procedure
entry badentryinsmp ! 1571
end procedure
end submodule
program main
!ERROR: ENTRY may appear only in a subroutine or function
entry badentryinprogram ! C1571
end program
block data bd1
!ERROR: ENTRY may appear only in a subroutine or function
entry badentryinbd ! C1571
end block data
subroutine subr(goodarg1)
real, intent(in) :: goodarg1
real :: goodarg2
!ERROR: A dummy argument may not also be a named constant
integer, parameter :: badarg1 = 1
type :: badarg2
end type
common /badarg3/ x
namelist /badarg4/ x
!ERROR: A dummy argument must not be initialized
!ERROR: A dummy argument may not have the SAVE attribute
integer :: badarg5 = 2
entry okargs(goodarg1, goodarg2)
!ERROR: RESULT(br1) may appear only in a function
entry badresult() result(br1) ! C1572
!ERROR: ENTRY dummy argument 'badarg2' is previously declared as an item that may not be used as a dummy argument
!ERROR: ENTRY dummy argument 'badarg4' is previously declared as an item that may not be used as a dummy argument
entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5)
end subroutine
function ifunc()
integer :: ifunc
integer :: ibad1
type :: ibad2
end type
save :: ibad3
real :: weird1
double precision :: weird2
complex :: weird3
logical :: weird4
character :: weird5
type(ibad2) :: weird6
integer :: iarr(1)
integer, allocatable :: alloc
integer, pointer :: ptr
entry iok1()
!ERROR: ENTRY name 'ibad1' may not be declared when RESULT() is present
entry ibad1() result(ibad1res) ! C1570
!ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
entry ibad2()
!ERROR: ENTRY in a function may not have an alternate return dummy argument
entry ibadalt(*) ! C1573
!ERROR: RESULT(ifunc) may not have the same name as the function
entry isameres() result(ifunc) ! C1574
entry iok()
!ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
entry isameres2() result(iok) ! C1574
entry isameres3() result(iok2) ! C1574
entry iok2()
!These cases are all acceptably incompatible
entry iok3() result(weird1)
entry iok4() result(weird2)
entry iok5() result(weird3)
entry iok6() result(weird4)
!ERROR: Result of ENTRY is not compatible with result of containing function
entry ibadt1() result(weird5)
!ERROR: Result of ENTRY is not compatible with result of containing function
entry ibadt2() result(weird6)
!ERROR: Result of ENTRY is not compatible with result of containing function
entry ibadt3() result(iarr)
!ERROR: Result of ENTRY is not compatible with result of containing function
entry ibadt4() result(alloc)
!ERROR: Result of ENTRY is not compatible with result of containing function
entry ibadt5() result(ptr)
call isubr
!ERROR: 'isubr' was previously called as a subroutine
entry isubr()
continue ! force transition to execution part
entry implicit()
implicit = 666 ! ok, just ensure that it works
end function
function chfunc() result(chr)
character(len=1) :: chr
character(len=2) :: chr1
!ERROR: Result of ENTRY is not compatible with result of containing function
entry chfunc1() result(chr1)
end function
subroutine externals
!ERROR: 'subr' is already defined as a global identifier
entry subr
!ERROR: 'ifunc' is already defined as a global identifier
entry ifunc
!ERROR: 'm1' is already defined as a global identifier
entry m1
!ERROR: 'iok1' is already defined as a global identifier
entry iok1
integer :: ix
ix = iproc()
!ERROR: 'iproc' was previously called as a function
entry iproc
end subroutine
module m2
external m2entry2
contains
subroutine m2subr1
entry m2entry1 ! ok
entry m2entry2 ! ok
entry m2entry3 ! ok
end subroutine
end module
subroutine usem2
use m2
interface
subroutine simplesubr
end subroutine
end interface
procedure(simplesubr), pointer :: p
p => m2subr1 ! ok
p => m2entry1 ! ok
p => m2entry2 ! ok
p => m2entry3 ! ok
end subroutine
module m3
interface
module subroutine m3entry1
end subroutine
end interface
contains
subroutine m3subr1
!ERROR: 'm3entry1' is already declared in this scoping unit
entry m3entry1
end subroutine
end module
function inone
implicit none
integer :: inone
!ERROR: No explicit type declared for 'implicitbad1'
entry implicitbad1
inone = 0 ! force transition to execution part
!ERROR: No explicit type declared for 'implicitbad2'
entry implicitbad2
end
|
