gcc/testsuite/gfortran.dg/c_by_val.c

   1 /*  Passing from fortran to C by value, using %VAL.  */
   2
   3 #include <inttypes.h>
   4
   5 /* We used to #include <complex.h>, but this fails for some platforms
   6    (like cygwin) who don't have it yet.  */
   7 #define complex __complex__
   8 #define _Complex_I (1.0iF)
   9
  10 extern void f_to_f__ (float*, float, float*, float**);
  11 extern void f_to_f8__ (double*, double, double*, double**);
  12 extern void i_to_i__ (int*, int, int*, int**);
  13 extern void i_to_i8__ (int64_t*, int64_t, int64_t*, int64_t**);
  14 extern void c_to_c__ (complex float*, complex float, complex float*, complex float**);
  15 extern void c_to_c8__ (complex double*, complex double, complex double*, complex double**);
  16 extern void abort (void);
  17
  18 void
  19 f_to_f__(float *retval, float a1, float *a2, float **a3)
  20 {
  21   if ( a1 != *a2 ) abort();
  22   if ( a1 != **a3 ) abort();
  23   a1 = 0.0;
  24   *retval = *a2 * 2.0;
  25   return;
  26 }
  27
  28 void
  29 f_to_f8__(double *retval, double a1, double *a2, double **a3)
  30 {
  31   if ( a1 != *a2 ) abort();
  32   if ( a1 != **a3 ) abort();
  33   a1 = 0.0;
  34   *retval = *a2 * 2.0;
  35   return;
  36 }
  37
  38 void
  39 i_to_i__(int *retval, int i1, int *i2, int **i3)
  40 {
  41   if ( i1 != *i2 ) abort();
  42   if ( i1 != **i3 ) abort();
  43   i1 = 0;
  44   *retval = *i2 * 3;
  45   return;
  46 }
  47
  48 void
  49 i_to_i8__(int64_t *retval, int64_t i1, int64_t *i2, int64_t **i3)
  50 {
  51   if ( i1 != *i2 ) abort();
  52   if ( i1 != **i3 ) abort();
  53   i1 = 0;
  54   *retval = *i2 * 3;
  55   return;
  56 }
  57
  58 void
  59 c_to_c__(complex float *retval, complex float c1, complex float *c2, complex float **c3)
  60 {
  61   if ( c1 != *c2    ) abort();
  62   if ( c1 != *(*c3) ) abort();
  63   c1 = 0.0 + 0.0 * _Complex_I;
  64   *retval = (*c2) * 4.0;
  65   return;
  66 }
  67
  68 void
  69 c_to_c8__(complex double *retval, complex double c1, complex double *c2, complex double **c3)
  70 {
  71   if ( c1 != *c2    ) abort();
  72   if ( c1 != *(*c3) ) abort();
  73   c1 = 0.0 +  0.0 * _Complex_I;;
  74   *retval = (*c2) * 4.0;
  75   return;
  76 }