(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
select-c.c
       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  /* Declare some source arrays.  */
      10  struct ss {
      11    char c[4];
      12    signed char b[4];
      13    int i, j, k;
      14  } s[10][5][3];
      15  
      16  char c[10][16];
      17  
      18  double _Complex dc[10];
      19  
      20  CFI_index_t extents3[] = {3,5,10};
      21  CFI_index_t extents1[] = {10};
      22  
      23  /* External entry point.  */
      24  extern void ctest (void);
      25  
      26  void
      27  ctest (void)
      28  {
      29    CFI_CDESC_T(3) sdesc;
      30    CFI_cdesc_t *source = (CFI_cdesc_t *) &sdesc;
      31    CFI_CDESC_T(3) rdesc;
      32    CFI_cdesc_t *result = (CFI_cdesc_t *) &rdesc;
      33    size_t offset;
      34  
      35    /* Extract an array of structure elements.  */
      36    offset = offsetof (struct ss, j);
      37    check_CFI_status ("CFI_establish",
      38  		    CFI_establish (source, (void *)s, CFI_attribute_other,
      39  				   CFI_type_struct,
      40  				   sizeof (struct ss), 3, extents3));
      41    check_CFI_status ("CFI_establish", 
      42  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      43  				   CFI_type_int, 0, 3, NULL));
      44    check_CFI_status ("CFI_select_part",
      45  		    CFI_select_part (result, source, offset, 0));
      46    dump_CFI_cdesc_t (source);
      47    dump_CFI_cdesc_t (result);
      48  
      49    if (result->elem_len != sizeof (int))
      50      abort ();
      51    if (result->base_addr != source->base_addr + offset)
      52      abort ();
      53    if (result->dim[0].extent != source->dim[0].extent)
      54      abort ();
      55    if (result->dim[0].sm != source->dim[0].sm)
      56      abort ();
      57    if (result->dim[1].extent != source->dim[1].extent)
      58      abort ();
      59    if (result->dim[1].sm != source->dim[1].sm)
      60      abort ();
      61    if (result->dim[2].extent != source->dim[2].extent)
      62      abort ();
      63    if (result->dim[2].sm != source->dim[2].sm)
      64      abort ();
      65  
      66    /* Check that we use the given elem_size for char but not for
      67       signed char, which is considered an integer type instead of a Fortran
      68       character type.  */
      69    check_CFI_status ("CFI_establish", 
      70  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      71  				   CFI_type_char, 4, 3, NULL));
      72    if (result->elem_len != 4)
      73      abort ();
      74    offset = offsetof (struct ss, c);
      75    check_CFI_status ("CFI_select_part",
      76  		    CFI_select_part (result, source, offset, 4));
      77    if (result->elem_len != 4)
      78      abort ();
      79  
      80    check_CFI_status ("CFI_establish", 
      81  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      82  				   CFI_type_signed_char, 4, 3, NULL));
      83    if (result->elem_len != sizeof (signed char))
      84      abort ();
      85    offset = offsetof (struct ss, c);
      86    check_CFI_status ("CFI_select_part",
      87  		    CFI_select_part (result, source, offset, 4));
      88    if (result->elem_len != sizeof (signed char))
      89      abort ();
      90  
      91    /* Extract an array of character substrings.  */
      92    offset = 2;
      93    check_CFI_status ("CFI_establish",
      94  		    CFI_establish (source, (void *)c, CFI_attribute_other,
      95  				   CFI_type_char, 16, 1, extents1));
      96    check_CFI_status ("CFI_establish", 
      97  		    CFI_establish (result, NULL, CFI_attribute_pointer,
      98  				   CFI_type_char, 8, 1, NULL));
      99    check_CFI_status ("CFI_select_part",
     100  		    CFI_select_part (result, source, offset, 8));
     101    dump_CFI_cdesc_t (source);
     102    dump_CFI_cdesc_t (result);
     103  
     104    if (result->elem_len != 8)
     105      abort ();
     106    if (result->base_addr != source->base_addr + offset)
     107      abort ();
     108    if (result->dim[0].extent != source->dim[0].extent)
     109      abort ();
     110    if (result->dim[0].sm != source->dim[0].sm)
     111      abort ();
     112  
     113    /* Extract an array the imaginary parts of complex numbers.
     114       Note that the use of __imag__ to obtain the imaginary part as
     115       an lvalue is a GCC extension.  */
     116    offset = (void *)&(__imag__ dc[0]) - (void *)&(dc[0]);
     117    check_CFI_status ("CFI_establish",
     118  		    CFI_establish (source, (void *)dc, CFI_attribute_other,
     119  				   CFI_type_double_Complex,
     120  				   0, 1, extents1));
     121    check_CFI_status ("CFI_establish", 
     122  		    CFI_establish (result, NULL, CFI_attribute_pointer,
     123  				   CFI_type_double, 0, 1, NULL));
     124    check_CFI_status ("CFI_select_part",
     125  		    CFI_select_part (result, source, offset, 0));
     126    dump_CFI_cdesc_t (source);
     127    dump_CFI_cdesc_t (result);
     128  
     129    if (result->elem_len != sizeof (double))
     130      abort ();
     131    if (result->base_addr != source->base_addr + offset)
     132      abort ();
     133    if (result->dim[0].extent != source->dim[0].extent)
     134      abort ();
     135    if (result->dim[0].sm != source->dim[0].sm)
     136      abort ();
     137  }
     138