gcc/testsuite/gfortran.dg/entry_14.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/34137
   4 !
   5 ! Entry was previously not possible in a module.
   6 ! Checks also whether the different result combinations
   7 ! work properly.
   8 !
   9 module m1
  10   implicit none
  11 contains
  12 function func(a)
  13   implicit none
  14   integer :: a, func
  15   real :: ent
  16   func = a*4
  17   return
  18 entry ent(a)
  19   ent = -a*2.0
  20   return
  21 end function func
  22 end module m1
  23
  24 module m2
  25   implicit none
  26 contains
  27 function func(a)
  28   implicit none
  29   integer :: a, func
  30   real :: func2
  31   func = a*8
  32   return
  33 entry ent(a) result(func2)
  34   func2 = -a*4.0
  35   return
  36 end function func
  37 end module m2
  38
  39 module m3
  40   implicit none
  41 contains
  42 function func(a) result(res)
  43   implicit none
  44   integer :: a, res
  45   real :: func2
  46   res = a*12
  47   return
  48 entry ent(a) result(func2)
  49   func2 = -a*6.0
  50   return
  51 end function func
  52 end module m3
  53
  54
  55 module m4
  56   implicit none
  57 contains
  58 function func(a) result(res)
  59   implicit none
  60   integer :: a, res
  61   real :: ent
  62   res = a*16
  63   return
  64 entry ent(a)
  65   ent = -a*8.0
  66   return
  67 end function func
  68 end module m4
  69
  70 program main
  71   implicit none
  72   call test1()
  73   call test2()
  74   call test3()
  75   call test4()
  76 contains
  77   subroutine test1()
  78     use m1
  79     implicit none
  80     if(func(3) /= 12) call abort()
  81     if(abs(ent(7) + 14.0) > tiny(1.0)) call abort()
  82   end subroutine test1
  83   subroutine test2()
  84     use m2
  85     implicit none
  86     if(func(9) /= 72) call abort()
  87     if(abs(ent(11) + 44.0) > tiny(1.0)) call abort()
  88   end subroutine test2
  89   subroutine test3()
  90     use m3
  91     implicit none
  92     if(func(13) /= 156) call abort()
  93     if(abs(ent(17) + 102.0) > tiny(1.0)) call abort()
  94   end subroutine test3
  95   subroutine test4()
  96     use m4
  97     implicit none
  98     if(func(23) /= 368) call abort()
  99     if(abs(ent(27) + 216.0) > tiny(1.0)) call abort()
 100   end subroutine test4
 101 end program main