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 ftest (CFI_cdesc_t *a, CFI_cdesc_t *b, int initp);
       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) bdesc;
      20    CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
      21    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      22    struct m* mp;
      23  
      24    /* Create the descriptor for a, then sanity-check it.  */
      25    check_CFI_status ("CFI_establish",
      26  		    CFI_establish (a, NULL, CFI_attribute_allocatable,
      27  				   CFI_type_struct,
      28  				   sizeof (struct m), 0, NULL));
      29    dump_CFI_cdesc_t (a);
      30    if (a->version != CFI_VERSION)
      31      abort ();
      32    if (a->rank != 0)
      33      abort ();
      34    if (a->attribute != CFI_attribute_allocatable)
      35      abort ();
      36    if (a->base_addr)
      37      abort ();
      38    if (a->elem_len != sizeof (struct m))
      39      abort ();
      40  
      41    /* Likewise for b.  */
      42    check_CFI_status ("CFI_establish",
      43  		    CFI_establish (b, NULL, CFI_attribute_pointer,
      44  				   CFI_type_struct,
      45  				   sizeof (struct m), 0, NULL));
      46    dump_CFI_cdesc_t (b);
      47    if (b->version != CFI_VERSION)
      48      abort ();
      49    if (b->rank != 0)
      50      abort ();
      51    if (b->attribute != CFI_attribute_pointer)
      52      abort ();
      53    if (b->base_addr)
      54      abort ();
      55    if (b->elem_len != sizeof (struct m))
      56      abort ();
      57  
      58    /* Call back into Fortran, passing the unallocated descriptors.  */
      59    ftest (a, b, 0);
      60  
      61    /* Allocate and initialize both variables, and try again.  */
      62    check_CFI_status ("CFI_allocate",
      63  		    CFI_allocate (a, NULL, NULL, 0));
      64    dump_CFI_cdesc_t (a);
      65    if (!a->base_addr)
      66      abort ();
      67    if (a->elem_len != sizeof (struct m))
      68      abort ();
      69    ((struct m *)a->base_addr)->i = imagic;
      70    ((struct m *)a->base_addr)->j = jmagic;
      71  
      72    check_CFI_status ("CFI_allocate",
      73  		    CFI_allocate (b, NULL, NULL, 0));
      74    dump_CFI_cdesc_t (b);
      75    if (!b->base_addr)
      76      abort ();
      77    if (b->elem_len != sizeof (struct m))
      78      abort ();
      79    ((struct m *)b->base_addr)->i = imagic + 1;
      80    ((struct m *)b->base_addr)->j = jmagic + 1;
      81  
      82    ftest (a, b, 1);
      83  
      84    /* Deallocate both objects and try again.  */
      85    check_CFI_status ("CFI_deallocate", CFI_deallocate (a));
      86    if (a->base_addr)
      87      abort ();
      88    check_CFI_status ("CFI_deallocate", CFI_deallocate (b));
      89    if (b->base_addr)
      90      abort ();
      91    ftest (a, b, 0);
      92  }