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  struct s {
      10    int i;
      11    double d;
      12  };
      13  
      14  static long buf[5][4][3];
      15  
      16  /* External entry point.  */
      17  extern void ctest (void);
      18  
      19  void
      20  ctest (void)
      21  {
      22    int bad = 0;
      23    int status;
      24    CFI_CDESC_T(3) desc;
      25    CFI_cdesc_t *dv = (CFI_cdesc_t *) &desc;
      26    CFI_index_t ex[3], lb[3], ub[3];
      27    CFI_index_t sm;
      28  
      29    /* On entry, the base_addr member of the C descriptor shall be a null
      30       pointer.  */
      31    sm = sizeof (struct s);
      32    check_CFI_status ("CFI_establish",
      33  		    CFI_establish (dv, NULL, CFI_attribute_allocatable,
      34  				   CFI_type_struct, sm,
      35  				   0, NULL));
      36    check_CFI_status ("CFI_allocate",
      37  		    CFI_allocate (dv, NULL, NULL, 69));
      38    status = CFI_allocate (dv, NULL, NULL, 42);
      39    if (status == CFI_SUCCESS)
      40      {
      41        fprintf (stderr,
      42  	       "no error for CFI_allocate of already-allocated object\n");
      43        bad ++;
      44      }
      45    check_CFI_status ("CFI_deallocate",
      46  		    CFI_deallocate (dv));
      47  
      48    /* The attribute member of the C descriptor shall have a value of
      49       CFI_attribute_allocatable or CFI_attribute_pointer.  */
      50    ex[0] = 3;
      51    ex[1] = 4;
      52    ex[2] = 5;
      53    check_CFI_status ("CFI_establish",
      54  		    CFI_establish (dv, NULL, CFI_attribute_other,
      55  				   CFI_type_long, 0, 3, ex));
      56    lb[0] = 1;
      57    lb[1] = 2;
      58    lb[2] = 3;
      59    ub[0] = 10;
      60    ub[1] = 5;
      61    ub[2] = 10;
      62    sm = sizeof (long);
      63    status = CFI_allocate (dv, lb, ub, 20);
      64    if (status == CFI_SUCCESS)
      65      {
      66        fprintf (stderr,
      67  	       "no error for CFI_allocate of CFI_attribute_other object\n");
      68        bad ++;
      69      }
      70  
      71    /* dv shall be the address of a C descriptor describing the object.
      72       It shall have been allocated using the same mechanism as the
      73       Fortran ALLOCATE statement.  */
      74    ex[0] = 3;
      75    ex[1] = 4;
      76    ex[2] = 5;
      77    check_CFI_status ("CFI_establish",
      78  		    CFI_establish (dv, NULL, CFI_attribute_pointer,
      79  				   CFI_type_long, 0, 3, ex));
      80    status = CFI_deallocate (dv);
      81    if (status == CFI_SUCCESS)
      82      {
      83        fprintf (stderr,
      84  	       "no error for CFI_deallocate with null pointer\n");
      85        bad ++;
      86      }
      87  
      88    /* This variant is disabled.  In theory it should be possible for
      89       the memory allocator to easily check for pointers outside the
      90       heap region, but libfortran just calls free() which has no provision
      91       for returning an error, and there is no other standard C interface
      92       to check the validity of a pointer in the C heap either.  */
      93  #if 0  
      94    check_CFI_status ("CFI_establish",
      95  		    CFI_establish (dv, buf, CFI_attribute_pointer,
      96  				   CFI_type_long, 0, 3, ex));
      97    status = CFI_deallocate (dv);
      98    if (status == CFI_SUCCESS)
      99      {
     100        fprintf (stderr,
     101  	       "no error for CFI_deallocate with non-allocated pointer\n");
     102        bad ++;
     103      }
     104  #endif
     105  
     106    if (bad)
     107      abort ();
     108  }
     109