gcc/testsuite/gfortran.dg/bind_c_dts_driver.c

   1 double fabs (double);
   2
   3 /* interops with myftype_1 */
   4 typedef struct {
   5    int m, n;
   6    float r;
   7 } myctype_t;
   8
   9 /* interops with particle in f90 */
  10 typedef struct particle
  11 {
  12    double x;  /* x position */
  13    double vx; /* velocity in x direction */
  14    double y;  /* y position */
  15    double vy; /* velocity in y direction */
  16    double z;  /* z position */
  17    double vz; /* velocity in z direction */
  18    double m;  /* mass */
  19 }particle_t;
  20
  21 extern void abort(void);
  22 void types_test(particle_t *my_particles, int num_particles);
  23 /* declared in the fortran module bind_c_dts */
  24 extern myctype_t myDerived;
  25
  26 int main(int argc, char **argv)
  27 {
  28    particle_t my_particles[100];
  29
  30    /* the fortran code will modify the middle particle */
  31    my_particles[49].x = 1.0;
  32    my_particles[49].vx = 1.0;
  33    my_particles[49].y = 1.0;
  34    my_particles[49].vy = 1.0;
  35    my_particles[49].z = 1.0;
  36    my_particles[49].vz = 1.0;
  37    my_particles[49].m = 1.0;
  38
  39    myDerived.m = 1;
  40    myDerived.n = 2;
  41    myDerived.r = 3.0;
  42
  43    types_test(&(my_particles[0]), 100);
  44
  45    if(fabs(my_particles[49].x - 1.2) > 0.00000000)
  46       abort();
  47    if(fabs(my_particles[49].vx - 1.2) > 0.00000000)
  48       abort();
  49    if(fabs(my_particles[49].y - 1.2) > 0.00000000)
  50       abort();
  51    if(fabs(my_particles[49].vy - 1.2) > 0.00000000)
  52       abort();
  53    if(fabs(my_particles[49].z - 1.2) > 0.00000000)
  54       abort();
  55    if(fabs(my_particles[49].vz - 1.2) > 0.00000000)
  56       abort();
  57    if(fabs(my_particles[49].m - 1.2) > 0.00000000)
  58       abort();
  59    if(myDerived.m != 2)
  60       abort();
  61    if(myDerived.n != 3)
  62       abort();
  63    if(fabs(myDerived.r - 4.0) > 0.00000000)
  64       abort();
  65    return 0;
  66 }/* end main() */