gcc/testsuite/gfortran.dg/f2c_9.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ff2c" }
   3 ! PR 34868
   4
   5 function f(a) result(res)
   6   implicit none
   7   real(8), intent(in) :: a(:)
   8   complex(8) :: res
   9
  10   res = cmplx(sum(a),product(a),8)
  11 end function f
  12
  13 function g(a)
  14   implicit none
  15   real(8), intent(in) :: a(:)
  16   complex(8) :: g
  17
  18   g = cmplx(sum(a),product(a),8)
  19 end function g
  20
  21 program test
  22   real(8) :: a(1,5)
  23   complex(8) :: c
  24   integer :: i
  25
  26   interface
  27     complex(8) function f(a)
  28       real(8), intent(in) :: a(:)
  29     end function f
  30     function g(a) result(res)
  31       real(8), intent(in) :: a(:)
  32       complex(8) :: res
  33     end function g
  34   end interface
  35
  36   do i = 1, 5
  37     a(1,i) = sqrt(real(i,kind(a)))
  38   end do
  39
  40   c = f(a(1,:))
  41   call check (real(c), sum(a))
  42   call check (imag(c), product(a))
  43
  44   c = g(a(1,:))
  45   call check (real(c), sum(a))
  46   call check (imag(c), product(a))
  47 contains
  48   subroutine check (a, b)
  49     real(8), intent(in) :: a, b
  50     if (abs(a - b) > 1.e-10_8) call abort
  51   end subroutine check
  52 end program test