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: