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 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 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 may appear only in a subroutine or function
  40   entry badentryinprogram ! C1571
  41 end program
  42
  43 block data bd1
  44   !ERROR: ENTRY 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: ENTRY dummy argument 'badarg2' is previously declared as an item that may not be used as a dummy argument
  63   !ERROR: ENTRY dummy argument 'badarg4' is previously declared as an item that may not be used as a dummy argument
  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: ENTRY name 'ibad1' may not be declared when RESULT() is present
  84   entry ibad1() result(ibad1res) ! C1570
  85   !ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
  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   entry iok2()
  96   !These cases are all acceptably incompatible
  97   entry iok3() result(weird1)
  98   entry iok4() result(weird2)
  99   entry iok5() result(weird3)
 100   entry iok6() result(weird4)
 101   !ERROR: Result of ENTRY is not compatible with result of containing function
 102   entry ibadt1() result(weird5)
 103   !ERROR: Result of ENTRY is not compatible with result of containing function
 104   entry ibadt2() result(weird6)
 105   !ERROR: Result of ENTRY is not compatible with result of containing function
 106   entry ibadt3() result(iarr)
 107   !ERROR: Result of ENTRY is not compatible with result of containing function
 108   entry ibadt4() result(alloc)
 109   !ERROR: Result of ENTRY is not compatible with result of containing function
 110   entry ibadt5() result(ptr)
 111   call isubr
 112   !ERROR: 'isubr' was previously called as a subroutine
 113   entry isubr()
 114   continue ! force transition to execution part
 115   entry implicit()
 116   implicit = 666 ! ok, just ensure that it works
 117 end function
 118
 119 function chfunc() result(chr)
 120   character(len=1) :: chr
 121   character(len=2) :: chr1
 122   !ERROR: Result of ENTRY is not compatible with result of containing function
 123   entry chfunc1() result(chr1)
 124 end function
 125
 126 subroutine externals
 127   !ERROR: 'subr' is already defined as a global identifier
 128   entry subr
 129   !ERROR: 'ifunc' is already defined as a global identifier
 130   entry ifunc
 131   !ERROR: 'm1' is already defined as a global identifier
 132   entry m1
 133   !ERROR: 'iok1' is already defined as a global identifier
 134   entry iok1
 135   integer :: ix
 136   ix = iproc()
 137   !ERROR: 'iproc' was previously called as a function
 138   entry iproc
 139 end subroutine
 140
 141 module m2
 142   !ERROR: EXTERNAL attribute not allowed on 'm2entry2'
 143   external m2entry2
 144  contains
 145   subroutine m2subr1
 146     entry m2entry1 ! ok
 147     entry m2entry2 ! NOT ok
 148     entry m2entry3 ! ok
 149   end subroutine
 150 end module
 151
 152 subroutine usem2
 153   use m2
 154   interface
 155     subroutine simplesubr
 156     end subroutine
 157   end interface
 158   procedure(simplesubr), pointer :: p
 159   p => m2subr1 ! ok
 160   p => m2entry1 ! ok
 161   p => m2entry2 ! ok
 162   p => m2entry3 ! ok
 163 end subroutine
 164
 165 module m3
 166   interface
 167     module subroutine m3entry1
 168     end subroutine
 169   end interface
 170  contains
 171   subroutine m3subr1
 172     !ERROR: 'm3entry1' is already declared in this scoping unit
 173     entry m3entry1
 174   end subroutine
 175 end module
 176
 177 module m4
 178   interface generic1
 179     module procedure m4entry1
 180   end interface
 181   interface generic2
 182     module procedure m4entry2
 183   end interface
 184   interface generic3
 185     module procedure m4entry3
 186   end interface
 187  contains
 188   subroutine m4subr1
 189     entry m4entry1 ! in implicit part
 190     integer :: n = 0
 191     entry m4entry2 ! in specification part
 192     n = 123
 193     entry m4entry3 ! in executable part
 194     print *, n
 195   end subroutine
 196 end module
 197
 198 function inone
 199   implicit none
 200   integer :: inone
 201   !ERROR: No explicit type declared for 'implicitbad1'
 202   entry implicitbad1
 203   inone = 0 ! force transition to execution part
 204   !ERROR: No explicit type declared for 'implicitbad2'
 205   entry implicitbad2
 206 end