This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR fortran/92142 - CFI_setpointer corrupts descriptor


Hi all!

Proposed patch to solve the handling of the attribute value in the descriptor.

Patch tested only on x86_64-pc-linux-gnu.

CFI_setpointer does not check if it is setting a pointer and will set any type of object to the target.

CFI_setpointer will also change the pointer attribute of the pointer to whatever is the target's attribute corrupting the descriptor.

Thank you very much.

Best regards,
José Rui

2019-10-17  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

 PR fortran/92142
 * ISO_Fortran_binding.c (CFI_setpointer): Add check to verify if the
 object being set (result) is really a pointer. Remove two instances
 where the result attribute value is overwritten.

2019-10-17  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

 PR fortran/92142
 * ISO_Fortran_binding_15.f90: New test.
 * ISO_Fortran_binding_15.c: Additional source.

Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
--- libgfortran/runtime/ISO_Fortran_binding.c	(revision 276937)
+++ libgfortran/runtime/ISO_Fortran_binding.c	(working copy)
@@ -795,13 +795,21 @@
 int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
 		    const CFI_index_t lower_bounds[])
 {
-  /* Result must not be NULL. */
-  if (unlikely (compile_options.bounds_check) && result == NULL)
+  /* Result must not be NULL and must be a Fortran pointer. */
+  if (unlikely (compile_options.bounds_check))
     {
-      fprintf (stderr, "CFI_setpointer: Result is NULL.\n");
-      return CFI_INVALID_DESCRIPTOR;
+      if (result == NULL)
+	{
+	  fprintf (stderr, "CFI_setpointer: Result is NULL.\n");
+	  return CFI_INVALID_DESCRIPTOR;
+	}
+
+      if (result->attribute != CFI_attribute_pointer)
+	{
+ 	  fprintf (stderr, "CFI_setpointer: Result is not a Fortran pointer.\n");
+ 	  return CFI_INVALID_ATTRIBUTE;
+ 	}
     }
-
   /* If source is NULL, the result is a C Descriptor that describes a
    * disassociated pointer. */
   if (source == NULL)
@@ -808,7 +816,6 @@
     {
       result->base_addr = NULL;
       result->version  = CFI_VERSION;
-      result->attribute = CFI_attribute_pointer;
     }
   else
     {
@@ -852,7 +859,6 @@

       /* Assign components to result. */
       result->version = source->version;
-      result->attribute = source->attribute;

       /* Dimension information. */
       for (int i = 0; i < source->rank; i++)
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c
===================================================================
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c	(nonexistent)
+++ gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.c	(working copy)
@@ -0,0 +1,41 @@
+/* Test the fix of .  */
+
+/* #include "../../../libgfortran/ISO_Fortran_binding.h" */
+#include "ISO_Fortran_binding.h"
+
+#include <stdlib.h>
+
+int c_setpointer(CFI_cdesc_t *);
+
+int c_setpointer(CFI_cdesc_t *ip)
+{
+  CFI_cdesc_t *yp = NULL;
+  void *auxp = ip->base_addr;
+  int ierr;
+  int status;
+
+  /* Setting up the pointer */
+  ierr = 1;
+  yp = malloc(sizeof(*ip));
+  if (yp == NULL) return ierr;
+ status = CFI_establish(yp, NULL, CFI_attribute_pointer, ip->type, ip->elem_len, ip->rank, NULL);
+  if (status != CFI_SUCCESS) return ierr;
+  if (yp->attribute != CFI_attribute_pointer) return ierr;
+  /* Set the pointer to ip */
+  ierr = 2;
+  status = CFI_setpointer(yp, ip, NULL);
+  if (status != CFI_SUCCESS) return ierr;
+  if (yp->attribute != CFI_attribute_pointer) return ierr;
+  /* Set the pointer to NULL */
+  ierr = 3;
+  status = CFI_setpointer(yp, NULL, NULL);
+  if (status != CFI_SUCCESS) return ierr;
+  if (yp->attribute != CFI_attribute_pointer) return ierr;
+  /* "Set" the ip variable to yp (should not be possible) */
+  ierr = 4;
+  status = CFI_setpointer(ip, yp, NULL);
+  if (status != CFI_INVALID_ATTRIBUTE) return ierr;
+  if (ip->attribute != CFI_attribute_other) return ierr;
+  if (ip->base_addr != auxp) return ierr;
+  return 0;
+}
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/ISO_Fortran_binding_15.f90	(working copy)
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-additional-options "-fbounds-check" }
+! { dg-additional-sources ISO_Fortran_binding_15.c }
+!
+!
+  use, intrinsic :: iso_c_binding, only: c_int
+
+  implicit none
+
+  interface
+    function c_setpointer(ip) result(ierr) bind(c)
+      use, intrinsic :: iso_c_binding, only: c_int
+      type(*), dimension(..), target :: ip
+      integer(c_int)                 :: ierr
+    end function c_setpointer
+  end interface
+
+  integer(c_int) :: it = 1
+
+  if (c_setpointer(it) /= 0) stop 1
+
+end



Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]