mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-31 03:00:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

f2c_4.f90: Add tests for complex functions

Browse Source 
2005-06-23  David Billinghurst  <David.Billinghurst@riotinto.com>

	* gfortran.dg/f2c_4.f90:  Add tests for complex functions
	* gfortran.dg/f2c_4.c: Likewise

From-SVN: r101261
This commit is contained in:
David Billinghurst 2005-06-23 03:01:57 +00:00
parent c08a3565c2
commit 127c51ed48
2 changed files with 116 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
gcc/testsuite/gfortran.dg/f2c_4.c
View File

@ -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;
}

48
gcc/testsuite/gfortran.dg/f2c_4.f90
View File

@ -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