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