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

   1 ! Test alternate entry points for functions when the result types
   2 ! of all entry points match
   3
   4         function f1 (a)
   5         integer a, b
   6         integer, pointer :: f1, e1
   7         allocate (f1)
   8         f1 = 15 + a
   9         return
  10         entry e1 (b)
  11         allocate (e1)
  12         e1 = 42 + b
  13         end function
  14         function f2 ()
  15         real, pointer :: f2, e2
  16         entry e2 ()
  17         allocate (e2)
  18         e2 = 45
  19         end function
  20         function f3 ()
  21         double precision, pointer :: f3, e3
  22         entry e3 ()
  23         allocate (f3)
  24         f3 = 47
  25         end function
  26         function f4 (a) result (r)
  27         double precision a, b
  28         double precision, pointer :: r, s
  29         allocate (r)
  30         r = 15 + a
  31         return
  32         entry e4 (b) result (s)
  33         allocate (s)
  34         s = 42 + b
  35         end function
  36         function f5 () result (r)
  37         integer, pointer :: r, s
  38         entry e5 () result (s)
  39         allocate (r)
  40         r = 45
  41         end function
  42         function f6 () result (r)
  43         real, pointer :: r, s
  44         entry e6 () result (s)
  45         allocate (s)
  46         s = 47
  47         end function
  48
  49         program entrytest
  50         interface
  51         function f1 (a)
  52         integer a
  53         integer, pointer :: f1
  54         end function
  55         function e1 (b)
  56         integer b
  57         integer, pointer :: e1
  58         end function
  59         function f2 ()
  60         real, pointer :: f2
  61         end function
  62         function e2 ()
  63         real, pointer :: e2
  64         end function
  65         function f3 ()
  66         double precision, pointer :: f3
  67         end function
  68         function e3 ()
  69         double precision, pointer :: e3
  70         end function
  71         function f4 (a)
  72         double precision a
  73         double precision, pointer :: f4
  74         end function
  75         function e4 (b)
  76         double precision b
  77         double precision, pointer :: e4
  78         end function
  79         function f5 ()
  80         integer, pointer :: f5
  81         end function
  82         function e5 ()
  83         integer, pointer :: e5
  84         end function
  85         function f6 ()
  86         real, pointer :: f6
  87         end function
  88         function e6 ()
  89         real, pointer :: e6
  90         end function
  91         end interface
  92         double precision d
  93         if (f1 (6) .ne. 21) STOP 1
  94         if (e1 (7) .ne. 49) STOP 2
  95         if (f2 () .ne. 45) STOP 3
  96         if (e2 () .ne. 45) STOP 4
  97         if (f3 () .ne. 47) STOP 5
  98         if (e3 () .ne. 47) STOP 6
  99         d = 17
 100         if (f4 (d) .ne. 32) STOP 7
 101         if (e4 (d) .ne. 59) STOP 8
 102         if (f5 () .ne. 45) STOP 9
 103         if (e5 () .ne. 45) STOP 10
 104         if (f6 () .ne. 47) STOP 11
 105         if (e6 () .ne. 47) STOP 12
 106         end