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   entry ibad2()
  87   !ERROR: ENTRY in a function may not have an alternate return dummy argument
  88   entry ibadalt(*) ! C1573
  89   !ERROR: RESULT(ifunc) may not have the same name as the function
  90   entry isameres() result(ifunc) ! C1574
  91   entry iok()
  92   !ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
  93   entry isameres2() result(iok) ! C1574
  94   entry isameres3() result(iok2) ! C1574
  95   !ERROR: 'iok2' is already declared in this scoping unit
  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   !ERROR: Cannot call function 'isubr' like a subroutine
 113   call isubr
 114   entry isubr()
 115   continue ! force transition to execution part
 116   entry implicit()
 117   implicit = 666 ! ok, just ensure that it works
 118   !ERROR: Cannot call function 'implicit' like a subroutine
 119   call implicit
 120 end function
 121
 122 function chfunc() result(chr)
 123   character(len=1) :: chr
 124   character(len=2) :: chr1
 125   !ERROR: Result of ENTRY is not compatible with result of containing function
 126   entry chfunc1() result(chr1)
 127 end function
 128
 129 subroutine externals
 130   !ERROR: 'subr' is already defined as a global identifier
 131   entry subr
 132   !ERROR: 'ifunc' is already defined as a global identifier
 133   entry ifunc
 134   !ERROR: 'm1' is already defined as a global identifier
 135   entry m1
 136   !ERROR: 'iok1' is already defined as a global identifier
 137   entry iok1
 138   integer :: ix
 139   !ERROR: Cannot call subroutine 'iproc' like a function
 140   !ERROR: Function result characteristics are not known
 141   ix = iproc()
 142   entry iproc
 143 end subroutine
 144
 145 module m2
 146   !ERROR: EXTERNAL attribute not allowed on 'm2entry2'
 147   external m2entry2
 148  contains
 149   subroutine m2subr1
 150     entry m2entry1 ! ok
 151     entry m2entry2 ! NOT ok
 152     entry m2entry3 ! ok
 153   end subroutine
 154 end module
 155
 156 subroutine usem2
 157   use m2
 158   interface
 159     subroutine simplesubr
 160     end subroutine
 161   end interface
 162   procedure(simplesubr), pointer :: p
 163   p => m2subr1 ! ok
 164   p => m2entry1 ! ok
 165   p => m2entry2 ! ok
 166   p => m2entry3 ! ok
 167 end subroutine
 168
 169 module m3
 170   interface
 171     module subroutine m3entry1
 172     end subroutine
 173   end interface
 174  contains
 175   subroutine m3subr1
 176     !ERROR: 'm3entry1' is already declared in this scoping unit
 177     entry m3entry1
 178   end subroutine
 179 end module
 180
 181 module m4
 182   interface generic1
 183     module procedure m4entry1
 184   end interface
 185   interface generic2
 186     module procedure m4entry2
 187   end interface
 188   interface generic3
 189     module procedure m4entry3
 190   end interface
 191  contains
 192   subroutine m4subr1
 193     entry m4entry1 ! in implicit part
 194     integer :: n = 0
 195     entry m4entry2 ! in specification part
 196     n = 123
 197     entry m4entry3 ! in executable part
 198     print *, n
 199   end subroutine
 200 end module
 201
 202 function inone
 203   implicit none
 204   integer :: inone
 205   !ERROR: No explicit type declared for 'implicitbad1'
 206   entry implicitbad1
 207   inone = 0 ! force transition to execution part
 208   !ERROR: No explicit type declared for 'implicitbad2'
 209   entry implicitbad2
 210 end
 211
 212 module m5
 213  contains
 214   real function setBefore
 215     ent = 1.0
 216     entry ent
 217   end function
 218 end module
 219
 220 module m6
 221  contains
 222   recursive subroutine passSubr
 223     call foo(passSubr)
 224     call foo(ent1)
 225     entry ent1
 226     call foo(ent1)
 227   end subroutine
 228   recursive function passFunc1
 229     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 230     call foo(passFunc1)
 231     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 232     call foo(ent2)
 233     entry ent2
 234     !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
 235     call foo(ent2)
 236   end function
 237   recursive function passFunc2() result(res)
 238     call foo(passFunc2)
 239     call foo(ent3)
 240     entry ent3() result(res)
 241     call foo(ent3)
 242   end function
 243   subroutine foo(e)
 244     external e
 245   end subroutine
 246 end module
 247
 248 !ERROR: 'q' appears more than once as a dummy argument name in this subprogram
 249 subroutine s7(q,q)
 250   !ERROR: Dummy argument 'x' may not be used before its ENTRY statement
 251   call x
 252   entry foo(x)
 253   !ERROR: 's7' may not appear as a dummy argument name in this ENTRY statement
 254   entry bar(s7)
 255   !ERROR: 'z' appears more than once as a dummy argument name in this ENTRY statement
 256   entry baz(z,z)
 257 end