gcc/testsuite/gfortran.dg/PR100906.c

   1 /* Test the fix for PR100906 */
   2
   3 #include <assert.h>
   4 #include <stdbool.h>
   5 #include <stdint.h>
   6 #include <stdio.h>
   7 /* #include <uchar.h> */
   8
   9 #include <ISO_Fortran_binding.h>
  10
  11 #define _CFI_type_mask 0xFF
  12 #define _CFI_type_kind_shift 8
  13
  14 #define _CFI_decode_type(NAME) (signed char)((NAME) & CFI_type_mask)
  15 #define _CFI_decode_kind(NAME) (signed char)(((NAME) >> CFI_type_kind_shift) & CFI_type_mask)
  16
  17 #define _CFI_encode_type(TYPE, KIND) (int16_t)\
  18 ((((KIND) & CFI_type_mask) << CFI_type_kind_shift)\
  19  | ((TYPE) & CFI_type_mask))
  20
  21 #define N 11
  22 #define M 7
  23
  24 typedef char c_char;
  25 /* typedef char32_t c_ucs4_char; */
  26 typedef uint32_t char32_t;
  27 typedef uint32_t c_ucs4_char;
  28
  29 bool charcmp (char *, char, size_t);
  30
  31 bool ucharcmp (char32_t *, char32_t, size_t);
  32
  33 bool c_vrfy_c_char (const CFI_cdesc_t *restrict, const size_t);
  34
  35 bool c_vrfy_c_ucs4_char (const CFI_cdesc_t *restrict, const size_t);
  36
  37 bool c_vrfy_character (const CFI_cdesc_t *restrict, const size_t);
  38
  39 void check_tk (const CFI_cdesc_t*restrict, const CFI_type_t, const signed char, const size_t, const size_t);
  40
  41 bool
  42 charcmp (char *c, char v, size_t n)
  43 {
  44   bool res = true;
  45   char b = (char)'A';
  46   size_t i;
  47
  48   for (i=0; ((i<n)&&(res)); i++, c++)
  49     res = (*c == (v+b));
  50   return res;
  51 }
  52
  53 bool
  54 ucharcmp (char32_t *c, char32_t v, size_t n)
  55 {
  56   bool res = true;
  57   char32_t b = (char32_t)0xFF01;
  58   size_t i;
  59
  60   for (i=0; ((i<n)&&(res)); i++, c++)
  61     res = (*c == (v+b));
  62   return res;
  63 }
  64
  65 bool
  66 c_vrfy_c_char (const CFI_cdesc_t *restrict auxp, const size_t len)
  67 {
  68   CFI_index_t i, lb, ub, ex;
  69   size_t sz;
  70   c_char *ip = NULL;
  71
  72   assert (auxp);
  73   assert (auxp->base_addr);
  74   assert (auxp->elem_len>0);
  75   lb = auxp->dim[0].lower_bound;
  76   ex = auxp->dim[0].extent;
  77   assert (ex==N);
  78   sz = (size_t)auxp->elem_len / sizeof (c_char);
  79   assert (sz==len);
  80   ub = ex + lb - 1;
  81   ip = (c_char*)auxp->base_addr;
  82   for (i=0; i<ex; i++, ip+=sz)
  83     if (!charcmp (ip, (c_char)(i), sz))
  84       return false;
  85   for (i=lb; i<ub+1; i++)
  86     {
  87       ip = (c_char*)CFI_address(auxp, &i);
  88       if (!charcmp (ip, (c_char)(i-lb), sz))
  89         return false;
  90     }
  91   return true;
  92 }
  93
  94 bool
  95 c_vrfy_c_ucs4_char (const CFI_cdesc_t *restrict auxp, const size_t len)
  96 {
  97   CFI_index_t i, lb, ub, ex;
  98   size_t sz;
  99   c_ucs4_char *ip = NULL;
 100
 101   assert (auxp);
 102   assert (auxp->base_addr);
 103   assert (auxp->elem_len>0);
 104   lb = auxp->dim[0].lower_bound;
 105   ex = auxp->dim[0].extent;
 106   assert (ex==N);
 107   sz = (size_t)auxp->elem_len / sizeof (c_ucs4_char);
 108   assert (sz==len);
 109   ub = ex + lb - 1;
 110   ip = (c_ucs4_char*)auxp->base_addr;
 111   for (i=0; i<ex; i++, ip+=sz)
 112     if (!ucharcmp (ip, (c_ucs4_char)(i), sz))
 113       return false;
 114   for (i=lb; i<ub+1; i++)
 115     {
 116       ip = (c_ucs4_char*)CFI_address(auxp, &i);
 117       if (!ucharcmp (ip, (c_ucs4_char)(i-lb), sz))
 118         return false;
 119     }
 120   return true;
 121 }
 122
 123 bool
 124 c_vrfy_character (const CFI_cdesc_t *restrict auxp, const size_t len)
 125 {
 126   signed char type, kind;
 127
 128   assert (auxp);
 129   type = _CFI_decode_type(auxp->type);
 130   kind = _CFI_decode_kind(auxp->type);
 131   assert (type == CFI_type_Character);
 132   switch (kind)
 133     {
 134     case 1:
 135       return c_vrfy_c_char (auxp, len);
 136       break;
 137     case 4:
 138       return c_vrfy_c_ucs4_char (auxp, len);
 139       break;
 140     default:
 141       assert (false);
 142     }
 143   return true;
 144 }
 145
 146 void
 147 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)
 148 {
 149   signed char ityp, iknd;
 150
 151   assert (auxp);
 152   assert (auxp->elem_len==elem_len*nelem);
 153   assert (auxp->rank==1);
 154   assert (auxp->dim[0].sm>0);
 155   assert ((size_t)auxp->dim[0].sm==elem_len*nelem);
 156   /*  */
 157   assert (auxp->type==type);
 158   ityp = _CFI_decode_type(auxp->type);
 159   assert (ityp == CFI_type_Character);
 160   iknd = _CFI_decode_kind(auxp->type);
 161   assert (_CFI_decode_type(type)==ityp);
 162   assert (kind==iknd);
 163   assert (c_vrfy_character (auxp, nelem));
 164   return;
 165 }
 166
 167 // Local Variables:
 168 // mode: C
 169 // End: