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 }