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) call abort ()
  94         if (e1 (7) .ne. 49) call abort ()
  95         if (f2 () .ne. 45) call abort ()
  96         if (e2 () .ne. 45) call abort ()
  97         if (f3 () .ne. 47) call abort ()
  98         if (e3 () .ne. 47) call abort ()
  99         d = 17
 100         if (f4 (d) .ne. 32) call abort ()
 101         if (e4 (d) .ne. 59) call abort ()
 102         if (f5 () .ne. 45) call abort ()
 103         if (e5 () .ne. 45) call abort ()
 104         if (f6 () .ne. 47) call abort ()
 105         if (e6 () .ne. 47) call abort ()
 106         end