From 127c51ed4859825f29c3ced46107e7b4b3ee98c1 Mon Sep 17 00:00:00 2001 From: David Billinghurst Date: Thu, 23 Jun 2005 03:01:57 +0000 Subject: [PATCH] f2c_4.f90: Add tests for complex functions 2005-06-23 David Billinghurst * gfortran.dg/f2c_4.f90: Add tests for complex functions * gfortran.dg/f2c_4.c: Likewise From-SVN: r101261 --- gcc/testsuite/gfortran.dg/f2c_4.c | 70 +++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/f2c_4.f90 | 48 +++++++++++++++++++- 2 files changed, 116 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/f2c_4.c b/gcc/testsuite/gfortran.dg/f2c_4.c index 0d64fc89b14..58f3ef1a2ab 100755 --- a/gcc/testsuite/gfortran.dg/f2c_4.c +++ b/gcc/testsuite/gfortran.dg/f2c_4.c @@ -1,4 +1,20 @@ +/* Check -ff2c calling conventions + Return value of COMPLEX function is via an extra argument in the + calling sequence that points to where to store the return value + Additional underscore appended to function name + + Simplified from f2c output and tested with g77 */ + +typedef float real; +typedef double doublereal; +typedef struct { real r, i; } complex; +typedef struct { doublereal r, i; } doublecomplex; + extern double f2c_4b__(double *); +extern void f2c_4d__( complex *, complex *); +extern void f2c_4f__( complex *, int *,complex *); +extern void f2c_4h__( doublecomplex *, doublecomplex *); +extern void f2c_4j__( doublecomplex *, int *, doublecomplex *); extern void abort (void); void f2c_4a__(void) { @@ -7,3 +23,57 @@ void f2c_4a__(void) { b=f2c_4b__(&a); if ( a != b ) abort(); } + +void f2c_4c__(void) { + complex x,ret_val; + x.r = 1234; + x.i = 5678; + f2c_4d__(&ret_val,&x); + if ( x.r != ret_val.r && x.i != ret_val.i ) abort(); +} + +void f2c_4e__(void) { + complex x,ret_val; + int i=0; + x.r = 1234; + x.i = 5678; + f2c_4f__(&ret_val,&i,&x); + if ( x.r != ret_val.r && x.i != ret_val.i ) abort(); +} + +void f2c_4g__(void) { + doublecomplex x,ret_val; + x.r = 1234; + x.i = 5678.0f; + f2c_4h__(&ret_val,&x); + if ( x.r != ret_val.r && x.i != ret_val.i ) abort(); +} + +void f2c_4i__(void) { + doublecomplex x,ret_val; + int i=0; + x.r = 1234.0f; + x.i = 5678.0f; + f2c_4j__(&ret_val,&i,&x); + if ( x.r != ret_val.r && x.i != ret_val.i ) abort(); +} + +void f2c_4k__(complex *ret_val, complex *x) { + ret_val->r = x->r; + ret_val->i = x->i; +} + +void f2c_4l__(complex *ret_val, int *i, complex *x) { + ret_val->r = x->r; + ret_val->i = x->i; +} + +void f2c_4m__(doublecomplex *ret_val, doublecomplex *x) { + ret_val->r = x->r; + ret_val->i = x->i; +} + +void f2c_4n__(doublecomplex *ret_val, int *i, doublecomplex *x) { + ret_val->r = x->r; + ret_val->i = x->i; +} diff --git a/gcc/testsuite/gfortran.dg/f2c_4.f90 b/gcc/testsuite/gfortran.dg/f2c_4.f90 index a03b4f8b593..a0d1909bf2f 100755 --- a/gcc/testsuite/gfortran.dg/f2c_4.f90 +++ b/gcc/testsuite/gfortran.dg/f2c_4.f90 @@ -4,11 +4,55 @@ ! Check -ff2c calling conventions ! Return value of REAL function is promoted to C type double -! Addional underscore appended to function name -call f2c_4a() +! Return value of COMPLEX function is via an extra argument in the +! calling sequence that points to where to store the return value +! Addional underscore appended to function name +program f2c_4 + complex c, f2c_4k, f2c_4l + double complex z, f2c_4m, f2c_4n + integer i + + ! Promotion of REAL function + call f2c_4a() + + ! Return COMPLEX arg - call Fortran routines from C + call f2c_4c() + call f2c_4e() + call f2c_4g() + call f2c_4i() + + ! Return COMPLEX arg - call C routines from Fortran + c = cmplx(1234.0,5678.0) + z = dcmplx(1234.0d0,5678.0d0) + if ( c .ne. f2c_4k(c) ) call abort + if ( c .ne. f2c_4l(i,c) ) call abort + if ( z .ne. f2c_4m(z) ) call abort + if ( z .ne. f2c_4n(i,z) ) call abort + end real function f2c_4b(x) double precision x f2c_4b = x end + +complex function f2c_4d(x) + complex x + f2c_4d = x +end + +complex function f2c_4f(i,x) + complex x + integer i + f2c_4f = x +end + +double complex function f2c_4h(x) + double complex x + f2c_4h = x +end + +double complex function f2c_4j(i,x) + double complex x + f2c_4j = x +end -- 2.30.2