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);
       8  extern void ctest2 (CFI_cdesc_t *a);
       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 lb, int ub, int s,
      36         void (*fn) (CFI_cdesc_t *, int, int, int))
      37  {
      38    CFI_CDESC_T(1) bdesc;
      39    CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
      40    CFI_index_t lb_array[1], ub_array[1], s_array[1];
      41    int i;
      42  
      43    /* Dump the descriptor contents to test that we can access the fields
      44       correctly, etc.  */
      45    dump_CFI_cdesc_t (a);
      46  
      47    /* Make sure we got a valid descriptor.  */
      48    if (!a->base_addr)
      49      abort ();
      50    if (a->elem_len != sizeof(int))
      51      abort ();
      52    if (a->rank != 1)
      53      abort ();
      54    if (a->type != CFI_type_int)
      55      abort ();
      56    if (a->attribute != CFI_attribute_other)
      57      abort ();
      58  
      59    /* Create an array section and pass it to fn.  */
      60    check_CFI_status ("CFI_establish",
      61  		    CFI_establish (b, NULL, CFI_attribute_other,
      62  				   CFI_type_int,
      63  				   sizeof (int), 1, NULL));
      64    lb_array[0] = lb - 1 + a->dim[0].lower_bound;
      65    ub_array[0] = ub - 1 + a->dim[0].lower_bound;
      66    s_array[0] = s;
      67    check_CFI_status ("CFI_section",
      68  		    CFI_section (b, a, lb_array, ub_array, s_array));
      69    dump_CFI_cdesc_t (b);
      70    dump_array (b, "b", "b after CFI_section");
      71  
      72    /* Pass it to the Fortran function fn.  */
      73    if (CFI_is_contiguous (b))
      74      abort ();
      75    (*fn) (b, lb, ub, s);
      76    dump_CFI_cdesc_t (b);
      77    dump_array (b, "b", "b after calling Fortran fn");
      78  
      79    /* fn is supposed to negate the elements of the array section it
      80       receives.  Check that the original array has been updated.  */
      81    dump_array (a, "a", "a after calling Fortran fn");
      82    for (i = 0; i < a->dim[0].extent; i++)
      83      {
      84        int elt;
      85        int j = i + a->dim[0].lower_bound;
      86        CFI_index_t sub[1];
      87        sub[0] = j;
      88        elt = *((int *) CFI_address (a, sub));
      89        if (i + 1 >= lb && i + 1 <= ub && (i + 1 - lb) % s == 0)
      90  	{
      91            if (elt != - (i + 1))
      92  	    abort ();
      93  	}
      94        else if (elt != (i + 1))
      95  	abort ();
      96      }
      97  }
      98  
      99  
     100  /* Entry points for the Fortran side.  */
     101  
     102  void
     103  ctest1 (CFI_cdesc_t *a)
     104  {
     105    ctest (a, 5, 13, 2, ftest1);
     106  }
     107  
     108  void
     109  ctest2 (CFI_cdesc_t *a)
     110  {
     111    ctest (a, 8, 20, 3, ftest2);
     112  }
     113