gcc/testsuite/gfortran.dg/c_by_val.c

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