(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
cf-out-descriptor-3-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 (int imagic, int jmagic);
       8  extern void frob (CFI_cdesc_t *a, CFI_cdesc_t *aa, CFI_cdesc_t *p);
       9  
      10  struct m {
      11    int i;
      12    int j;
      13  };
      14  
      15  void
      16  ctest (int imagic, int jmagic)
      17  {
      18    CFI_CDESC_T(0) adesc;
      19    CFI_CDESC_T(0) aadesc;
      20    CFI_CDESC_T(0) bdesc;
      21    CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
      22    CFI_cdesc_t *aa = (CFI_cdesc_t *) &aadesc;
      23    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      24  
      25    /* Create and sanity-check descriptors.  */
      26    check_CFI_status ("CFI_establish",
      27  		    CFI_establish (a, NULL, CFI_attribute_allocatable,
      28  				   CFI_type_struct,
      29  				   sizeof (struct m), 0, NULL));
      30    dump_CFI_cdesc_t (a);
      31    if (a->version != CFI_VERSION)
      32      abort ();
      33    if (a->rank != 0)
      34      abort ();
      35    if (a->attribute != CFI_attribute_allocatable)
      36      abort ();
      37    if (a->base_addr)
      38      abort ();
      39    if (a->elem_len != sizeof (struct m))
      40      abort ();
      41  
      42    check_CFI_status ("CFI_establish",
      43  		    CFI_establish (aa, NULL, CFI_attribute_allocatable,
      44  				   CFI_type_struct,
      45  				   sizeof (struct m), 0, NULL));
      46    dump_CFI_cdesc_t (aa);
      47    if (aa->version != CFI_VERSION)
      48      abort ();
      49    if (aa->rank != 0)
      50      abort ();
      51    if (aa->attribute != CFI_attribute_allocatable)
      52      abort ();
      53    if (aa->base_addr)
      54      abort ();
      55    if (aa->elem_len != sizeof (struct m))
      56      abort ();
      57    check_CFI_status ("CFI_allocate",
      58  		    CFI_allocate (aa, NULL, NULL, 0));
      59    ((struct m *)aa->base_addr)->i = 0;
      60    ((struct m *)aa->base_addr)->j = 0;
      61    
      62    check_CFI_status ("CFI_establish",
      63  		    CFI_establish (b, NULL, CFI_attribute_pointer,
      64  				   CFI_type_struct,
      65  				   sizeof (struct m), 0, NULL));
      66    dump_CFI_cdesc_t (b);
      67    if (b->version != CFI_VERSION)
      68      abort ();
      69    if (b->rank != 0)
      70      abort ();
      71    if (b->attribute != CFI_attribute_pointer)
      72      abort ();
      73    if (b->base_addr)
      74      abort ();
      75    if (b->elem_len != sizeof (struct m))
      76      abort ();
      77  
      78    /* Call back into Fortran, which will allocate and initialize the
      79       objects.  */
      80    frob (a, aa, b);
      81  
      82    if (!a->base_addr)
      83      abort ();
      84    if (a->elem_len != sizeof (struct m))
      85      abort ();
      86    if (((struct m *)a->base_addr)->i != imagic)
      87      abort ();
      88    if (((struct m *)a->base_addr)->j != jmagic)
      89      abort ();
      90  
      91    if (!aa->base_addr)
      92      abort ();
      93    if (aa->elem_len != sizeof (struct m))
      94      abort ();
      95    if (((struct m *)aa->base_addr)->i != imagic)
      96      abort ();
      97    if (((struct m *)aa->base_addr)->j != jmagic)
      98      abort ();
      99  
     100    if (!b->base_addr)
     101      abort ();
     102    if (b->elem_len != sizeof (struct m))
     103      abort ();
     104    if (((struct m *)b->base_addr)->i != imagic)
     105      abort ();
     106    if (((struct m *)b->base_addr)->j != jmagic)
     107      abort ();
     108  }