[PATCH, Fortran] [PR libfortran/101317] Bind(c): Improve error checking in CFI_* functions

[Sandra Loosemore <sandra@codesourcery.com>]

[-- Attachment #1: Type: text/plain, Size: 523 bytes --]

This patch is for PR101317, one of the bugs uncovered by the TS29113 
testsuite.  Here I'd observed that CFI_establish, etc was not diagnosing 
some invalid-argument situations documented in the standard, although it 
was properly catching others.  After fixing those I discovered a couple 
small mistakes in the test cases and fixed those too.

The testsuite fixes can either be committed with this patch or rolled 
into the TS29113 testsuite, depending on the order in which things are 
approved/committed.

OK?

-Sandra

[-- Attachment #2: pr101317.patch --]
[-- Type: text/x-patch, Size: 7920 bytes --]

commit 6cecb3e3625072c7846434df9dcd8db5e6f66432
Author: Sandra Loosemore <sandra@codesourcery.com>
Date:   Thu Jul 15 08:48:45 2021 -0700

    [PR libfortran/101317] Bind(c): Improve error checking in CFI_* functions
    
    This patch adds additional run-time checking for invalid arguments to
    CFI_allocate, CFI_establish, CFI_select_part, and CFI_setpointer.
    
    It also includes some minor fixes for signed/unsigned confusion in the
    TS29113 testsuite.
    
    2021-07-16  Sandra Loosemore  <sandra@codesourcery.com>
    
    	PR libfortran/101317
    
    libgfortran/
    	* runtime/ISO_Fortran_binding.c (CFI_allocate): Check elem_len
    	for validity when it's used.
    	(CFI_establish): Likewise.  Also check type argument and extents.
    	(CFI_select_part): Check elem_len.
    	(CFI_setpointer): Check that source is not an unallocated
    	allocatable array or an assumed-size array.  Minor formatting
    	cleanup.
    
    gcc/testsuite/
    	* gfortran.dg/ts29113/library/establish-errors-c.c (ctest):
    	Correct unsigned argument to CFI_establish.
    	* gfortran.dg/ts29113/library/setpointer-errors-c.c (ctest):
    	Bypass CFI_establish to create an assumed-size array.

diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c b/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c
index b55362a..ae02b46 100644
--- a/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c
@@ -57,7 +57,7 @@ ctest (void)
      character type, elem_len shall be greater than zero and equal to
      the storage size in bytes of an element of the object.  */
   status = CFI_establish (a, (void *)buf, CFI_attribute_other,
-			  CFI_type_struct, -5, 2, extents);
+			  CFI_type_struct, 0, 2, extents);
   if (status == CFI_SUCCESS)
     {
       fprintf (stderr,
diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c b/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c
index eec96e6..670d360 100644
--- a/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c
+++ b/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c
@@ -8,7 +8,6 @@
 
 static int a[10][5][3];
 static CFI_index_t extents[] = {3, 5, 10};
-static CFI_index_t badextents[] = {3, 5, -1};
 
 /* External entry point.  */
 extern void ctest (void);
@@ -69,9 +68,12 @@ ctest (void)
       bad ++;
     }
 
+  /* CFI_establish rejects negative extents, so we can't use it to make
+     an assumed-size array, so hack the descriptor by hand.  Yuck.  */
   check_CFI_status ("CFI_establish",
 		    CFI_establish (source, (void *)a, CFI_attribute_other,
-				   CFI_type_int, 0, 3, badextents));
+				   CFI_type_int, 0, 3, extents));
+  source->dim[2].extent = -1;
   status = CFI_setpointer (result, source, NULL);
   if (status == CFI_SUCCESS)
     {
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 79bb377..38e1b6e 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -232,7 +232,16 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
   /* If the type is a Fortran character type, the descriptor's element
      length is replaced by the elem_len argument. */
   if (dv->type == CFI_type_char || dv->type == CFI_type_ucs4_char)
-    dv->elem_len = elem_len;
+    {
+      if (unlikely (compile_options.bounds_check) && elem_len == 0)
+	{
+	  fprintf ("CFI_allocate: The supplied elem_len must be "
+		   "greater than zero (elem_len = %d).\n",
+		   (int) elem_len);
+	  return CFI_INVALID_ELEM_LEN;
+	}
+      dv->elem_len = elem_len;
+    }
 
   /* Dimension information and calculating the array length. */
   size_t arr_len = 1;
@@ -342,11 +351,28 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
 
   if (type == CFI_type_char || type == CFI_type_ucs4_char
       || type == CFI_type_struct || type == CFI_type_other)
-    dv->elem_len = elem_len;
+    {
+      /* Note that elem_len has type size_t, which is unsigned.  */
+      if (unlikely (compile_options.bounds_check) && elem_len == 0)
+	{
+	  fprintf ("CFI_establish: The supplied elem_len must be "
+		   "greater than zero (elem_len = %d).\n",
+		   (int) elem_len);
+	  return CFI_INVALID_ELEM_LEN;
+	}
+      dv->elem_len = elem_len;
+    }
   else if (type == CFI_type_cptr)
     dv->elem_len = sizeof (void *);
   else if (type == CFI_type_cfunptr)
     dv->elem_len = sizeof (void (*)(void));
+  else if (unlikely (compile_options.bounds_check)
+	   && type < 0)
+    {
+      fprintf (stderr, "CFI_establish: Invalid type (type = %d).\n",
+	       (int)type);
+      return CFI_INVALID_TYPE;
+    }
   else
     {
       /* base_type describes the intrinsic type with kind parameter. */
@@ -383,6 +409,16 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
 
       for (int i = 0; i < rank; i++)
 	{
+	  /* The standard requires all dimensions to be nonnegative.
+	     Apparently you can have an extent-zero dimension but can't
+	     construct an assumed-size array with -1 as the extent
+	     of the last dimension.  */
+	  if (unlikely (compile_options.bounds_check) && extents[i] < 0)
+	    {
+	      fprintf (stderr, "CFI_establish: Extents must be nonnegative "
+		       "(extents[%d] = %d).\n", i, (int)extents[i]);
+	      return CFI_INVALID_EXTENT;
+	    }
 	  dv->dim[i].lower_bound = 0;
 	  dv->dim[i].extent = extents[i];
 	  if (i == 0)
@@ -734,7 +770,16 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
   /* Element length is ignored unless result->type specifies a Fortran
      character type.  */
   if (result->type == CFI_type_char || result->type == CFI_type_ucs4_char)
-    result->elem_len = elem_len;
+    {
+      if (unlikely (compile_options.bounds_check) && elem_len == 0)
+	{
+	  fprintf ("CFI_select_part: The supplied elem_len must be "
+		   "greater than zero (elem_len = %d).\n",
+		   (int) elem_len);
+	  return CFI_INVALID_ELEM_LEN;
+	}
+      result->elem_len = elem_len;
+    }
 
   if (unlikely (compile_options.bounds_check))
     {
@@ -808,10 +853,26 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
     }
   else
     {
-      /* Check that element lengths, ranks and types of source and result are
-       * the same. */
+      /* Check that the source is valid and that element lengths, ranks
+	 and types of source and result are the same. */
       if (unlikely (compile_options.bounds_check))
 	{
+	  if (source->base_addr == NULL
+	      && source->attribute == CFI_attribute_allocatable)
+	    {
+	      fprintf (stderr, "CFI_setpointer: The source is an "
+		       "allocatable object but is not allocated.\n");
+	      return CFI_ERROR_BASE_ADDR_NULL;
+	    }
+	  if (source->attribute == CFI_attribute_other
+	      && source->rank > 0
+	      && source->dim[source->rank - 1].extent == -1)
+	    {
+	      fprintf (stderr, "CFI_setpointer: The source is a "
+		       "nonallocatable nonpointer object that is an "
+		       "assumed-size array.\n");
+	      return CFI_INVALID_EXTENT;
+	    }
 	  if (result->elem_len != source->elem_len)
 	    {
 	      fprintf (stderr, "CFI_setpointer: Element lengths of result "
@@ -838,10 +899,10 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
 	    }
 	}
 
-      /* If the source is a disassociated pointer, the result must also describe
-       * a disassociated pointer. */
-      if (source->base_addr == NULL &&
-          source->attribute == CFI_attribute_pointer)
+      /* If the source is a disassociated pointer, the result must also
+	 describe a disassociated pointer. */
+      if (source->base_addr == NULL
+	  && source->attribute == CFI_attribute_pointer)
 	result->base_addr = NULL;
       else
 	result->base_addr = source->base_addr;