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: