1! Make sure the f2c calling conventions work
2! { dg-do run }
3! { dg-options "-ff2c" }
4
5function f(x)
6  f = x
7end function f
8
9complex function c(a,b)
10  c = cmplx (a,b)
11end function c
12
13double complex function d(e,f)
14  double precision e, f
15  d = cmplx (e, f, kind(d))
16end function d
17
18subroutine test_with_interface()
19  interface
20     real function f(x)
21       real::x
22     end function f
23  end interface
24
25  interface
26     complex function c(a,b)
27       real::a,b
28     end function c
29  end interface
30
31  interface
32     double complex function d(e,f)
33       double precision::e,f
34     end function d
35  end interface
36
37  double precision z, w
38
39  x = 8.625
40  if (x /= f(x)) call abort ()
41  y = f(x)
42  if (x /= y) call abort ()
43
44  a = 1.
45  b = -1.
46  if (c(a,b) /= cmplx(a,b)) call abort ()
47
48  z = 1.
49  w = -1.
50  if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
51end subroutine test_with_interface
52
53external f, c, d
54real f
55complex c
56double complex d
57double precision z, w
58
59x = 8.625
60if (x /= f(x)) call abort ()
61y = f(x)
62if (x /= y) call abort ()
63
64a = 1.
65b = -1.
66if (c(a,b) /= cmplx(a,b)) call abort ()
67
68z = 1.
69w = -1.
70if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
71
72call test_with_interface ()
73end
74