flang/test/Semantics/entry01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Tests valid and invalid ENTRY statements
   3
   4 module m1
   5   !ERROR: ENTRY 'badentryinmodule' 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
  28 end module
  29
  30 submodule(m1) m1s1
  31  contains
  32   module procedure separate
  33     !ERROR: ENTRY 'badentryinsmp' may not appear in a separate module procedure
  34     entry badentryinsmp ! 1571
  35   end procedure
  36 end submodule
  37
  38 program main
  39   !ERROR: ENTRY 'badentryinprogram' may appear only in a subroutine or function
  40   entry badentryinprogram ! C1571
  41 end program
  42
  43 block data bd1
  44   !ERROR: ENTRY 'badentryinbd' may appear only in a subroutine or function
  45   entry badentryinbd ! C1571
  46 end block data
  47
  48 subroutine 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   integer :: badarg5 = 2
  59   entry okargs(goodarg1, goodarg2)
  60   !ERROR: RESULT(br1) may appear only in a function
  61   entry badresult() result(br1) ! C1572
  62   !ERROR: 'badarg2' is already declared in this scoping unit
  63   !ERROR: 'badarg4' is already declared in this scoping unit
  64   entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5)
  65 end subroutine
  66
  67 function ifunc()
  68   integer :: ifunc
  69   integer :: ibad1
  70   type :: ibad2
  71   end type
  72   save :: ibad3
  73   real :: weird1
  74   double precision :: weird2
  75   complex :: weird3
  76   logical :: weird4
  77   character :: weird5
  78   type(ibad2) :: weird6
  79   integer :: iarr(1)
  80   integer, allocatable :: alloc
  81   integer, pointer :: ptr
  82   entry iok1()
  83   !ERROR: 'ibad1' is already declared in this scoping unit
  84   entry ibad1() result(ibad1res) ! C1570
  85   !ERROR: 'ibad2' is already declared in this scoping unit
  86   !ERROR: Procedure 'ibad2' is referenced before being sufficiently defined in a context where it must be so
  87   entry ibad2()
  88   !ERROR: ENTRY in a function may not have an alternate return dummy argument
  89   entry ibadalt(*) ! C1573
  90   !ERROR: ENTRY cannot have RESULT(ifunc) that is not a variable
  91   entry isameres() result(ifunc) ! C1574
  92   entry iok()
  93   !ERROR: Explicit RESULT('iok') of function 'isameres2' cannot have the same name as a distinct ENTRY into the same scope
  94   entry isameres2() result(iok) ! C1574
  95   !ERROR: Procedure 'iok2' is referenced before being sufficiently defined in a context where it must be so
  96   !ERROR: Explicit RESULT('iok2') of function 'isameres3' cannot have the same name as a distinct ENTRY into the same scope
  97   entry isameres3() result(iok2) ! C1574
  98   !ERROR: 'iok2' is already declared in this scoping unit
  99   entry iok2()
 100   !These cases are all acceptably incompatible
 101   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 function
 106   entry ibadt1() result(weird5)
 107   !ERROR: Result of ENTRY is not compatible with result of containing function
 108   entry ibadt2() result(weird6)
 109   !ERROR: Result of ENTRY is not compatible with result of containing function
 110   entry ibadt3() result(iarr)
 111   !ERROR: Result of ENTRY is not compatible with result of containing function
 112   entry ibadt4() result(alloc)
 113   !ERROR: Result of ENTRY is not compatible with result of containing function
 114   entry ibadt5() result(ptr)
 115   !ERROR: Cannot call function 'isubr' like a subroutine
 116   call isubr
 117   entry isubr()
 118   continue ! force transition to execution part
 119   entry implicit()
 120   implicit = 666 ! ok, just ensure that it works
 121   !ERROR: Cannot call function 'implicit' like a subroutine
 122   call implicit
 123 end function
 124
 125 function chfunc() result(chr)
 126   character(len=1) :: chr
 127   character(len=2) :: chr1
 128   !ERROR: Result of ENTRY is not compatible with result of containing function
 129   entry chfunc1() result(chr1)
 130 end function
 131
 132 subroutine externals
 133   !ERROR: 'subr' is already defined as a global identifier
 134   entry subr
 135   !ERROR: 'ifunc' is already defined as a global identifier
 136   entry ifunc
 137   !ERROR: 'm1' is already defined as a global identifier
 138   entry m1
 139   !ERROR: 'iok1' is already defined as a global identifier
 140   entry iok1
 141   integer :: ix
 142   !ERROR: Cannot call subroutine 'iproc' like a function
 143   !ERROR: Function result characteristics are not known
 144   ix = iproc()
 145   entry iproc
 146 end subroutine
 147
 148 module m2
 149   !ERROR: EXTERNAL attribute not allowed on 'm2entry2'
 150   external m2entry2
 151  contains
 152   subroutine m2subr1
 153     entry m2entry1 ! ok
 154     entry m2entry2 ! NOT ok
 155     entry m2entry3 ! ok
 156   end subroutine
 157 end module
 158
 159 subroutine usem2
 160   use m2
 161   interface
 162     subroutine simplesubr
 163     end subroutine
 164   end interface
 165   procedure(simplesubr), pointer :: p
 166   p => m2subr1 ! ok
 167   p => m2entry1 ! ok
 168   p => m2entry2 ! ok
 169   p => m2entry3 ! ok
 170 end subroutine
 171
 172 module m3
 173   interface
 174     module subroutine m3entry1
 175     end subroutine
 176   end interface
 177  contains
 178   subroutine m3subr1
 179     !ERROR: 'm3entry1' is already declared in this scoping unit
 180     entry m3entry1
 181   end subroutine
 182 end module
 183
 184 module m4
 185   interface generic1
 186     module procedure m4entry1
 187   end interface
 188   interface generic2
 189     module procedure m4entry2
 190   end interface
 191   interface generic3
 192     module procedure m4entry3
 193   end interface
 194  contains
 195   subroutine m4subr1
 196     entry m4entry1 ! in implicit part
 197     integer :: n = 0
 198     entry m4entry2 ! in specification part
 199     n = 123
 200     entry m4entry3 ! in executable part
 201     print *, n
 202   end subroutine
 203 end module
 204
 205 function inone
 206   implicit none
 207   integer :: inone
 208   !ERROR: No explicit type declared for 'implicitbad1'
 209   entry implicitbad1
 210   inone = 0 ! force transition to execution part
 211   !ERROR: No explicit type declared for 'implicitbad2'
 212   entry implicitbad2
 213 end
 214
 215 module m5
 216  contains
 217   real function setBefore
 218     ent = 1.0
 219     entry ent
 220   end function
 221 end module
 222
 223 module m6
 224  contains
 225   recursive subroutine passSubr
 226     call foo(passSubr)
 227     call foo(ent1)
 228     entry ent1
 229     call foo(ent1)
 230   end subroutine
 231   recursive function passFunc1
 232     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 233     call foo(passFunc1)
 234     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 235     call foo(ent2)
 236     entry ent2
 237     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 238     call foo(ent2)
 239   end function
 240   recursive function passFunc2() result(res)
 241     call foo(passFunc2)
 242     call foo(ent3)
 243     entry ent3() result(res)
 244     call foo(ent3)
 245   end function
 246   subroutine foo(e)
 247     external e
 248   end subroutine
 249 end module
 250
 251 !ERROR: 'q' appears more than once as a dummy argument name in this subprogram
 252 subroutine s7(q,q)
 253   !ERROR: Dummy argument 'x' may not be used before its ENTRY statement
 254   call x
 255   entry foo(x)
 256   !ERROR: 's7' may not appear as a dummy argument name in this ENTRY statement
 257   entry bar(s7)
 258   !ERROR: 'z' appears more than once as a dummy argument name in this ENTRY statement
 259   entry baz(z,z)
 260 end
 261
 262 !ERROR: Explicit RESULT('f8e1') of function 'f8' cannot have the same name as a distinct ENTRY into the same scope
 263 function f8() result(f8e1)
 264   entry f8e1()
 265   entry f8e2() result(f8e2) ! ok
 266   !ERROR: Explicit RESULT('f8e1') of function 'f8e3' cannot have the same name as a distinct ENTRY into the same scope
 267   entry f8e3() result(f8e1)
 268   !ERROR: ENTRY cannot have RESULT(f8) that is not a variable
 269   entry f8e4() result(f8)
 270 end