gcc/testsuite/gfortran.dg/ISO_Fortran_binding_5.c

   1 /* Test fix for PR89385.  */
   2
   3 /* Contributed by Reinhold Bader  <Bader@lrz.de>  */
   4
   5 #include <stdio.h>
   6 #include <math.h>
   7 #include <ISO_Fortran_binding.h>
   8
   9 typedef struct {
  10   int i;
  11   float r[2];
  12 } cstruct;
  13
  14
  15 void Psub(CFI_cdesc_t *this, CFI_cdesc_t *that, int *ierr) {
  16     int status = 0;
  17     cstruct *cu;
  18     float *ct;
  19     CFI_dim_t *dim;
  20     if (this->elem_len != sizeof(float)) {
  21         printf("FAIL: this->elem_len %i\n",(int) this->elem_len);
  22         status++;
  23     }
  24     if (this->type != CFI_type_float) {
  25         printf("FAIL: this->type\n");
  26         status++;
  27     }
  28     if (this->rank != 2) {
  29         printf("FAIL: this->rank %i\n",this->rank);
  30         status++;
  31     }
  32     if (this->attribute != CFI_attribute_allocatable) {
  33         printf("FAIL: this->attribute\n");
  34         status++;
  35     }
  36     dim = this->dim;
  37     if (dim[0].lower_bound != 3 || dim[0].extent != 4)  {
  38         printf("FAIL: dim[0] %d %d\n", dim[0].lower_bound, dim[0].extent);
  39         status++;
  40     }
  41     if (dim[1].lower_bound != 1 || dim[1].extent != 5)  {
  42         printf("FAIL: dim[1] %d %d\n", dim[1].lower_bound, dim[1].extent);
  43         status++;
  44     }
  45
  46     if (that->elem_len != sizeof(cstruct)) {
  47         printf("FAIL: that->elem_len\n");
  48         status++;
  49     }
  50     if (that->type != CFI_type_struct) {
  51         printf("FAIL: that->type %d %d\n", that->type, CFI_type_struct);
  52         status++;
  53     }
  54      if (that->rank != 1) {
  55         printf("FAIL: that->rank\n");
  56         status++;
  57     }
  58     if (that->attribute != CFI_attribute_allocatable) {
  59         printf("FAIL: that->attribute\n");
  60         status++;
  61     }
  62     dim = that->dim;
  63     if (dim[0].lower_bound != 1 || dim[0].extent != 1)  {
  64         printf("FAIL: dim[0] %d %d\n" , dim[0].lower_bound, dim[0].extent);
  65         status++;
  66     }
  67     cu = (cstruct *) ((CFI_cdesc_t *) that)->base_addr;
  68     if (cu->i != 4 || fabs(cu->r[1] -  2.2) > 1.0e-6) {
  69         printf("FAIL: value of that %i %f %f\n",cu->i,cu->r[1],cu->r[2]);
  70         status++;
  71     }
  72
  73     ct = (float *) ((CFI_cdesc_t *) this)->base_addr;
  74     if ( fabs(ct[5] +  2.0) > 1.0e-6) {
  75         printf("FAIL: value of this %f\n",ct[5]);
  76         status++;
  77     }
  78
  79
  80     *ierr = status;
  81
  82 }
  83