(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
ISO_Fortran_binding_16.c
       1  /* Test the fix for PR92142. */
       2  
       3  #include <ISO_Fortran_binding.h>
       4  
       5  #include <stdlib.h>
       6  
       7  int c_setpointer(CFI_cdesc_t *);
       8  
       9  int c_setpointer(CFI_cdesc_t *ip)
      10  {
      11    CFI_cdesc_t *yp = NULL;
      12    void *auxp = ip->base_addr;
      13    int ierr;
      14    int status;
      15  
      16    /* Setting up the pointer */
      17    ierr = 1;
      18    yp = malloc(sizeof(*ip));
      19    if (yp == NULL) return ierr;
      20    status = CFI_establish(yp, NULL, CFI_attribute_pointer, ip->type, ip->elem_len, ip->rank, NULL);
      21    if (status != CFI_SUCCESS) return ierr;
      22    if (yp->attribute != CFI_attribute_pointer) return ierr;
      23    /* Set the pointer to ip */
      24    ierr = 2;
      25    status = CFI_setpointer(yp, ip, NULL);
      26    if (status != CFI_SUCCESS) return ierr;
      27    if (yp->attribute != CFI_attribute_pointer) return ierr;
      28    /* Set the pointer to NULL */
      29    ierr = 3;
      30    status = CFI_setpointer(yp, NULL, NULL);
      31    if (status != CFI_SUCCESS) return ierr;
      32    if (yp->attribute != CFI_attribute_pointer) return ierr;
      33    /* "Set" the ip variable to yp (should not be possible) */
      34    ierr = 4;
      35    status = CFI_setpointer(ip, yp, NULL);
      36    if (status != CFI_INVALID_ATTRIBUTE) return ierr;
      37    if (ip->attribute != CFI_attribute_other) return ierr;
      38    if (ip->base_addr != auxp) return ierr;
      39    return 0;
      40  }