gcc/testsuite/gfortran.dg/f2c_4.c

   1 /*  Check -ff2c calling conventions
   2     Return value of COMPLEX function is via an extra argument in the
   3      calling sequence that points to where to store the return value
   4     Additional underscore appended to function name
   5
   6    Simplified from f2c output and tested with g77 */
   7
   8 /* We used to #include <complex.h>, but this fails for some platforms
   9    (like cygwin) who don't have it yet.  */
  10 #define complex __complex__
  11 #define _Complex_I (1.0iF)
  12
  13 typedef float real;
  14 typedef double doublereal;
  15
  16 extern double f2c_4b__(double *);
  17 extern void f2c_4d__( complex float *, complex float *);
  18 extern void f2c_4f__( complex float *, int *,complex float *);
  19 extern void f2c_4h__( complex double *, complex double *);
  20 extern void f2c_4j__( complex double *, int *, complex double *);
  21 extern void abort (void);
  22
  23 void f2c_4a__(void) {
  24   double a,b;
  25   a = 1023.0;
  26   b=f2c_4b__(&a);
  27   if ( a != b ) abort();
  28 }
  29
  30 void f2c_4c__(void) {
  31   complex float x,ret_val;
  32   x = 1234 + 5678 * _Complex_I;
  33   f2c_4d__(&ret_val,&x);
  34   if ( x != ret_val ) abort();
  35 }
  36
  37 void f2c_4e__(void) {
  38   complex float x,ret_val;
  39   int i=0;
  40   x = 1234 + 5678 * _Complex_I;
  41   f2c_4f__(&ret_val,&i,&x);
  42   if ( x != ret_val ) abort();
  43 }
  44
  45 void f2c_4g__(void) {
  46   complex double x,ret_val;
  47   x = 1234 + 5678.0f * _Complex_I;
  48   f2c_4h__(&ret_val,&x);
  49   if ( x != ret_val ) abort();
  50 }
  51
  52 void f2c_4i__(void) {
  53   complex double x,ret_val;
  54   int i=0;
  55   x = 1234.0f + 5678.0f * _Complex_I;
  56   f2c_4j__(&ret_val,&i,&x);
  57   if ( x != ret_val ) abort();
  58 }
  59
  60 void f2c_4k__(complex float *ret_val, complex float *x) {
  61   *ret_val = *x;
  62 }
  63
  64 void f2c_4l__(complex float *ret_val, int *i, complex float *x) {
  65   *ret_val = *x;
  66 }
  67
  68 void f2c_4m__(complex double *ret_val, complex double *x) {
  69   *ret_val = *x;
  70 }
  71
  72 void f2c_4n__(complex double *ret_val, int *i, complex double *x) {
  73   *ret_val = *x;
  74 }