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