(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
fc-descriptor-4-c.c
       1  #include <stdlib.h>
       2  
       3  #include <ISO_Fortran_binding.h>
       4  #include "dump-descriptors.h"
       5  
       6  extern void ctest (CFI_cdesc_t *a, CFI_cdesc_t *b, int initp);
       7  
       8  void
       9  ctest (CFI_cdesc_t *a, CFI_cdesc_t *b, int initp)
      10  {
      11    /* Dump the descriptor contents to test that we can access the fields
      12       correctly, etc.  */
      13    dump_CFI_cdesc_t (a);
      14    dump_CFI_cdesc_t (b);
      15  
      16    /* Make sure the descriptors match what we are expecting.  a is an
      17       allocatable derived type object, b is a pointer which points at a
      18       if initp is true.  */
      19    if (initp && !a->base_addr)
      20      abort ();
      21    else if (!initp && a->base_addr)
      22      abort ();
      23    if (a->base_addr != b->base_addr)
      24      abort ();
      25  
      26    if (a->type != CFI_type_struct)
      27      abort ();
      28    if (b->type != CFI_type_struct)
      29      abort ();
      30    if (a->elem_len != 3 * 3 * sizeof(double))
      31      abort ();
      32    if (b->elem_len != 3 * 3 * sizeof(double))
      33      abort ();
      34    if (a->attribute != CFI_attribute_allocatable)
      35      abort ();
      36    if (b->attribute != CFI_attribute_pointer)
      37      abort ();
      38  
      39    if (initp)
      40      /* The actual array is allocated with
      41           allocate (aa(3:7))
      42         Per 8.3.3 of TS29113, the lower_bound must reflect that.  */
      43      {
      44        if (a->rank != 1)
      45  	abort ();
      46        if (b->rank != 1)
      47  	abort ();
      48        if (a->dim[0].lower_bound != 3)
      49  	abort ();
      50        if (b->dim[0].lower_bound != 3)
      51  	abort ();
      52        if (a->dim[0].extent != 5)
      53  	abort ();
      54        if (b->dim[0].extent != 5)
      55  	abort ();
      56      }
      57  }