gcc/testsuite/gfortran.dg/entry_1.f90

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