1  #include <stdlib.h>
       2  #include <stdint.h>
       3  #include <stdio.h>
       4  #include <string.h>
       5  
       6  #include <ISO_Fortran_binding.h>
       7  #include "dump-descriptors.h"
       8  
       9  static int a[10][5][3];
      10  static CFI_index_t extents[] = {3, 5, 10};
      11  
      12  /* External entry point.  */
      13  extern void ctest (void);
      14  
      15  void
      16  ctest (void)
      17  {
      18    int bad = 0;
      19    int status;
      20    CFI_CDESC_T(3) sdesc;
      21    CFI_cdesc_t *source = (CFI_cdesc_t *) &sdesc;
      22    CFI_CDESC_T(3) rdesc;
      23    CFI_cdesc_t *result = (CFI_cdesc_t *) &rdesc;
      24  
      25    /* result shall be the address of a C descriptor for a Fortran pointer.  */
      26    check_CFI_status ("CFI_establish",
      27  		    CFI_establish (source, (void *)a, CFI_attribute_other,
      28  				   CFI_type_int, 0, 3, extents));
      29  
      30    check_CFI_status ("CFI_establish", 
      31  		    CFI_establish (result, NULL, CFI_attribute_allocatable,
      32  				   CFI_type_int, 0, 3, NULL));
      33    status = CFI_setpointer (result, source, NULL);
      34    if (status == CFI_SUCCESS)
      35      {
      36        fprintf (stderr,
      37  	       "no error for CFI_attribute_allocatable result\n");
      38        bad ++;
      39      }
      40  
      41    check_CFI_status ("CFI_establish", 
      42  		    CFI_establish (result, NULL, CFI_attribute_other,
      43  				   CFI_type_int, 0, 3, NULL));
      44    status = CFI_setpointer (result, source, NULL);
      45    if (status == CFI_SUCCESS)
      46      {
      47        fprintf (stderr,
      48  	       "no error for CFI_attribute_other result\n");
      49        bad ++;
      50      }
      51  
      52    /* source shall be a null pointer or the address of a C descriptor
      53       for an allocated allocatable object, a data pointer object, or a
      54       nonallocatable nonpointer data object that is not an
      55       assumed-size array.  */
      56    check_CFI_status ("CFI_establish", 
      57  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      58  				   CFI_type_int, 0, 3, NULL));
      59  
      60    check_CFI_status ("CFI_establish", 
      61  		    CFI_establish (source, NULL, CFI_attribute_allocatable,
      62  				   CFI_type_int, 0, 3, NULL));
      63    status = CFI_setpointer (result, source, NULL);
      64    if (status == CFI_SUCCESS)
      65      {
      66        fprintf (stderr,
      67  	       "no error for unallocated allocatable source\n");
      68        bad ++;
      69      }
      70  
      71    /* CFI_establish rejects negative extents, so we can't use it to make
      72       an assumed-size array, so hack the descriptor by hand.  Yuck.  */
      73    check_CFI_status ("CFI_establish",
      74  		    CFI_establish (source, (void *)a, CFI_attribute_other,
      75  				   CFI_type_int, 0, 3, extents));
      76    source->dim[2].extent = -1;
      77    status = CFI_setpointer (result, source, NULL);
      78    if (status == CFI_SUCCESS)
      79      {
      80        fprintf (stderr,
      81  	       "no error for assumed-size source array\n");
      82        bad ++;
      83      }
      84    
      85    /* If source is not a null pointer, the corresponding values of the
      86       elem_len, rank, and type members shall be the same in the C
      87       descriptors with the addresses source and result.  */
      88    check_CFI_status ("CFI_establish",
      89  		    CFI_establish (source, (void *)a, CFI_attribute_other,
      90  				   CFI_type_char, sizeof(int), 3, extents));
      91    check_CFI_status ("CFI_establish", 
      92  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      93  				   CFI_type_char, 1, 3, NULL));
      94    status = CFI_setpointer (result, source, NULL);
      95    if (status == CFI_SUCCESS)
      96      {
      97        fprintf (stderr,
      98  	       "no error for elem_len mismatch\n");
      99        bad ++;
     100      }
     101  
     102    check_CFI_status ("CFI_establish", 
     103  		    CFI_establish (result, NULL, CFI_attribute_pointer,
     104  				   CFI_type_char, sizeof(int), 1, NULL));
     105    status = CFI_setpointer (result, source, NULL);
     106    if (status == CFI_SUCCESS)
     107      {
     108        fprintf (stderr,
     109  	       "no error for rank mismatch\n");
     110        bad ++;
     111      }
     112  
     113    check_CFI_status ("CFI_establish", 
     114  		    CFI_establish (result, NULL, CFI_attribute_pointer,
     115  				   CFI_type_int, 0, 3, NULL));
     116    status = CFI_setpointer (result, source, NULL);
     117    if (status == CFI_SUCCESS)
     118      {
     119        fprintf (stderr,
     120  	       "no error for type mismatch\n");
     121        bad ++;
     122      }
     123  
     124    if (bad)
     125      abort ();
     126  }
     127