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