| ! RUN: %python %S/test_errors.py %s %flang_fc1 |
| ! Tests valid and invalid ENTRY statements |
| |
| module m1 |
| !ERROR: ENTRY 'badentryinmodule' 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 'badentryinsmp' may not appear in a separate module procedure |
| entry badentryinsmp ! 1571 |
| end procedure |
| end submodule |
| |
| program main |
| !ERROR: ENTRY 'badentryinprogram' may appear only in a subroutine or function |
| entry badentryinprogram ! C1571 |
| end program |
| |
| block data bd1 |
| !ERROR: ENTRY 'badentryinbd' 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 |
| integer :: badarg5 = 2 |
| entry okargs(goodarg1, goodarg2) |
| !ERROR: RESULT(br1) may appear only in a function |
| entry badresult() result(br1) ! C1572 |
| !ERROR: 'badarg2' is already declared in this scoping unit |
| !ERROR: 'badarg4' is already declared in this scoping unit |
| 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: 'ibad1' is already declared in this scoping unit |
| entry ibad1() result(ibad1res) ! C1570 |
| !ERROR: 'ibad2' is already declared in this scoping unit |
| !ERROR: Procedure 'ibad2' is referenced before being sufficiently defined in a context where it must be so |
| entry ibad2() |
| !ERROR: ENTRY in a function may not have an alternate return dummy argument |
| entry ibadalt(*) ! C1573 |
| !ERROR: ENTRY cannot have RESULT(ifunc) that is not a variable |
| entry isameres() result(ifunc) ! C1574 |
| entry iok() |
| !ERROR: Explicit RESULT('iok') of function 'isameres2' cannot have the same name as a distinct ENTRY into the same scope |
| entry isameres2() result(iok) ! C1574 |
| !ERROR: Procedure 'iok2' is referenced before being sufficiently defined in a context where it must be so |
| !ERROR: Explicit RESULT('iok2') of function 'isameres3' cannot have the same name as a distinct ENTRY into the same scope |
| entry isameres3() result(iok2) ! C1574 |
| !ERROR: 'iok2' is already declared in this scoping unit |
| 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) |
| !ERROR: Cannot call function 'isubr' like a subroutine |
| call isubr |
| entry isubr() |
| continue ! force transition to execution part |
| entry implicit() |
| implicit = 666 ! ok, just ensure that it works |
| !ERROR: Cannot call function 'implicit' like a subroutine |
| call implicit |
| 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 |
| !ERROR: Cannot call subroutine 'iproc' like a function |
| !ERROR: Function result characteristics are not known |
| ix = iproc() |
| entry iproc |
| end subroutine |
| |
| module m2 |
| !ERROR: EXTERNAL attribute not allowed on 'm2entry2' |
| external m2entry2 |
| contains |
| subroutine m2subr1 |
| entry m2entry1 ! ok |
| entry m2entry2 ! NOT 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 |
| |
| module m4 |
| interface generic1 |
| module procedure m4entry1 |
| end interface |
| interface generic2 |
| module procedure m4entry2 |
| end interface |
| interface generic3 |
| module procedure m4entry3 |
| end interface |
| contains |
| subroutine m4subr1 |
| entry m4entry1 ! in implicit part |
| integer :: n = 0 |
| entry m4entry2 ! in specification part |
| n = 123 |
| entry m4entry3 ! in executable part |
| print *, n |
| 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 |
| |
| module m5 |
| contains |
| real function setBefore |
| ent = 1.0 |
| entry ent |
| end function |
| end module |
| |
| module m6 |
| contains |
| recursive subroutine passSubr |
| call foo(passSubr) |
| call foo(ent1) |
| entry ent1 |
| call foo(ent1) |
| end subroutine |
| recursive function passFunc1 |
| !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure |
| call foo(passFunc1) |
| !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure |
| call foo(ent2) |
| entry ent2 |
| !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure |
| call foo(ent2) |
| end function |
| recursive function passFunc2() result(res) |
| call foo(passFunc2) |
| call foo(ent3) |
| entry ent3() result(res) |
| call foo(ent3) |
| end function |
| subroutine foo(e) |
| external e |
| end subroutine |
| end module |
| |
| !ERROR: 'q' appears more than once as a dummy argument name in this subprogram |
| subroutine s7(q,q) |
| !ERROR: Dummy argument 'x' may not be used before its ENTRY statement |
| call x |
| entry foo(x) |
| !ERROR: 's7' may not appear as a dummy argument name in this ENTRY statement |
| entry bar(s7) |
| !ERROR: 'z' appears more than once as a dummy argument name in this ENTRY statement |
| entry baz(z,z) |
| end |
| |
| !ERROR: Explicit RESULT('f8e1') of function 'f8' cannot have the same name as a distinct ENTRY into the same scope |
| function f8() result(f8e1) |
| entry f8e1() |
| entry f8e2() result(f8e2) ! ok |
| !ERROR: Explicit RESULT('f8e1') of function 'f8e3' cannot have the same name as a distinct ENTRY into the same scope |
| entry f8e3() result(f8e1) |
| !ERROR: ENTRY cannot have RESULT(f8) that is not a variable |
| entry f8e4() result(f8) |
| end |