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

   1 ! Test alternate entry points for functions when the result types
   2 ! of all entry points match
   3
   4         function f1 (str, i, j) result (r)
   5         character str*(*), r1*(*), r2*(*), r*(*)
   6         integer i, j
   7         r = str (i:j)
   8         return
   9         entry e1 (str, i, j) result (r1)
  10         i = i + 1
  11         entry e2 (str, i, j) result (r2)
  12         j = j - 1
  13         r2 = str (i:j)
  14         end function
  15
  16         function f3 () result (r)
  17         character r3*5, r4*5, r*5
  18         integer i
  19         r = 'ABCDE'
  20         return
  21         entry e3 (i) result (r3)
  22         entry e4 (i) result (r4)
  23         if (i .gt. 0) then
  24           r3 = 'abcde'
  25         else
  26           r4 = 'UVWXY'
  27         endif
  28         end function
  29
  30         program entrytest
  31         character f1*16, e1*16, e2*16, str*16, ret*16
  32         character f3*5, e3*5, e4*5
  33         integer i, j
  34         str = 'ABCDEFGHIJ'
  35         i = 2
  36         j = 6
  37         ret = f1 (str, i, j)
  38         if ((i .ne. 2) .or. (j .ne. 6)) STOP 1
  39         if (ret .ne. 'BCDEF') STOP 2
  40         ret = e1 (str, i, j)
  41         if ((i .ne. 3) .or. (j .ne. 5)) STOP 3
  42         if (ret .ne. 'CDE') STOP 4
  43         ret = e2 (str, i, j)
  44         if ((i .ne. 3) .or. (j .ne. 4)) STOP 5
  45         if (ret .ne. 'CD') STOP 6
  46         if (f3 () .ne. 'ABCDE') STOP 7
  47         if (e3 (1) .ne. 'abcde') STOP 8
  48         if (e4 (1) .ne. 'abcde') STOP 9
  49         if (e3 (0) .ne. 'UVWXY') STOP 10
  50         if (e4 (0) .ne. 'UVWXY') STOP 11
  51         end program