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 imax, int jmax)
      17  {
      18    CFI_CDESC_T(2) adesc;
      19    CFI_CDESC_T(2) bdesc;
      20    CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
      21    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      22    struct m* mp;
      23    CFI_index_t lower[2], upper[2], subscripts[2];
      24    CFI_index_t i, j;
      25  
      26    /* Create the descriptor for a, then sanity-check it.  */
      27    check_CFI_status ("CFI_establish",
      28  		    CFI_establish (a, NULL, CFI_attribute_allocatable,
      29  				   CFI_type_struct,
      30  				   sizeof (struct m), 2, NULL));
      31    dump_CFI_cdesc_t (a);
      32    if (a->version != CFI_VERSION)
      33      abort ();
      34    if (a->rank != 2)
      35      abort ();
      36    if (a->attribute != CFI_attribute_allocatable)
      37      abort ();
      38    if (a->base_addr)
      39      abort ();
      40    if (a->elem_len != sizeof (struct m))
      41      abort ();
      42  
      43    /* Likewise for b.  */
      44    check_CFI_status ("CFI_establish",
      45  		    CFI_establish (b, NULL, CFI_attribute_pointer,
      46  				   CFI_type_struct,
      47  				   sizeof (struct m), 2, NULL));
      48    dump_CFI_cdesc_t (b);
      49    if (b->version != CFI_VERSION)
      50      abort ();
      51    if (b->rank != 2)
      52      abort ();
      53    if (b->attribute != CFI_attribute_pointer)
      54      abort ();
      55    if (b->base_addr)
      56      abort ();
      57    if (b->elem_len != sizeof (struct m))
      58      abort ();
      59  
      60    /* Call back into Fortran, passing the unallocated descriptors.  */
      61    ftest (a, b, 0);
      62  
      63    /* Allocate and initialize both variables, and try again.  */
      64    lower[0] = 1;
      65    lower[1] = 1;
      66    upper[0] = imax;
      67    upper[1] = jmax;
      68  
      69    check_CFI_status ("CFI_allocate",
      70  		    CFI_allocate (a, lower, upper, 0));
      71    dump_CFI_cdesc_t (a);
      72    if (!a->base_addr)
      73      abort ();
      74    if (a->elem_len != sizeof (struct m))
      75      abort ();
      76  
      77    upper[0] = jmax;
      78    upper[1] = imax;
      79    check_CFI_status ("CFI_allocate",
      80  		    CFI_allocate (b, lower, upper, 0));
      81    dump_CFI_cdesc_t (b);
      82    if (!b->base_addr)
      83      abort ();
      84    if (b->elem_len != sizeof (struct m))
      85      abort ();
      86  
      87    for (i = 1; i <= imax; i++)
      88      for (j = 1; j <= jmax; j++)
      89        {
      90  	subscripts[0] = i;
      91  	subscripts[1] = j;
      92  	mp = (struct m *) CFI_address (a, subscripts);
      93  	mp->i = i;
      94  	mp->j = j;
      95  	subscripts[0] = j;
      96  	subscripts[1] = i;
      97  	mp = (struct m *) CFI_address (b, subscripts);
      98  	mp->i = i;
      99  	mp->j = j;
     100        }
     101  
     102    ftest (a, b, 1);
     103  
     104    /* Deallocate both objects and try again.  */
     105    check_CFI_status ("CFI_deallocate", CFI_deallocate (a));
     106    if (a->base_addr)
     107      abort ();
     108    check_CFI_status ("CFI_deallocate", CFI_deallocate (b));
     109    if (b->base_addr)
     110      abort ();
     111    ftest (a, b, 0);
     112  }