old-autovect-branch/gcc/testsuite/gfortran.fortran-torture/execute/entry_6.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, dimension (2, 2) :: a, b, f1, e1
   6         f1 (:, :) = 15 + a (1, 1)
   7         return
   8         entry e1 (b)
   9         e1 (:, :) = 42 + b (1, 1)
  10         end function
  11         function f2 ()
  12         real, dimension (2, 2) :: f2, e2
  13         entry e2 ()
  14         e2 (:, :) = 45
  15         end function
  16         function f3 ()
  17         double precision, dimension (2, 2) :: a, b, f3, e3
  18         entry e3 ()
  19         f3 (:, :) = 47
  20         end function
  21         function f4 (a) result (r)
  22         double precision, dimension (2, 2) :: a, b, r, s
  23         r (:, :) = 15 + a (1, 1)
  24         return
  25         entry e4 (b) result (s)
  26         s (:, :) = 42 + b (1, 1)
  27         end function
  28         function f5 () result (r)
  29         integer, dimension (2, 2) :: r, s
  30         entry e5 () result (s)
  31         r (:, :) = 45
  32         end function
  33         function f6 () result (r)
  34         real, dimension (2, 2) :: r, s
  35         entry e6 () result (s)
  36         s (:, :) = 47
  37         end function
  38
  39         program entrytest
  40         interface
  41         function f1 (a)
  42         integer, dimension (2, 2) :: a, f1
  43         end function
  44         function e1 (b)
  45         integer, dimension (2, 2) :: b, e1
  46         end function
  47         function f2 ()
  48         real, dimension (2, 2) :: f2
  49         end function
  50         function e2 ()
  51         real, dimension (2, 2) :: e2
  52         end function
  53         function f3 ()
  54         double precision, dimension (2, 2) :: f3
  55         end function
  56         function e3 ()
  57         double precision, dimension (2, 2) :: e3
  58         end function
  59         function f4 (a)
  60         double precision, dimension (2, 2) :: a, f4
  61         end function
  62         function e4 (b)
  63         double precision, dimension (2, 2) :: b, e4
  64         end function
  65         function f5 ()
  66         integer, dimension (2, 2) :: f5
  67         end function
  68         function e5 ()
  69         integer, dimension (2, 2) :: e5
  70         end function
  71         function f6 ()
  72         real, dimension (2, 2) :: f6
  73         end function
  74         function e6 ()
  75         real, dimension (2, 2) :: e6
  76         end function
  77         end interface
  78         integer, dimension (2, 2) :: i, j
  79         real, dimension (2, 2) :: r
  80         double precision, dimension (2, 2) :: d, e
  81         i (:, :) = 6
  82         j = f1 (i)
  83         if (any (j .ne. 21)) call abort ()
  84         i (:, :) = 7
  85         j = e1 (i)
  86         j (:, :) = 49
  87         if (any (j .ne. 49)) call abort ()
  88         r = f2 ()
  89         if (any (r .ne. 45)) call abort ()
  90         r = e2 ()
  91         if (any (r .ne. 45)) call abort ()
  92         e = f3 ()
  93         if (any (e .ne. 47)) call abort ()
  94         e = e3 ()
  95         if (any (e .ne. 47)) call abort ()
  96         d (:, :) = 17
  97         e = f4 (d)
  98         if (any (e .ne. 32)) call abort ()
  99         e = e4 (d)
 100         if (any (e .ne. 59)) call abort ()
 101         j = f5 ()
 102         if (any (j .ne. 45)) call abort ()
 103         j = e5 ()
 104         if (any (j .ne. 45)) call abort ()
 105         r = f6 ()
 106         if (any (r .ne. 47)) call abort ()
 107         r = e6 ()
 108         if (any (r .ne. 47)) call abort ()
 109         end