(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
cf-descriptor-6-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, int lb1, int lb2, int ub1, int ub2, int step1, int step2);
       8  extern void ftest (CFI_cdesc_t *b);
       9  
      10  struct m {
      11    int i;
      12    int j;
      13  };
      14  
      15  void
      16  ctest (CFI_cdesc_t *a, int lb1, int lb2, int ub1, int ub2,
      17         int step1, int step2)
      18  {
      19    CFI_CDESC_T(2) bdesc;
      20    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      21    CFI_index_t lb[2], ub[2], step[2];
      22    int i, j;
      23  
      24    fprintf (stderr, "got new bound info (%d:%d:%d, %d:%d:%d)\n",
      25  	   lb1, ub1, step1, lb2, ub2, step2);
      26    lb[0] = lb1 - 1;
      27    lb[1] = lb2 - 1;
      28    ub[0] = ub1 - 1;
      29    ub[1] = ub2 - 1;
      30    step[0] = step1;
      31    step[1] = step2;
      32  
      33    /* Dump the descriptor contents to test that we can access the fields
      34       correctly, etc.  */
      35    dump_CFI_cdesc_t (a);
      36  
      37    if (a->rank != 2)
      38      abort ();
      39  
      40    /* Fill in bdesc.  */
      41    check_CFI_status ("CFI_establish",
      42  		    CFI_establish (b, NULL, CFI_attribute_pointer,
      43  				   CFI_type_struct,
      44  				   sizeof (struct m), 2, NULL));
      45    check_CFI_status ("CFI_section",
      46  		    CFI_section (b, a, lb, ub, step));
      47    
      48    /* Sanity checking to make sure the descriptor has been initialized
      49       properly.  */
      50    dump_CFI_cdesc_t (b);
      51    if (b->version != CFI_VERSION)
      52      abort ();
      53    if (b->rank != 2)
      54      abort ();
      55    if (b->attribute != CFI_attribute_pointer)
      56      abort ();
      57    if (!b->base_addr)
      58      abort ();
      59    if (CFI_is_contiguous (b))
      60      abort ();
      61  
      62    for (j = b->dim[1].lower_bound;
      63         j < b->dim[1].lower_bound + b->dim[1].extent;
      64         j++)
      65      {
      66        for (i = b->dim[0].lower_bound;
      67  	   i < b->dim[0].lower_bound + b->dim[0].extent;
      68  	   i++)
      69  	{
      70  	  CFI_index_t subscripts[2];
      71  	  struct m *mp;
      72  	  subscripts[0] = i;
      73  	  subscripts[1] = j;
      74  	  mp = (struct m *) CFI_address (b, subscripts);
      75  	  fprintf (stderr, "b(%d,%d) = (%d,%d)\n", i, j, mp->i, mp->j);
      76  	}
      77      }
      78  
      79    /* Call back into Fortran.  */
      80    ftest (b);
      81  }