old-autovect-branch/gcc/testsuite/gfortran.fortran-torture/execute/entry_1.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, f1, e1
   6         f1 = 15 + a
   7         return
   8         entry e1 (b)
   9         e1 = 42 + b
  10         end function
  11         function f2 ()
  12         real f2, e2
  13         entry e2 ()
  14         e2 = 45
  15         end function
  16         function f3 ()
  17         double precision a, b, f3, e3
  18         entry e3 ()
  19         f3 = 47
  20         end function
  21         function f4 (a) result (r)
  22         double precision a, b, r, s
  23         r = 15 + a
  24         return
  25         entry e4 (b) result (s)
  26         s = 42 + b
  27         end function
  28         function f5 () result (r)
  29         integer r, s
  30         entry e5 () result (s)
  31         r = 45
  32         end function
  33         function f6 () result (r)
  34         real r, s
  35         entry e6 () result (s)
  36         s = 47
  37         end function
  38         function f7 ()
  39         entry e7 ()
  40         e7 = 163
  41         end function
  42         function f8 () result (r)
  43         entry e8 ()
  44         e8 = 115
  45         end function
  46         function f9 ()
  47         entry e9 () result (r)
  48         r = 119
  49         end function
  50
  51         program entrytest
  52         integer f1, e1, f5, e5
  53         real f2, e2, f6, e6, f7, e7, f8, e8, f9, e9
  54         double precision f3, e3, f4, e4, d
  55         if (f1 (6) .ne. 21) call abort ()
  56         if (e1 (7) .ne. 49) call abort ()
  57         if (f2 () .ne. 45) call abort ()
  58         if (e2 () .ne. 45) call abort ()
  59         if (f3 () .ne. 47) call abort ()
  60         if (e3 () .ne. 47) call abort ()
  61         d = 17
  62         if (f4 (d) .ne. 32) call abort ()
  63         if (e4 (d) .ne. 59) call abort ()
  64         if (f5 () .ne. 45) call abort ()
  65         if (e5 () .ne. 45) call abort ()
  66         if (f6 () .ne. 47) call abort ()
  67         if (e6 () .ne. 47) call abort ()
  68         if (f7 () .ne. 163) call abort ()
  69         if (e7 () .ne. 163) call abort ()
  70         if (f8 () .ne. 115) call abort ()
  71         if (e8 () .ne. 115) call abort ()
  72         if (f9 () .ne. 119) call abort ()
  73         if (e9 () .ne. 119) call abort ()
  74         end