1  #include <stdlib.h>
       2  #include <stdio.h>
       3  
       4  #include <ISO_Fortran_binding.h>
       5  #include "dump-descriptors.h"
       6  
       7  extern void ctest1 (CFI_cdesc_t *a, int first, int last, int step);
       8  extern void ctest2 (CFI_cdesc_t *a, int first, int last, int step);
       9  extern void ftest1 (CFI_cdesc_t *a, int first, int last, int step);
      10  extern void ftest2 (CFI_cdesc_t *a, int first, int last, int step);
      11  
      12  #if 0
      13  static void
      14  dump_array (CFI_cdesc_t *a, const char *name, const char *note)
      15  {
      16    int i;
      17  
      18    fprintf (stderr, "%s\n", note);
      19    for (i = 0; i < a->dim[0].extent; i++)
      20      {
      21        int j = i + a->dim[0].lower_bound;
      22        int elt;
      23        CFI_index_t sub[1];
      24        sub[0] = j;
      25        elt = *((int *) CFI_address (a, sub));
      26        fprintf (stderr, "%s[%d] = %d\n", name, j, elt);
      27      }
      28    fprintf (stderr, "\n");
      29  }
      30  #else
      31  #define dump_array(a, name, note) 
      32  #endif
      33  
      34  static void
      35  ctest (CFI_cdesc_t *a, int first, int last, int step,
      36         void (*fn) (CFI_cdesc_t *, int, int, int))
      37  {
      38    int i;
      39  
      40    /* Dump the descriptor contents to test that we can access the fields
      41       correctly, etc.  */
      42    dump_CFI_cdesc_t (a);
      43    dump_array (a, "a", "a on input to ctest");
      44  
      45    /* Make sure we got a valid descriptor.  */
      46    if (!a->base_addr)
      47      abort ();
      48    if (a->elem_len != sizeof(int))
      49      abort ();
      50    if (a->rank != 1)
      51      abort ();
      52    if (a->type != CFI_type_int)
      53      abort ();
      54    if (a->attribute != CFI_attribute_other)
      55      abort ();
      56  
      57    /* Pass it to the Fortran function fn.  */
      58    (*fn) (a, first, last, step);
      59    dump_CFI_cdesc_t (a);
      60    dump_array (a, "a", "a after calling Fortran fn");
      61  }
      62  
      63  /* Entry points for the Fortran side.
      64     Note that the Fortran code has already created the array section
      65     and these functions were declared without the CONTIGUOUS attribute
      66     so they receive a non-contiguous array.  The magic is supposed to
      67     happen when we pass them back into a Fortran function declared with
      68     the CONTIGUOUS attribute.  */
      69  
      70  void
      71  ctest1 (CFI_cdesc_t *a, int first, int last, int step)
      72  {
      73    ctest (a, first, last, step, ftest1);
      74  }
      75  
      76  void
      77  ctest2 (CFI_cdesc_t *a, int first, int last, int step)
      78  {
      79    ctest (a, first, last, step, ftest2);
      80  }