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 typedef float real;
   9 typedef double doublereal;
  10 typedef struct { real r, i; } complex;
  11 typedef struct { doublereal r, i; } doublecomplex;
  12
  13 extern double f2c_4b__(double *);
  14 extern void f2c_4d__( complex *, complex *);
  15 extern void f2c_4f__( complex *, int *,complex *);
  16 extern void f2c_4h__( doublecomplex *, doublecomplex *);
  17 extern void f2c_4j__( doublecomplex *, int *, doublecomplex *);
  18 extern void abort (void);
  19
  20 void f2c_4a__(void) {
  21   double a,b;
  22   a = 1023.0;
  23   b=f2c_4b__(&a);
  24   if ( a != b ) abort();
  25 }
  26
  27 void f2c_4c__(void) {
  28   complex x,ret_val;
  29   x.r = 1234;
  30   x.i = 5678;
  31   f2c_4d__(&ret_val,&x);
  32   if ( x.r != ret_val.r && x.i != ret_val.i ) abort();
  33 }
  34
  35 void f2c_4e__(void) {
  36   complex x,ret_val;
  37   int i=0;
  38   x.r = 1234;
  39   x.i = 5678;
  40   f2c_4f__(&ret_val,&i,&x);
  41   if ( x.r != ret_val.r && x.i != ret_val.i ) abort();
  42 }
  43
  44 void f2c_4g__(void) {
  45   doublecomplex x,ret_val;
  46   x.r = 1234;
  47   x.i = 5678.0f;
  48   f2c_4h__(&ret_val,&x);
  49   if ( x.r != ret_val.r && x.i != ret_val.i ) abort();
  50 }
  51
  52 void f2c_4i__(void) {
  53   doublecomplex x,ret_val;
  54   int i=0;
  55   x.r = 1234.0f;
  56   x.i = 5678.0f;
  57   f2c_4j__(&ret_val,&i,&x);
  58   if ( x.r != ret_val.r && x.i != ret_val.i ) abort();
  59 }
  60
  61 void f2c_4k__(complex *ret_val, complex *x) {
  62   ret_val->r = x->r;
  63   ret_val->i = x->i;
  64 }
  65
  66 void f2c_4l__(complex *ret_val, int *i, complex *x) {
  67   ret_val->r = x->r;
  68   ret_val->i = x->i;
  69 }
  70
  71 void f2c_4m__(doublecomplex *ret_val, doublecomplex *x) {
  72   ret_val->r = x->r;
  73   ret_val->i = x->i;
  74 }
  75
  76 void f2c_4n__(doublecomplex *ret_val, int *i, doublecomplex *x) {
  77   ret_val->r = x->r;
  78   ret_val->i = x->i;
  79 }