(root)/
gcc-13.2.0/
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  }