summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/f2c_1.f90
blob: 9f45d05bf22f75dd0e7ecc7a3b6cb763ec7cbc96 (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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
! Make sure the f2c calling conventions work
! { dg-do run }
! { dg-options "-ff2c" }

function f(x)
  f = x
end function f

complex function c(a,b)
  c = cmplx (a,b)
end function c

double complex function d(e,f)
  double precision e, f
  d = cmplx (e, f, kind(d))
end function d

subroutine test_with_interface()
  interface
     real function f(x)
       real::x
     end function f
  end interface

  interface
     complex function c(a,b)
       real::a,b
     end function c
  end interface

  interface
     double complex function d(e,f)
       double precision::e,f
     end function d
  end interface
  
  double precision z, w

  x = 8.625
  if (x /= f(x)) call abort ()
  y = f(x)
  if (x /= y) call abort ()

  a = 1.
  b = -1.
  if (c(a,b) /= cmplx(a,b)) call abort ()

  z = 1.
  w = -1.
  if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
end subroutine test_with_interface

external f, c, d
real f
complex c
double complex d
double precision z, w

x = 8.625
if (x /= f(x)) call abort ()
y = f(x)
if (x /= y) call abort ()

a = 1.
b = -1.
if (c(a,b) /= cmplx(a,b)) call abort ()

z = 1.
w = -1.
if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()

call test_with_interface ()
end