gcc/testsuite/gfortran.dg/f2c_7.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ff2c" }
   3 ! Verifies that array results work with -ff2c
   4 ! try all permutations of result clause in function yes/no
   5 !                     and result clause in interface yes/no
   6 ! this is not possible in Fortran 77, but this exercises a previously
   7 ! buggy codepath
   8 function c() result (r)
   9   complex :: r(5)
  10   r = 0.
  11 end function c
  12
  13 function d()
  14   complex :: d(5)
  15   d = 1.
  16 end function d
  17
  18 subroutine test_without_result
  19 interface
  20    function c ()
  21      complex :: c(5)
  22    end function c
  23 end interface
  24 interface
  25    function d ()
  26      complex :: d(5)
  27    end function d
  28 end interface
  29 complex z(5)
  30 z = c()
  31 if (any(z /= 0.)) STOP 1
  32 z = d()
  33 if (any(z /= 1.)) STOP 2
  34 end subroutine test_without_result
  35
  36 subroutine test_with_result
  37 interface
  38    function c () result(r)
  39      complex :: r(5)
  40    end function c
  41 end interface
  42 interface
  43    function d () result(r)
  44      complex :: r(5)
  45    end function d
  46 end interface
  47 complex z(5)
  48 z = c()
  49 if (any(z /= 0.)) STOP 3
  50 z = d()
  51 if (any(z /= 1.)) STOP 4
  52 end subroutine test_with_result
  53
  54 call test_without_result
  55 call test_with_result
  56 end
  57