(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
ISO_Fortran_binding_10.c
       1  /* Test the fix of PR89843.  */
       2  
       3  /* Contributed by Reinhold Bader  <Bader@lrz.de> */
       4  
       5  #include <ISO_Fortran_binding.h>
       6  #include <stdlib.h>
       7  #include <stdio.h>
       8  #include <stdbool.h>
       9  
      10  void sa(CFI_cdesc_t *, int, int *);
      11  
      12  void si(CFI_cdesc_t *this, int flag, int *status)
      13  {
      14    int value, sum;
      15    bool err;
      16    CFI_CDESC_T(1) that;
      17    CFI_index_t lb[] = { 0, 0 };
      18    CFI_index_t ub[] = { 4, 0 };
      19    CFI_index_t st[] = { 2, 0 };
      20    int chksum[] = { 9, 36, 38 };
      21  
      22    if (flag == 1)
      23      {
      24        lb[0] = 0; lb[1] = 2;
      25        ub[0] = 2; ub[1] = 2;
      26        st[0] = 1; st[1] = 0;
      27      }
      28    else if (flag == 2)
      29      {
      30        lb[0] = 1; lb[1] = 0;
      31        ub[0] = 1; ub[1] = 3;
      32        st[0] = 0; st[1] = 1;
      33      }
      34  
      35    CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
      36  		CFI_type_float, 0, 1, NULL);
      37  
      38    *status = CFI_section((CFI_cdesc_t *) &that, this, lb, ub, st);
      39  
      40    if (*status != CFI_SUCCESS)
      41      {
      42        printf("FAIL C: status is %i\n",status);
      43        return;
      44      }
      45  
      46    value = CFI_is_contiguous((CFI_cdesc_t *) &that);
      47    err = ((flag == 0 && value != 0)
      48  	 || (flag == 1 && value != 1)
      49  	 || (flag == 2 && value != 0));
      50  
      51    if (err)
      52      {
      53        printf("FAIL C: contiguity for flag value %i - is %i\n", flag, value);
      54        *status = 10;
      55        return;
      56      }
      57  
      58    sum = 0;
      59    for (int i = 0; i < that.dim[0].extent; i++)
      60      {
      61        CFI_index_t idx[] = {i};
      62        sum += (int)(*(float *)CFI_address ((CFI_cdesc_t *)&that, idx));
      63      }
      64  
      65    if (sum != chksum[flag])
      66      {
      67        printf ("FAIL C: check sum = %d(%d)\n", sum, chksum[flag]);
      68        *status = 11;
      69        return;
      70      }
      71  
      72      sa((CFI_cdesc_t *) &that, flag, status);
      73  }