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 (CFI_cdesc_t *a, int lb, int ub, int s, CFI_cdesc_t *r);
       8  
       9  /* Take a section of array A.  OFF is the start index of A on the Fortran
      10     side and the bounds LB and UB for the section to take are relative to 
      11     that base index.  Store the result in R, which is supposed to be a pointer
      12     array with lower bound 1.  */
      13     
      14  void
      15  ctest (CFI_cdesc_t *a, int lb, int ub, int s, CFI_cdesc_t *r)
      16  {
      17    CFI_index_t lb_array[1], ub_array[1], s_array[1];
      18    CFI_index_t i, o;
      19  
      20    /* Dump the descriptor contents to test that we can access the fields
      21       correctly, etc.  */
      22    fprintf (stderr, "\n%s: lb=%d  ub=%d  s=%d\n",
      23  	   (a->attribute == CFI_attribute_other) ? "non-pointer" : "pointer",
      24  	   lb, ub, s);  
      25    dump_CFI_cdesc_t (a);
      26    dump_CFI_cdesc_t (r);
      27  
      28    /* Make sure we got a valid input descriptor.  */
      29    if (!a->base_addr)
      30      abort ();
      31    if (a->elem_len != sizeof(int))
      32      abort ();
      33    if (a->rank != 1)
      34      abort ();
      35    if (a->type != CFI_type_int)
      36      abort ();
      37    if (a->attribute == CFI_attribute_other)
      38      {
      39        if (a->dim[0].lower_bound != 0)
      40  	abort ();
      41        /* Adjust the 1-based bounds.  */
      42        lb = lb - 1;
      43        ub = ub - 1;
      44      }
      45    /* For pointer arrays, the bounds use the same indexing as the lower
      46       bound in the array descriptor.  */
      47  
      48    /* Make sure we got a valid output descriptor.  */
      49    if (r->base_addr)
      50      abort ();
      51    if (r->elem_len != sizeof(int))
      52      abort ();
      53    if (r->rank != 1)
      54      abort ();
      55    if (r->type != CFI_type_int)
      56      abort ();
      57    if (r->attribute != CFI_attribute_pointer)
      58      abort ();
      59  
      60    /* Create an array section.  */
      61    lb_array[0] = lb;
      62    ub_array[0] = ub;
      63    s_array[0] = s;
      64  
      65    check_CFI_status ("CFI_section",
      66  		    CFI_section (r, a, lb_array, ub_array, s_array));
      67  
      68    /* Check that the output descriptor is correct.  */
      69    dump_CFI_cdesc_t (r);
      70    if (!r->base_addr)
      71      abort ();
      72    if (r->elem_len != sizeof(int))
      73      abort ();
      74    if (r->rank != 1)
      75      abort ();
      76    if (r->type != CFI_type_int)
      77      abort ();
      78    if (r->attribute != CFI_attribute_pointer)
      79      abort ();
      80  
      81    /* Check the contents of the output array.  */
      82  #if 0
      83    for (o = r->dim[0].lower_bound, i = lb;
      84         (s > 0 ? i <= ub : i >= ub);
      85         o++, i += s)
      86      {
      87        int *input = (int *) CFI_address (a, &i);
      88        int *output = (int *) CFI_address (r, &o);
      89        fprintf (stderr, "a(%d) = %d, r(%d) = %d\n",
      90  	       (int)i, *input, (int)o, *output);
      91      }
      92  #endif
      93    for (o = r->dim[0].lower_bound, i = lb;
      94         (s > 0 ? i <= ub : i >= ub);
      95         o++, i += s)
      96      {
      97        int *input = (int *) CFI_address (a, &i);
      98        int *output = (int *) CFI_address (r, &o);
      99        if (*input != *output)
     100  	abort ();
     101      }
     102  
     103    /* Force the output array to be 1-based.  */
     104    lb_array[0] = 1;
     105    check_CFI_status ("CFI_setpointer", CFI_setpointer (r, r, lb_array));
     106    /* Check that the output descriptor is correct.  */
     107    dump_CFI_cdesc_t (r);
     108    if (!r->base_addr)
     109      abort ();
     110    if (r->elem_len != sizeof(int))
     111      abort ();
     112    if (r->rank != 1)
     113      abort ();
     114    if (r->type != CFI_type_int)
     115      abort ();
     116    if (r->attribute != CFI_attribute_pointer)
     117      abort ();
     118    if (r->dim[0].lower_bound != 1)
     119      abort ();
     120  
     121    /* Check the contents of the output array again.  */
     122    for (o = r->dim[0].lower_bound, i = lb;
     123         (s > 0 ? i <= ub : i >= ub);
     124         o++, i += s)
     125      {
     126        int *input = (int *) CFI_address (a, &i);
     127        int *output = (int *) CFI_address (r, &o);
     128        if (*input != *output)
     129  	abort ();
     130      }
     131  
     132  }
     133  
     134  
     135