1  #include <stdlib.h>
       2  
       3  #include <ISO_Fortran_binding.h>
       4  #include "dump-descriptors.h"
       5  
       6  extern void ctest (CFI_cdesc_t *a, int n);
       7  
       8  void
       9  ctest (CFI_cdesc_t *a, int n)
      10  {
      11    /* Dump the descriptor contents to test that we can access the fields
      12       correctly, etc.  */
      13    dump_CFI_cdesc_t (a);
      14  
      15    if (!a->base_addr)
      16      abort ();
      17    if (a->elem_len != sizeof(float))
      18      abort ();
      19    if (a->type != CFI_type_float)
      20      abort ();
      21    if (a->attribute != CFI_attribute_other)
      22      abort ();
      23  
      24    if (n == 1)
      25      {
      26        /* The actual argument on the Fortran side was declared as 
      27  	 real(C_FLOAT):: aa(100)  */
      28        if (a->rank != 1)
      29  	abort ();
      30        if (a->dim[0].lower_bound != 0)
      31  	abort ();
      32        if (a->dim[0].extent != 100)
      33  	abort ();
      34        if (a->dim[0].sm != sizeof(float))
      35  	abort ();
      36        if (!CFI_is_contiguous (a))
      37  	abort ();
      38      }
      39    else if (n == 3)
      40      {
      41        /* The actual argument on the Fortran side was declared as 
      42  	 real(C_FLOAT) :: bb(3,4,5)  */
      43        if (a->rank != 3)
      44  	abort ();
      45        if (a->dim[0].lower_bound != 0)
      46  	abort ();
      47        if (a->dim[0].extent != 3)
      48  	abort ();
      49        if (a->dim[0].sm != sizeof(float))
      50  	abort ();
      51        if (a->dim[1].lower_bound != 0)
      52  	abort ();
      53        if (a->dim[1].extent != 4)
      54  	abort ();
      55        if (a->dim[1].sm != a->dim[0].sm * a->dim[0].extent)
      56  	abort ();
      57        if (a->dim[2].lower_bound != 0)
      58  	abort ();
      59        if (a->dim[2].extent != 5)
      60  	abort ();
      61        if (a->dim[2].sm != a->dim[1].sm * a->dim[1].extent)
      62  	abort ();
      63        if (!CFI_is_contiguous (a))
      64  	abort ();
      65      }
      66    else
      67      abort ();
      68  }