(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
cf-descriptor-7-c.c
       1  #include <stdlib.h>
       2  #include <stdio.h>
       3  #include <stddef.h>
       4  
       5  #include <ISO_Fortran_binding.h>
       6  #include "dump-descriptors.h"
       7  
       8  extern void ctest (CFI_cdesc_t *a);
       9  extern void ftest (CFI_cdesc_t *iarray, CFI_cdesc_t *jarray);
      10  
      11  struct m {
      12    int i;
      13    int j;
      14  };
      15  
      16  void
      17  ctest (CFI_cdesc_t *a)
      18  {
      19    CFI_CDESC_T(2) idesc;
      20    CFI_cdesc_t *iarray = (CFI_cdesc_t *) &idesc;
      21    CFI_CDESC_T(2) jdesc;
      22    CFI_cdesc_t *jarray = (CFI_cdesc_t *) &jdesc;
      23    int i, j;
      24  
      25    /* Dump the descriptor contents to test that we can access the fields
      26       correctly, etc.  */
      27    dump_CFI_cdesc_t (a);
      28  
      29    if (a->rank != 2)
      30      abort ();
      31  
      32    /* Fill in the new descriptors.  */
      33    check_CFI_status ("CFI_establish",
      34  		    CFI_establish (iarray, NULL, CFI_attribute_pointer,
      35  				   CFI_type_int,
      36  				   sizeof (int), 2, NULL));
      37    check_CFI_status ("CFI_select_part",
      38  		    CFI_select_part (iarray, a, offsetof (struct m, i),
      39  				     sizeof (int)));
      40  
      41    check_CFI_status ("CFI_establish",
      42  		    CFI_establish (jarray, NULL, CFI_attribute_pointer,
      43  				   CFI_type_int,
      44  				   sizeof (int), 2, NULL));
      45    check_CFI_status ("CFI_select_part",
      46  		    CFI_select_part (jarray, a, offsetof (struct m, j),
      47  				     sizeof (int)));
      48    
      49    /* Sanity checking to make sure the descriptor has been initialized
      50       properly.  */
      51    dump_CFI_cdesc_t (iarray);
      52    if (iarray->version != CFI_VERSION)
      53      abort ();
      54    if (iarray->rank != 2)
      55      abort ();
      56    if (iarray->attribute != CFI_attribute_pointer)
      57      abort ();
      58    if (!iarray->base_addr)
      59      abort ();
      60    if (iarray->dim[0].extent != a->dim[0].extent)
      61      abort ();
      62    if (iarray->dim[1].extent != a->dim[1].extent)
      63      abort ();
      64  
      65    dump_CFI_cdesc_t (jarray);
      66    if (jarray->version != CFI_VERSION)
      67      abort ();
      68    if (jarray->rank != 2)
      69      abort ();
      70    if (jarray->attribute != CFI_attribute_pointer)
      71      abort ();
      72    if (!jarray->base_addr)
      73      abort ();
      74    if (jarray->dim[0].extent != a->dim[0].extent)
      75      abort ();
      76    if (jarray->dim[1].extent != a->dim[1].extent)
      77      abort ();
      78  
      79    /* Call back into Fortran.  */
      80    ftest (iarray, jarray);
      81  }