271 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Tests valid and invalid ENTRY statements3 4module m15 !ERROR: ENTRY 'badentryinmodule' may appear only in a subroutine or function6 entry badentryinmodule7 interface8 module subroutine separate9 end subroutine10 end interface11 contains12 subroutine modproc13 entry entryinmodproc ! ok14 block15 !ERROR: ENTRY may not appear in an executable construct16 entry badentryinblock ! C157117 end block18 if (.true.) then19 !ERROR: ENTRY may not appear in an executable construct20 entry ibadconstr() ! C157121 end if22 contains23 subroutine internal24 !ERROR: ENTRY may not appear in an internal subprogram25 entry badentryininternal ! C157126 end subroutine27 end subroutine28end module29 30submodule(m1) m1s131 contains32 module procedure separate33 !ERROR: ENTRY 'badentryinsmp' may not appear in a separate module procedure34 entry badentryinsmp ! 157135 end procedure36end submodule37 38program main39 !ERROR: ENTRY 'badentryinprogram' may appear only in a subroutine or function40 entry badentryinprogram ! C157141end program42 43block data bd144 !ERROR: ENTRY 'badentryinbd' may appear only in a subroutine or function45 entry badentryinbd ! C157146end block data47 48subroutine subr(goodarg1)49 real, intent(in) :: goodarg150 real :: goodarg251 !ERROR: A dummy argument may not also be a named constant52 integer, parameter :: badarg1 = 153 type :: badarg254 end type55 common /badarg3/ x56 namelist /badarg4/ x57 !ERROR: A dummy argument must not be initialized58 integer :: badarg5 = 259 entry okargs(goodarg1, goodarg2)60 !ERROR: RESULT(br1) may appear only in a function61 entry badresult() result(br1) ! C157262 !ERROR: 'badarg2' is already declared in this scoping unit63 !ERROR: 'badarg4' is already declared in this scoping unit64 entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5)65end subroutine66 67function ifunc()68 integer :: ifunc69 integer :: ibad170 type :: ibad271 end type72 save :: ibad373 real :: weird174 double precision :: weird275 complex :: weird376 logical :: weird477 character :: weird578 type(ibad2) :: weird679 integer :: iarr(1)80 integer, allocatable :: alloc81 integer, pointer :: ptr82 entry iok1()83 !ERROR: 'ibad1' is already declared in this scoping unit84 entry ibad1() result(ibad1res) ! C157085 !ERROR: 'ibad2' is already declared in this scoping unit86 !ERROR: Procedure 'ibad2' is referenced before being sufficiently defined in a context where it must be so87 entry ibad2()88 !ERROR: ENTRY in a function may not have an alternate return dummy argument89 entry ibadalt(*) ! C157390 !ERROR: ENTRY cannot have RESULT(ifunc) that is not a variable91 entry isameres() result(ifunc) ! C157492 entry iok()93 !ERROR: Explicit RESULT('iok') of function 'isameres2' cannot have the same name as a distinct ENTRY into the same scope94 entry isameres2() result(iok) ! C157495 !ERROR: Procedure 'iok2' is referenced before being sufficiently defined in a context where it must be so96 !ERROR: Explicit RESULT('iok2') of function 'isameres3' cannot have the same name as a distinct ENTRY into the same scope97 entry isameres3() result(iok2) ! C157498 !ERROR: 'iok2' is already declared in this scoping unit99 entry iok2()100 !These cases are all acceptably incompatible101 entry iok3() result(weird1)102 entry iok4() result(weird2)103 entry iok5() result(weird3)104 entry iok6() result(weird4)105 !ERROR: Result of ENTRY is not compatible with result of containing function106 entry ibadt1() result(weird5)107 !ERROR: Result of ENTRY is not compatible with result of containing function108 entry ibadt2() result(weird6)109 !ERROR: Result of ENTRY is not compatible with result of containing function110 entry ibadt3() result(iarr)111 !ERROR: Result of ENTRY is not compatible with result of containing function112 entry ibadt4() result(alloc)113 !ERROR: Result of ENTRY is not compatible with result of containing function114 entry ibadt5() result(ptr)115 !ERROR: Cannot call function 'isubr' like a subroutine116 call isubr117 entry isubr()118 continue ! force transition to execution part119 entry implicit()120 implicit = 666 ! ok, just ensure that it works121 !ERROR: Cannot call function 'implicit' like a subroutine122 call implicit123end function124 125function chfunc() result(chr)126 character(len=1) :: chr127 character(len=2) :: chr1128 !ERROR: Result of ENTRY is not compatible with result of containing function129 entry chfunc1() result(chr1)130end function131 132subroutine externals133 !ERROR: 'subr' is already defined as a global identifier134 entry subr135 !ERROR: 'ifunc' is already defined as a global identifier136 entry ifunc137 !ERROR: 'm1' is already defined as a global identifier138 entry m1139 !ERROR: 'iok1' is already defined as a global identifier140 entry iok1141 integer :: ix142 !ERROR: Cannot call subroutine 'iproc' like a function143 !ERROR: Function result characteristics are not known144 ix = iproc()145 entry iproc146end subroutine147 148module m2149 !ERROR: EXTERNAL attribute not allowed on 'm2entry2'150 external m2entry2151 contains152 subroutine m2subr1153 entry m2entry1 ! ok154 entry m2entry2 ! NOT ok155 entry m2entry3 ! ok156 end subroutine157end module158 159subroutine usem2160 use m2161 interface162 subroutine simplesubr163 end subroutine164 end interface165 procedure(simplesubr), pointer :: p166 p => m2subr1 ! ok167 p => m2entry1 ! ok168 p => m2entry2 ! ok169 p => m2entry3 ! ok170end subroutine171 172module m3173 interface174 module subroutine m3entry1175 end subroutine176 end interface177 contains178 subroutine m3subr1179 !ERROR: 'm3entry1' is already declared in this scoping unit180 entry m3entry1181 end subroutine182end module183 184module m4185 interface generic1186 module procedure m4entry1187 end interface188 interface generic2189 module procedure m4entry2190 end interface191 interface generic3192 module procedure m4entry3193 end interface194 contains195 subroutine m4subr1196 entry m4entry1 ! in implicit part197 integer :: n = 0198 entry m4entry2 ! in specification part199 n = 123200 entry m4entry3 ! in executable part201 print *, n202 end subroutine203end module204 205function inone206 implicit none207 integer :: inone208 !ERROR: No explicit type declared for 'implicitbad1'209 entry implicitbad1210 inone = 0 ! force transition to execution part211 !ERROR: No explicit type declared for 'implicitbad2'212 entry implicitbad2213end214 215module m5216 contains217 real function setBefore218 ent = 1.0219 entry ent220 end function221end module222 223module m6224 contains225 recursive subroutine passSubr226 call foo(passSubr)227 call foo(ent1)228 entry ent1229 call foo(ent1)230 end subroutine231 recursive function passFunc1232 !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure233 call foo(passFunc1)234 !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure235 call foo(ent2)236 entry ent2237 !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure238 call foo(ent2)239 end function240 recursive function passFunc2() result(res)241 call foo(passFunc2)242 call foo(ent3)243 entry ent3() result(res)244 call foo(ent3)245 end function246 subroutine foo(e)247 external e248 end subroutine249end module250 251!ERROR: 'q' appears more than once as a dummy argument name in this subprogram252subroutine s7(q,q)253 !ERROR: Dummy argument 'x' may not be used before its ENTRY statement254 call x255 entry foo(x)256 !ERROR: 's7' may not appear as a dummy argument name in this ENTRY statement257 entry bar(s7)258 !ERROR: 'z' appears more than once as a dummy argument name in this ENTRY statement259 entry baz(z,z)260end261 262!ERROR: Explicit RESULT('f8e1') of function 'f8' cannot have the same name as a distinct ENTRY into the same scope263function f8() result(f8e1)264 entry f8e1()265 entry f8e2() result(f8e2) ! ok266 !ERROR: Explicit RESULT('f8e1') of function 'f8e3' cannot have the same name as a distinct ENTRY into the same scope267 entry f8e3() result(f8e1)268 !ERROR: ENTRY cannot have RESULT(f8) that is not a variable269 entry f8e4() result(f8)270end271