1  /* Test the fix for PR94331.  */
       2  
       3  #include <assert.h>
       4  #include <stdbool.h>
       5  #include <stdlib.h>
       6  
       7  #include <ISO_Fortran_binding.h>
       8  
       9  bool c_vrfy (const CFI_cdesc_t *restrict);
      10  
      11  bool check_bounds(const CFI_cdesc_t*restrict, const int, const int);
      12  
      13  bool
      14  c_vrfy (const CFI_cdesc_t *restrict auxp)
      15  {
      16    CFI_index_t i, lb, ub, ex;
      17    int *ip = NULL;
      18  
      19    assert (auxp);
      20    assert (auxp->base_addr);
      21    lb = auxp->dim[0].lower_bound;
      22    ex = auxp->dim[0].extent;
      23    ub = ex + lb - 1;
      24    ip = (int*)auxp->base_addr;
      25    for (i=0; i<ex; i++)
      26      if (*ip++ != i+1)
      27        return false;
      28    for (i=lb; i<ub+1; i++)
      29      {
      30        ip = (int*)CFI_address(auxp, &i);
      31        if (*ip != i-lb+1)
      32  	return false;
      33      }
      34    return true;
      35  }
      36  
      37  bool
      38  check_bounds (const CFI_cdesc_t *restrict auxp, const int lb, const int ub)
      39  {
      40    CFI_index_t ex = ub-lb+1;
      41    size_t el;
      42    bool is_ok = false;
      43    
      44    assert (auxp);
      45    el = auxp->elem_len;
      46    assert (auxp->rank==1);
      47    assert (auxp->type==CFI_type_int);
      48    assert (auxp->dim[0].sm>0);
      49    assert ((size_t)auxp->dim[0].sm==el);
      50    if (auxp->dim[0].extent==ex
      51        && auxp->dim[0].lower_bound==lb)
      52      {
      53      switch(auxp->attribute)
      54        {
      55        case CFI_attribute_pointer:
      56        case CFI_attribute_allocatable:
      57  	if (!c_vrfy (auxp))
      58  	  break;
      59  	is_ok = true;
      60  	break;
      61        case CFI_attribute_other:
      62  	if (!c_vrfy (auxp))
      63  	  break;
      64  	is_ok = (lb==0);
      65  	break;
      66        default:
      67  	assert (false);
      68  	break;
      69        }
      70      }
      71    return is_ok;
      72  }
      73