(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
cf-descriptor-8-c.c
       1  #include <stdlib.h>
       2  #include <stdio.h>
       3  
       4  #include <ISO_Fortran_binding.h>
       5  #include "dump-descriptors.h"
       6  
       7  extern void ctest (CFI_cdesc_t *a);
       8  extern void ftest1 (CFI_cdesc_t *a, int lb1, int lb2);
       9  extern void ftest2 (CFI_cdesc_t *a);
      10  
      11  struct m {
      12    int i;
      13    int j;
      14  };
      15  
      16  #define imax 10
      17  #define jmax 5
      18  
      19  void
      20  ctest (CFI_cdesc_t *a)
      21  {
      22    
      23    CFI_CDESC_T(2) bdesc;
      24    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      25    int i, j;
      26    CFI_index_t subscripts[2];
      27    struct m* mp;
      28  
      29    /* Dump the descriptor contents to test that we can access the fields
      30       correctly, etc.  */
      31    dump_CFI_cdesc_t (a);
      32  
      33    if (a->rank != 2)
      34      abort ();
      35    if (a->attribute != CFI_attribute_other)
      36      abort ();
      37  
      38    /* Fill in bdesc.  */
      39    subscripts[0] = a->dim[0].extent;
      40    subscripts[1] = a->dim[1].extent;
      41    check_CFI_status ("CFI_establish",
      42  		    CFI_establish (b, NULL, CFI_attribute_pointer,
      43  				   CFI_type_struct,
      44  				   sizeof (struct m), 2, subscripts));
      45  
      46    /* Pass the unassociated pointer descriptor b back to Fortran for
      47       checking.  */
      48    dump_CFI_cdesc_t (b);
      49    ftest2 (b);
      50  
      51    /* Point the descriptor b at the input argument array, and check that
      52       on the Fortran side.  */
      53    subscripts[0] = a->dim[0].lower_bound;
      54    subscripts[1] = a->dim[1].lower_bound;
      55    check_CFI_status ("CFI_setpointer",
      56  		    CFI_setpointer (b, a, subscripts));
      57    dump_CFI_cdesc_t (b);
      58    ftest1 (b, (int)subscripts[0], (int)subscripts[1]);
      59  
      60    /* Diddle the lower bounds and try again.  */
      61    subscripts[0] = 42;
      62    subscripts[1] = -69;
      63    check_CFI_status ("CFI_setpointer",
      64  		    CFI_setpointer (b, b, subscripts));
      65    dump_CFI_cdesc_t (b);
      66    ftest1 (b, 42, -69);
      67  
      68    /* Disassociate the pointer and check that.  */
      69    check_CFI_status ("CFI_setpointer",
      70  		    CFI_setpointer (b, NULL, NULL));
      71    dump_CFI_cdesc_t (b);
      72    ftest2 (b);
      73  }