(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
c-interop/
fc-out-descriptor-4-c.c
       1  #include <stdlib.h>
       2  #include <stdio.h>
       3  
       4  #include <ISO_Fortran_binding.h>
       5  #include "dump-descriptors.h"
       6  
       7  extern void ctest1 (int imin, int imax, int jmin, int jmax, CFI_cdesc_t *p);
       8  extern void ctest2 (int imin, int imax, int jmin, int jmax, CFI_cdesc_t *a);
       9  
      10  struct m {
      11    int i;
      12    int j;
      13  };
      14  
      15  void
      16  ctest1 (int imin, int imax, int jmin, int jmax, CFI_cdesc_t *p)
      17  {
      18    struct m *mp;
      19    int i, j;
      20    CFI_index_t lb[2], ub[2], s[2];
      21  
      22    /* Dump the descriptor contents to test that we can access the fields
      23       correctly, etc.  */
      24    dump_CFI_cdesc_t (p);
      25  
      26    if (p->rank != 2)
      27      abort ();
      28    if (p->attribute != CFI_attribute_pointer)
      29      abort ();
      30    if (p->type != CFI_type_struct)
      31      abort ();
      32  
      33    lb[0] = imin;
      34    lb[1] = jmin;
      35    ub[0] = imax;
      36    ub[1] = jmax;
      37    check_CFI_status ("CFI_allocate",
      38  		    CFI_allocate (p, lb, ub, sizeof (struct m)));
      39  
      40    if (p->base_addr == NULL)
      41      abort ();
      42  
      43    for (j = jmin; j <= jmax; j++)
      44      for (i = imin; i <= imax; i++)
      45        {
      46  	s[0] = i;
      47  	s[1] = j;
      48  	mp = (struct m *) CFI_address (p, s);
      49  	mp->i = i;
      50  	mp->j = j;
      51        }
      52  }
      53  
      54  void
      55  ctest2 (int imin, int imax, int jmin, int jmax, CFI_cdesc_t *a)
      56  {
      57    struct m *mp;
      58    int i, j;
      59    CFI_index_t lb[2], ub[2], s[2];
      60  
      61    /* Dump the descriptor contents to test that we can access the fields
      62       correctly, etc.  */
      63    dump_CFI_cdesc_t (a);
      64  
      65    if (a->rank != 2)
      66      abort ();
      67    if (a->attribute != CFI_attribute_allocatable)
      68      abort ();
      69    if (a->type != CFI_type_struct)
      70      abort ();
      71  
      72    /* Intent(out) argument is supposed to be deallocated automatically
      73       on entry.  */
      74    if (a->base_addr)
      75      abort ();
      76  
      77    lb[0] = imin;
      78    lb[1] = jmin;
      79    ub[0] = imax;
      80    ub[1] = jmax;
      81    check_CFI_status ("CFI_allocate",
      82  		    CFI_allocate (a, lb, ub, sizeof (struct m)));
      83  
      84    if (a->base_addr == NULL)
      85      abort ();
      86  
      87    for (j = jmin; j <= jmax; j++)
      88      for (i = imin; i <= imax; i++)
      89        {
      90  	s[0] = i;
      91  	s[1] = j;
      92  	mp = (struct m *) CFI_address (a, s);
      93  	mp->i = i;
      94  	mp->j = j;
      95        }
      96  }