summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/f2c_4.f90
blob: a0d1909bf2f4a8cb1928608eaf96291184aed67e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
! { dg-do run }
! { dg-additional-sources f2c_4.c }
! { dg-options "-ff2c -w" }

! Check -ff2c calling conventions
!   Return value of REAL function is promoted to C type double
!   Return value of COMPLEX function is via an extra argument in the
!    calling sequence that points to where to store the return value
!   Addional underscore appended to function name
program f2c_4
  complex c, f2c_4k, f2c_4l
  double complex z, f2c_4m, f2c_4n
  integer i

  ! Promotion of REAL function
  call f2c_4a()

  ! Return COMPLEX arg - call Fortran routines from C
  call f2c_4c()
  call f2c_4e()
  call f2c_4g()
  call f2c_4i()

  !  Return COMPLEX arg - call C routines from Fortran 
  c = cmplx(1234.0,5678.0)
  z = dcmplx(1234.0d0,5678.0d0)
  if ( c .ne. f2c_4k(c) )   call abort
  if ( c .ne. f2c_4l(i,c) ) call abort
  if ( z .ne. f2c_4m(z) )   call abort
  if ( z .ne. f2c_4n(i,z) ) call abort

end

real function f2c_4b(x)
  double precision x
  f2c_4b = x
end

complex function f2c_4d(x)
  complex x
  f2c_4d = x
end

complex function f2c_4f(i,x)
  complex x
  integer i
  f2c_4f = x
end

double complex function f2c_4h(x)
  double complex x
  f2c_4h = x
end

double complex function f2c_4j(i,x)
  double complex x
  f2c_4j = x
end