(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
PR100911.c
       1  /* Test the fix for PR100911 */
       2  
       3  #include <assert.h>
       4  #include <stdbool.h>
       5  #include <stdio.h>
       6  
       7  #include <ISO_Fortran_binding.h>
       8  
       9  #define _CFI_type_mask 0xFF
      10  #define _CFI_type_kind_shift 8
      11  
      12  #define _CFI_decode_type(NAME) (signed char)((NAME) & CFI_type_mask)
      13  #define _CFI_decode_kind(NAME) (signed char)(((NAME) >> CFI_type_kind_shift) & CFI_type_mask)
      14  
      15  #define _CFI_encode_type(TYPE, KIND) (int16_t)\
      16  ((((KIND) & CFI_type_mask) << CFI_type_kind_shift)\
      17   | ((TYPE) & CFI_type_mask))
      18  
      19  #define N 11
      20  #define M 7
      21  
      22  #define CFI_type_Cptr CFI_type_cptr
      23  
      24  typedef int* c_ptr;
      25  
      26  bool c_vrfy_cptr (const CFI_cdesc_t *restrict);
      27   
      28  void check_tk (const CFI_cdesc_t*restrict, const CFI_type_t, const signed char, const size_t, const size_t);
      29  
      30  bool
      31  c_vrfy_cptr (const CFI_cdesc_t *restrict auxp)
      32  {
      33    CFI_index_t i, lb, ub, ex;
      34    size_t sz;
      35    c_ptr *ip = NULL;
      36  
      37    assert (auxp);
      38    assert (auxp->base_addr);
      39    assert (auxp->elem_len>0);
      40    lb = auxp->dim[0].lower_bound;
      41    ex = auxp->dim[0].extent;
      42    assert (ex==11);
      43    sz = (size_t)auxp->elem_len / sizeof (c_ptr);
      44    assert (sz==1);
      45    ub = ex + lb - 1;
      46    ip = (c_ptr*)auxp->base_addr;
      47    for (i=0; i<ex; i++, ip+=sz)
      48      if ((**ip) != (int)(i+1))
      49        return false;
      50    for (i=lb; i<ub+1; i++)
      51      {
      52        ip = (c_ptr*)CFI_address(auxp, &i);
      53        if ((**ip) != (int)(i-lb+1))
      54  	return false;
      55      }
      56    return true;
      57  }
      58  
      59  void
      60  check_tk (const CFI_cdesc_t *restrict auxp, const CFI_type_t type, const signed char kind, const size_t elem_len, const size_t nelem)
      61  {
      62    signed char ityp, iknd;
      63  
      64    assert (auxp);
      65    assert (auxp->elem_len==elem_len*nelem);
      66    assert (auxp->rank==1);
      67    assert (auxp->dim[0].sm>0);
      68    assert ((size_t)auxp->dim[0].sm==elem_len*nelem);
      69    /*  */
      70    assert (auxp->type==type);
      71    ityp = _CFI_decode_type(auxp->type);
      72    assert (ityp == CFI_type_cptr);
      73    iknd = _CFI_decode_kind(auxp->type);
      74    assert (_CFI_decode_type(type)==ityp);
      75    assert (kind==iknd);
      76    assert (c_vrfy_cptr (auxp));
      77    return;
      78  }
      79  
      80  // Local Variables:
      81  // mode: C
      82  // End: