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