gcc/testsuite/gfortran.fortran-torture/execute/entry_4.f90

   1 ! Test alternate entry points for functions when the result types
   2 ! of all entry points don't match
   3
   4         integer function f1 (a)
   5         integer a, b
   6         double precision e1
   7         f1 = 15 + a
   8         return
   9         entry e1 (b)
  10         e1 = 42 + b
  11         end function
  12         complex function f2 (a)
  13         integer a
  14         logical e2
  15         entry e2 (a)
  16         if (a .gt. 0) then
  17           e2 = a .lt. 46
  18         else
  19           f2 = 45
  20         endif
  21         end function
  22         function f3 (a) result (r)
  23         integer a, b
  24         real r
  25         logical s
  26         complex c
  27         r = 15 + a
  28         return
  29         entry e3 (b) result (s)
  30         s = b .eq. 42
  31         return
  32         entry g3 (b) result (c)
  33         c = b + 11
  34         end function
  35         function f4 (a) result (r)
  36         logical r
  37         integer a, s
  38         double precision t
  39         entry e4 (a) result (s)
  40         entry g4 (a) result (t)
  41         r = a .lt. 0
  42         if (a .eq. 0) s = 16 + a
  43         if (a .gt. 0) t = 17 + a
  44         end function
  45
  46         program entrytest
  47         integer f1, e4
  48         real f3
  49         double precision e1, g4
  50         logical e2, e3, f4
  51         complex f2, g3
  52         if (f1 (6) .ne. 21) STOP 1
  53         if (e1 (7) .ne. 49) STOP 2
  54         if (f2 (0) .ne. 45) STOP 3
  55         if (.not. e2 (45)) STOP 4
  56         if (e2 (46)) STOP 5
  57         if (f3 (17) .ne. 32) STOP 6
  58         if (.not. e3 (42)) STOP 7
  59         if (e3 (41)) STOP 8
  60         if (g3 (12) .ne. 23) STOP 9
  61         if (.not. f4 (-5)) STOP 10
  62         if (e4 (0) .ne. 16) STOP 11
  63         if (g4 (2) .ne. 19) STOP 12
  64         end