OSDN Git Service

gcc/fortran/
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / f2c_1.f90
1 ! Make sure the f2c calling conventions work
2 ! { dg-do run }
3 ! { dg-options "-ff2c" }
4
5 function f(x)
6   f = x
7 end function f
8
9 complex function c(a,b)
10   c = cmplx (a,b)
11 end function c
12
13 double complex function d(e,f)
14   double precision e, f
15   d = cmplx (e, f, kind(d))
16 end function d
17
18 subroutine 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 ()
51 end subroutine test_with_interface
52
53 external f, c, d
54 real f
55 complex c
56 double complex d
57 double precision z, w
58
59 x = 8.625
60 if (x /= f(x)) call abort ()
61 y = f(x)
62 if (x /= y) call abort ()
63
64 a = 1.
65 b = -1.
66 if (c(a,b) /= cmplx(a,b)) call abort ()
67
68 z = 1.
69 w = -1.
70 if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
71
72 call test_with_interface ()
73 end