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