gcc/testsuite/gfortran.dg/entry_3.f90

   1 ! { dg-do run }
   2 ! Test assumed shape arrays in procedures with multiple entry points.
   3 ! Arguments that aren't present in all entry points must be treated like
   4 ! optional arguments.
   5 module entry_4
   6 contains
   7 subroutine foo(a)
   8   integer, dimension(:) :: a
   9   integer, dimension(:) :: b
  10   a = (/1, 2/)
  11   return
  12 entry bar(b)
  13   b = (/3, 4/)
  14 end subroutine
  15 end module
  16
  17 program entry_4_prog
  18   use entry_4
  19   integer :: a(2)
  20   a = 0
  21   call foo(a)
  22   if (any (a .ne. (/1, 2/))) STOP 1
  23   call bar(a)
  24   if (any (a .ne. (/3, 4/))) STOP 2
  25 end program