gcc/testsuite/gfortran.dg/entry_1.f90

   1 ! Test alternate entry points in a module procedure
   2 ! Also check that references to sibling entry points are resolved correctly.
   3 module m
   4 contains
   5 subroutine indirecta (p)
   6   call p (3, 4)
   7 end subroutine
   8 subroutine indirectb (p)
   9   call p (5)
  10 end subroutine
  11
  12 subroutine test1
  13   implicit none
  14   call indidecta (foo)
  15   call indirectb (bar)
  16 end subroutine
  17
  18 subroutine foo(a, b)
  19   integer a, b
  20   logical, save :: was_foo = .false.
  21   if ((a .ne. 3) .or. (b .ne. 4)) call abort
  22   was_foo = .true.
  23 entry bar(a)
  24   if (was_foo) then
  25     if ((a .ne. 3) .or. (b .ne. 4)) call abort
  26   else
  27     if (a .ne. 5) call abort
  28   end if
  29   was_foo = .false.
  30 end subroutine
  31
  32 subroutine test2
  33   call foo (3, 4)
  34   call bar (5)
  35 end subroutine
  36 end module
  37
  38 program p
  39   use m
  40   call foo (3, 4)
  41   call bar (5)
  42   call test1 ()
  43   call test2 ()
  44 end program