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

Message ID 8fc3b97c-b122-9c2c-4657-4f98cf82973e@codesourcery.com
State New
Headers show
Series
  • [Fortran,PR,libfortran/101317] Bind(c): Improve error checking in CFI_* functions
Related show

Commit Message

Sandra Loosemore July 17, 2021, 12:49 a.m.
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

Comments

Tobias Burnus July 21, 2021, 5:26 p.m. | #1
On 17.07.21 02:49, Sandra Loosemore wrote:

> 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.


Some first comments – I think I have to read though the file
ISO_Fortran_binding.c itself and not only your patch.

> --- 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);


I think there is no need to use '(elem_len = %d)' given that it is always zero as stated in the error message itself.

(Appears twice)

However, the check itself is also wrong – cf. below.

  * * *

Talking about CFI_allocatable, there is also another bug in that function,
untouched by your patch:

  /* If the type is a character, 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->type == CFI_type_signed_char)
     dv->elem_len = elem_len;

The bug is that CFI_type_signed_char is not a character type.

> +  else if (unlikely (compile_options.bounds_check)

> +        && type < 0)

Pointless line break.
> +           fprintf (stderr, "CFI_establish: Extents must be nonnegative "

> +                    "(extents[%d] = %d).\n", i, (int)extents[i]);

> +           return CFI_INVALID_EXTENT;

> +         }


How about PRIiPTR + ptrdiff_t instead of %d + (int) cast? At least as
positive value, extent may exceed INT_MAX.

(Twice)

>     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);


What's wrong with  ["", ""]? Or with:
   character(len=:), allocatable :: str2(:)
   str2 = [str1(5:4)]
both are len(...) == 0 arrays with 1 or 2 elements.

> +       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");


I think you could just check for assumed rank – without
CFI_attribute_other in the 'if' and 'nonallocatable nonpointer' in the
error message. Only nonallocatable nonpointer variables can be of
assumed size (in Fortran); I think that makes the message simpler
(focusing on the issue) and if the C user passes an allocatable/pointer,
which is assumed rank, it is also a bug.

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Sandra Loosemore July 21, 2021, 6:01 p.m. | #2
On 7/21/21 11:26 AM, Tobias Burnus wrote:
> On 17.07.21 02:49, Sandra Loosemore wrote:

> 

>> 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.

> 

> Some first comments – I think I have to read though the file 

> ISO_Fortran_binding.c itself and not only your patch.

> 

>> --- 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);

> 

> I think there is no need to use '(elem_len = %d)' given that it is 

> always zero as stated in the error message itself.


Yeah, I could fix this.  I'd initially forgotten that elem_len was an 
unsigned type and was trying to test it by passing a negative value.  :-P

> 

> (Appears twice)

> 

> However, the check itself is also wrong – cf. below.


Hmmm.  CFI_establish explicitly says that the elem_len has to be greater 
than zero.  It seems somewhat confusing that it's inconsistent with the 
other functions that take an elem_len argument.

> Talking about CFI_allocatable, there is also another bug in that function,

> untouched by your patch:

> 

>   /* If the type is a character, 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->type == CFI_type_signed_char)

>      dv->elem_len = elem_len;

> 

> The bug is that CFI_type_signed_char is not a character type.


Ha!  I noticed the same thing and already posted a separate patch for 
that.  :-P

https://gcc.gnu.org/pipermail/fortran/2021-July/056243.html

>> +  else if (unlikely (compile_options.bounds_check)

>> +       && type < 0)

> Pointless line break.

>> +          fprintf (stderr, "CFI_establish: Extents must be nonnegative "

>> +               "(extents[%d] = %d).\n", i, (int)extents[i]);

>> +          return CFI_INVALID_EXTENT;

>> +        }

> 

> How about PRIiPTR + ptrdiff_t instead of %d + (int) cast? At least as 

> positive value, extent may exceed INT_MAX.


Hmmm, there are similar problems in existing code in other functions in 
this file (e.g., CFI_section).

>> +      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");

> 

> I think you could just check for assumed rank – without 

> CFI_attribute_other in the 'if' and 'nonallocatable nonpointer' in the 

> error message. Only nonallocatable nonpointer variables can be of 

> assumed size (in Fortran); I think that makes the message simpler 

> (focusing on the issue) and if the C user passes an allocatable/pointer, 

> which is assumed rank, it is also a bug.


The wording of the message reflects the language of the standard:
"source shall be a null pointer or the address of a C descriptor for an 
allocated allocatable object, a data pointer object, or a nonallocatable 
nonpointer data object that is not an assumed-size array.

-Sandra
Tobias Burnus July 22, 2021, 7:54 a.m. | #3
Hi Sandra,

On 21.07.21 20:01, Sandra Loosemore wrote:
> Hmmm. CFI_establish explicitly says that the elem_len has to be

> greater than zero.  It seems somewhat confusing that it's inconsistent

> with the other functions that take an elem_len argument.


Congratulation – we have found a bug in the spec, which is also
present in the current draft (21-007). I have now written to J3:
https://mailman.j3-fortran.org/pipermail/j3/2021-July/013189.html

> Ha! I noticed the same thing and already posted a separate patch for

> that.  :-P

> https://gcc.gnu.org/pipermail/fortran/2021-July/056243.html

:-)
>> How about PRIiPTR + ptrdiff_t instead of %d + (int) cast? At least as

>> positive value, extent may exceed INT_MAX.

> Hmmm, there are similar problems in existing code in other functions

> in this file (e.g., CFI_section).


I think that you could fix as well. At least for size(array), it is not
uncommon that this exceeds MAX_INT.

On the other hand, I think it is unlikely to occur for a single
dimension (→ extent). In particular, the most likely way to get a
negative value is doing 'int' calculations with an overflow – and then
assigning the result "array->dim[i].extent". But in that case, that
(possibly negative) value fits into an int by construction.

>>> +      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");

>>

>> I think you could just check for assumed rank – without

>> CFI_attribute_other in the 'if' and 'nonallocatable nonpointer' in

>> the error message. Only nonallocatable nonpointer variables can be of

>> assumed size (in Fortran); I think that makes the message simpler

>> (focusing on the issue) and if the C user passes an

>> allocatable/pointer, which is assumed rank, it is also a bug.

>

> The wording of the message reflects the language of the standard:

> "source shall be a null pointer or the address of a C descriptor for

> an allocated allocatable object, a data pointer object, or a

> nonallocatable nonpointer data object that is not an assumed-size array.


I know – but the wording is such that it permits all 'nonallocatable
nonpointer data object' – with one exception.

This does not mean that 'assumed-size array' is only invalid for
'nonallocatable nonpointer' – it is also invalid for
allocatables/pointers. The latter cannot occur for Fortran code as only
deferred-shape arrays are permitted in that case, but from the C side,
you can easily set it to the wrong value.

Thus, by simplifying the wording, the error message is clearer (directly
pointing to the issue) and it additionally catches another wrong use of
the array descriptor, which can be (only) triggered from C.

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Sandra Loosemore July 25, 2021, 4:11 a.m. | #4
On 7/22/21 1:54 AM, Tobias Burnus wrote:
> Hi Sandra,

> 

> On 21.07.21 20:01, Sandra Loosemore wrote:

>> Hmmm. CFI_establish explicitly says that the elem_len has to be 

>> greater than zero.  It seems somewhat confusing that it's inconsistent 

>> with the other functions that take an elem_len argument.

> 

> Congratulation – we have found a bug in the spec, which is also

> present in the current draft (21-007). I have now written to J3:

> https://mailman.j3-fortran.org/pipermail/j3/2021-July/013189.html


That discussion seems to have wandered off into some other direction so 
I'm not sure whether it really clarifies this problem.  For the purposes 
of this patch I have left in the test for elem_len > 0 in CFI_establish 
where the standard explicitly has that requirement and removed it from 
the other functions where I'd added it just to be consistent.

>>> How about PRIiPTR + ptrdiff_t instead of %d + (int) cast? At least as 

>>> positive value, extent may exceed INT_MAX.

>> Hmmm, there are similar problems in existing code in other functions 

>> in this file (e.g., CFI_section).

> 

> I think that you could fix as well. At least for size(array), it is not 

> uncommon that this exceeds MAX_INT.


OK, I have done that throughout the file, and also made the wording 
change you asked for.  While I was at it, I went through all the 
diagnostic messages in the file and simplified the wording of a few 
other messages as well, fixed typos and inconsistent capitalization and 
missing punctuation and things like that.  As documentation maintainer I 
can self-approve those changes but of course I'll address complaints 
from the Fortran experts with what I've done there.

Here's a new patch.  For this version I've split off the fixes for the 
new tests in the TS29113 testsuite and merged them back into a new 
version of the main patch, which I will be posting soon.

-Sandra
commit 4940cf8cd97e718e7e9a89784e1f788d51ce64c2
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_establish and CFI_setpointer.  It also changes existing messages
    throughout the CFI_* functions to use PRIiPTR to format CFI_index_t
    values instead of casting them to int and using %d (which may not work
    on targets where int is a smaller type), simplifies wording of some
    messages, and fixes issues with capitalization, typos, and the like.
    Additionally some coding standards problems such as >80 character lines
    are addressed.
    
    2021-07-24  Sandra Loosemore  <sandra@codesourcery.com>
    
    	PR libfortran/101317
    
    libgfortran/
    	* runtime/ISO_Fortran_binding.c: Include <inttypes.h>.
    	(CFI_address): Tidy error messages and comments.
    	(CFI_allocate): Likewise.
    	(CFI_deallocate): Likewise.
    	(CFI_establish): Likewise.  Add new checks for validity of
    	elem_len when it's used, plus type argument and extents.
    	(CFI_is_contiguous): Tidy error messages and comments.
    	(CFI_section): Likewise.  Refactor some repetitive code to
    	make it more understandable.
    	(CFI_select_part): Likewise.
    	(CFI_setpointer): Likewise.  Check that source is not an
    	unallocated allocatable array or an assumed-size array.
    
    gcc/testsuite/
    	* gfortran.dg/ISO_Fortran_binding_17.f90: Fix typo in error
    	message patterns.

diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90
index bb30931..5902334 100644
--- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90
@@ -71,7 +71,7 @@
    end block blk2
 end
 
-! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -1, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r)" }
-! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 5, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r).*" }
-! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -3, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" }
-! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 2, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" }
+! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -1, lower_bound = 0, upper bound = 4, extent = 4(\n|\r\n|\r)" }
+! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 5, lower_bound = 0, upper bound = 4, extent = 4(\n|\r\n|\r).*" }
+! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -3, lower_bound = -2, upper bound = 6, extent = 4(\n|\r\n|\r)" }
+! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 2, lower_bound = -2, upper bound = 6, extent = 4(\n|\r\n|\r)" }
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 31dfdc9..bbf3e79 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "libgfortran.h"
 #include "ISO_Fortran_binding.h"
 #include <string.h>
+#include <inttypes.h>   /* for PRIiPTR */
 
 extern void cfi_desc_to_gfc_desc (gfc_array_void *, CFI_cdesc_t **);
 export_proto(cfi_desc_to_gfc_desc);
@@ -150,17 +151,17 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
 
   if (unlikely (compile_options.bounds_check))
     {
-      /* C Descriptor must not be NULL. */
+      /* C descriptor must not be NULL. */
       if (dv == NULL)
 	{
-	  fprintf (stderr, "CFI_address: C Descriptor is NULL.\n");
+	  fprintf (stderr, "CFI_address: C descriptor is NULL.\n");
 	  return NULL;
 	}
 
-      /* Base address of C Descriptor must not be NULL. */
+      /* Base address of C descriptor must not be NULL. */
       if (dv->base_addr == NULL)
 	{
-	  fprintf (stderr, "CFI_address: base address of C Descriptor "
+	  fprintf (stderr, "CFI_address: base address of C descriptor "
 		   "must not be NULL.\n");
 	  return NULL;
 	}
@@ -184,10 +185,12 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
 	    {
 	      fprintf (stderr, "CFI_address: subscripts[%d] is out of "
 		       "bounds. For dimension = %d, subscripts = %d, "
-		       "lower_bound = %d, upper bound = %d, extend = %d\n",
-		       i, i, (int)subscripts[i], (int)dv->dim[i].lower_bound,
-		       (int)(dv->dim[i].extent - dv->dim[i].lower_bound),
-		       (int)dv->dim[i].extent);
+		       "lower_bound = %" PRIiPTR ", upper bound = %" PRIiPTR
+		       ", extent = %" PRIiPTR "\n",
+		       i, i, (int)subscripts[i],
+		       (ptrdiff_t)dv->dim[i].lower_bound,
+		       (ptrdiff_t)(dv->dim[i].extent - dv->dim[i].lower_bound),
+		       (ptrdiff_t)dv->dim[i].extent);
               return NULL;
             }
 
@@ -205,14 +208,14 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
 {
   if (unlikely (compile_options.bounds_check))
     {
-      /* C Descriptor must not be NULL. */
+      /* C descriptor must not be NULL. */
       if (dv == NULL)
 	{
-	  fprintf (stderr, "CFI_allocate: C Descriptor is NULL.\n");
+	  fprintf (stderr, "CFI_allocate: C descriptor is NULL.\n");
 	  return CFI_INVALID_DESCRIPTOR;
 	}
 
-      /* The C Descriptor must be for an allocatable or pointer object. */
+      /* The C descriptor must be for an allocatable or pointer object. */
       if (dv->attribute == CFI_attribute_other)
 	{
 	  fprintf (stderr, "CFI_allocate: The object of the C descriptor "
@@ -220,7 +223,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
 	  return CFI_INVALID_ATTRIBUTE;
 	}
 
-      /* Base address of C Descriptor must be NULL. */
+      /* Base address of C descriptor must be NULL. */
       if (dv->base_addr != NULL)
 	{
 	  fprintf (stderr, "CFI_allocate: Base address of C descriptor "
@@ -244,8 +247,9 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
       if (unlikely (compile_options.bounds_check)
 	  && (lower_bounds == NULL || upper_bounds == NULL))
 	{
-	  fprintf (stderr, "CFI_allocate: If 0 < rank (= %d) upper_bounds[] "
-		   "and lower_bounds[], must not be NULL.\n", dv->rank);
+	  fprintf (stderr, "CFI_allocate: The lower_bounds and "
+		   "upper_bounds arguments must be non-NULL when "
+		   "rank is greater than zero.\n");
 	  return CFI_INVALID_EXTENT;
 	}
 
@@ -274,10 +278,10 @@ CFI_deallocate (CFI_cdesc_t *dv)
 {
   if (unlikely (compile_options.bounds_check))
     {
-      /* C Descriptor must not be NULL */
+      /* C descriptor must not be NULL */
       if (dv == NULL)
 	{
-	  fprintf (stderr, "CFI_deallocate: C Descriptor is NULL.\n");
+	  fprintf (stderr, "CFI_deallocate: C descriptor is NULL.\n");
 	  return CFI_INVALID_DESCRIPTOR;
 	}
 
@@ -288,10 +292,10 @@ CFI_deallocate (CFI_cdesc_t *dv)
 	  return CFI_ERROR_BASE_ADDR_NULL;
 	}
 
-      /* C Descriptor must be for an allocatable or pointer variable. */
+      /* C descriptor must be for an allocatable or pointer variable. */
       if (dv->attribute == CFI_attribute_other)
 	{
-	  fprintf (stderr, "CFI_deallocate: C Descriptor must describe a "
+	  fprintf (stderr, "CFI_deallocate: C descriptor must describe a "
 		  "pointer or allocatable object.\n");
 	  return CFI_INVALID_ATTRIBUTE;
 	}
@@ -326,14 +330,13 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
 	  return CFI_INVALID_RANK;
 	}
 
-      /* If base address is not NULL, the established C Descriptor is for a
+      /* If base address is not NULL, the established C descriptor is for a
 	  nonallocatable entity. */
       if (attribute == CFI_attribute_allocatable && base_addr != NULL)
 	{
-	  fprintf (stderr, "CFI_establish: If base address is not NULL "
-		   "(base_addr != NULL), the established C descriptor is "
-		   "for a nonallocatable entity (attribute != %d).\n",
-		   CFI_attribute_allocatable);
+	  fprintf (stderr, "CFI_establish: If base address is not NULL, "
+		   "the established C descriptor must be "
+		   "for a nonallocatable entity.\n");
 	  return CFI_INVALID_ATTRIBUTE;
 	}
     }
@@ -342,11 +345,26 @@ 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 (stderr, "CFI_establish: The supplied elem_len must "
+		   "be greater than zero.\n");
+	  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. */
@@ -376,13 +394,24 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
       if (unlikely (compile_options.bounds_check) && extents == NULL)
         {
 	  fprintf (stderr, "CFI_establish: Extents must not be NULL "
-		   "(extents != NULL) if rank (= %d) > 0 and base address "
-		   "is not NULL (base_addr != NULL).\n", (int)rank);
+		   "if rank is greater than zero and base address is "
+		   "not NULL.\n");
 	  return CFI_INVALID_EXTENT;
 	}
 
       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] = %" PRIiPTR ").\n",
+		       i, (ptrdiff_t)extents[i]);
+	      return CFI_INVALID_EXTENT;
+	    }
 	  dv->dim[i].lower_bound = 0;
 	  dv->dim[i].extent = extents[i];
 	  if (i == 0)
@@ -415,16 +444,16 @@ int CFI_is_contiguous (const CFI_cdesc_t *dv)
       /* Base address must not be NULL. */
       if (dv->base_addr == NULL)
 	{
-	  fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
+	  fprintf (stderr, "CFI_is_contiguous: Base address of C descriptor "
 		   "is already NULL.\n");
 	  return 0;
 	}
 
       /* Must be an array. */
-      if (dv->rank == 0)
+      if (dv->rank <= 0)
 	{
-	  fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
-		   "array (0 < dv->rank = %d).\n", dv->rank);
+	  fprintf (stderr, "CFI_is_contiguous: C descriptor must describe "
+		   "an array.\n");
 	  return 0;
 	}
     }
@@ -433,8 +462,8 @@ int CFI_is_contiguous (const CFI_cdesc_t *dv)
   if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
     return 1;
 
-  /* If an array is not contiguous the memory stride is different to the element
-   * length. */
+  /* If an array is not contiguous the memory stride is different to
+     the element length. */
   for (int i = 0; i < dv->rank; i++)
     {
       if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
@@ -461,14 +490,13 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
   CFI_index_t upper[CFI_MAX_RANK];
   CFI_index_t stride[CFI_MAX_RANK];
   int zero_count = 0;
-  bool assumed_size;
 
   if (unlikely (compile_options.bounds_check))
     {
-      /* C Descriptors must not be NULL. */
+      /* C descriptors must not be NULL. */
       if (source == NULL)
 	{
-	  fprintf (stderr, "CFI_section: Source must not be  NULL.\n");
+	  fprintf (stderr, "CFI_section: Source must not be NULL.\n");
 	  return CFI_INVALID_DESCRIPTOR;
 	}
 
@@ -498,8 +526,7 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
 	 allocated allocatable array or an associated pointer array). */
       if (source->rank <= 0)
 	{
-	  fprintf (stderr, "CFI_section: Source must describe an array "
-		       "(0 < source->rank, 0 !< %d).\n", source->rank);
+	  fprintf (stderr, "CFI_section: Source must describe an array.\n");
 	  return CFI_INVALID_RANK;
 	}
 
@@ -507,9 +534,9 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
       if (result->elem_len != source->elem_len)
 	{
 	  fprintf (stderr, "CFI_section: The element lengths of "
-		   "source (source->elem_len = %d) and result "
-		   "(result->elem_len = %d) must be equal.\n",
-		   (int)source->elem_len, (int)result->elem_len);
+		   "source (source->elem_len = %" PRIiPTR ") and result "
+		   "(result->elem_len = %" PRIiPTR ") must be equal.\n",
+		   (ptrdiff_t)source->elem_len, (ptrdiff_t)result->elem_len);
 	  return CFI_INVALID_ELEM_LEN;
 	}
 
@@ -561,7 +588,7 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
       if (unlikely (compile_options.bounds_check)
 	  && source->dim[source->rank - 1].extent == -1)
         {
-	  fprintf (stderr, "CFI_section: Source must not be an assumed size "
+	  fprintf (stderr, "CFI_section: Source must not be an assumed-size "
 		   "array if upper_bounds is NULL.\n");
 	  return CFI_INVALID_EXTENT;
 	}
@@ -590,64 +617,70 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
 	  if (unlikely (compile_options.bounds_check)
 	      && stride[i] == 0 && lower[i] != upper[i])
 	    {
-	      fprintf (stderr, "CFI_section: If strides[%d] = 0, then the "
-		       "lower bounds, lower_bounds[%d] = %d, and "
-		       "upper_bounds[%d] = %d, must be equal.\n",
-		       i, i, (int)lower_bounds[i], i, (int)upper_bounds[i]);
+	      fprintf (stderr, "CFI_section: If strides[%d] = 0, then "
+		       "lower_bounds[%d] = %" PRIiPTR " and "
+		       "upper_bounds[%d] = %" PRIiPTR " must be equal.\n",
+		       i, i, (ptrdiff_t)lower_bounds[i], i,
+		       (ptrdiff_t)upper_bounds[i]);
 	      return CFI_ERROR_OUT_OF_BOUNDS;
 	    }
 	}
     }
 
   /* Check that section upper and lower bounds are within the array bounds. */
-  for (int i = 0; i < source->rank; i++)
-    {
-      assumed_size = (i == source->rank - 1)
-		     && (source->dim[i].extent == -1);
-      if (unlikely (compile_options.bounds_check)
-	  && lower_bounds != NULL
-	  && (lower[i] < source->dim[i].lower_bound ||
-	      (!assumed_size && lower[i] > source->dim[i].lower_bound
-					   + source->dim[i].extent - 1)))
-	{
-	  fprintf (stderr, "CFI_section: Lower bounds must be within the "
-		   "bounds of the fortran array (source->dim[%d].lower_bound "
-		   "<= lower_bounds[%d] <= source->dim[%d].lower_bound "
-		   "+ source->dim[%d].extent - 1, %d <= %d <= %d).\n",
-		   i, i, i, i, (int)source->dim[i].lower_bound, (int)lower[i],
-		   (int)(source->dim[i].lower_bound
-			 + source->dim[i].extent - 1));
-	  return CFI_ERROR_OUT_OF_BOUNDS;
-        }
-
-      if (unlikely (compile_options.bounds_check)
-	  && upper_bounds != NULL
-	  && (upper[i] < source->dim[i].lower_bound
-	      || (!assumed_size
-		  && upper[i] > source->dim[i].lower_bound
-				+ source->dim[i].extent - 1)))
-	{
-	  fprintf (stderr, "CFI_section: Upper bounds must be within the "
-		   "bounds of the fortran array (source->dim[%d].lower_bound "
-		   "<= upper_bounds[%d] <= source->dim[%d].lower_bound + "
-		   "source->dim[%d].extent - 1, %d !<= %d !<= %d).\n",
-		   i, i, i, i, (int)source->dim[i].lower_bound, (int)upper[i],
-		   (int)(source->dim[i].lower_bound
-			 + source->dim[i].extent - 1));
-	  return CFI_ERROR_OUT_OF_BOUNDS;
-	}
-
-      if (unlikely (compile_options.bounds_check)
-	  && upper[i] < lower[i] && stride[i] >= 0)
-        {
-          fprintf (stderr, "CFI_section: If the upper bound is smaller than "
-		   "the lower bound for a given dimension (upper[%d] < "
-		   "lower[%d], %d < %d), then he stride for said dimension"
-		   "t must be negative (stride[%d] < 0, %d < 0).\n",
-		   i, i, (int)upper[i], (int)lower[i], i, (int)stride[i]);
-	  return CFI_INVALID_STRIDE;
-	}
-    }
+  if (unlikely (compile_options.bounds_check))
+    for (int i = 0; i < source->rank; i++)
+      {
+	bool assumed_size
+	  = (i == source->rank - 1 && source->dim[i].extent == -1);
+	CFI_index_t ub
+	  = source->dim[i].lower_bound + source->dim[i].extent - 1;
+	if (lower_bounds != NULL
+	    && (lower[i] < source->dim[i].lower_bound
+		|| (!assumed_size && lower[i] > ub)))
+	  {
+	    fprintf (stderr, "CFI_section: Lower bounds must be within "
+		     "the bounds of the Fortran array "
+		     "(source->dim[%d].lower_bound "
+		     "<= lower_bounds[%d] <= source->dim[%d].lower_bound "
+		     "+ source->dim[%d].extent - 1, "
+		     "%" PRIiPTR " <= %" PRIiPTR " <= %" PRIiPTR ").\n",
+		     i, i, i, i,
+		     (ptrdiff_t)source->dim[i].lower_bound,
+		     (ptrdiff_t)lower[i],
+		     (ptrdiff_t)ub);
+	    return CFI_ERROR_OUT_OF_BOUNDS;
+	  }
+
+	if (upper_bounds != NULL
+	    && (upper[i] < source->dim[i].lower_bound
+		|| (!assumed_size && upper[i] > ub)))
+	  {
+	    fprintf (stderr, "CFI_section: Upper bounds must be within "
+		     "the bounds of the Fortran array "
+		     "(source->dim[%d].lower_bound "
+		     "<= upper_bounds[%d] <= source->dim[%d].lower_bound "
+		     "+ source->dim[%d].extent - 1, "
+		     "%" PRIiPTR " !<= %" PRIiPTR " !<= %" PRIiPTR ").\n",
+		     i, i, i, i,
+		     (ptrdiff_t)source->dim[i].lower_bound,
+		     (ptrdiff_t)upper[i],
+		     (ptrdiff_t)ub);
+	    return CFI_ERROR_OUT_OF_BOUNDS;
+	  }
+
+	if (upper[i] < lower[i] && stride[i] >= 0)
+	  {
+	    fprintf (stderr, "CFI_section: If the upper bound is smaller than "
+		     "the lower bound for a given dimension (upper[%d] < "
+		     "lower[%d], %" PRIiPTR " < %" PRIiPTR "), then the "
+		     "stride for said dimension must be negative "
+		     "(stride[%d] < 0, %" PRIiPTR " < 0).\n",
+		     i, i, (ptrdiff_t)upper[i], (ptrdiff_t)lower[i],
+		     i, (ptrdiff_t)stride[i]);
+	    return CFI_INVALID_STRIDE;
+	  }
+      }
 
   /* Set the base address.  We have to compute this first in the case
      where source == result, before we overwrite the dimension data.  */
@@ -674,7 +707,7 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
 {
   if (unlikely (compile_options.bounds_check))
     {
-      /* C Descriptors must not be NULL. */
+      /* C descriptors must not be NULL. */
       if (source == NULL)
 	{
 	  fprintf (stderr, "CFI_select_part: Source must not be NULL.\n");
@@ -737,8 +770,9 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
 	{
 	  fprintf (stderr, "CFI_select_part: Displacement must be within the "
 		   "bounds of source (0 <= displacement <= source->elem_len "
-		   "- 1, 0 <= %d <= %d).\n", (int)displacement,
-		   (int)(source->elem_len - 1));
+		   "- 1, 0 <= %" PRIiPTR " <= %" PRIiPTR ").\n",
+		   (ptrdiff_t)displacement,
+		   (ptrdiff_t)(source->elem_len - 1));
 	  return CFI_ERROR_OUT_OF_BOUNDS;
 	}
 
@@ -749,10 +783,12 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
 	  fprintf (stderr, "CFI_select_part: Displacement plus the element "
 		   "length of result must be less than or equal to the "
 		   "element length of source (displacement + result->elem_len "
-		   "<= source->elem_len, %d + %d = %d <= %d).\n",
-		   (int)displacement, (int)result->elem_len,
-		   (int)(displacement + result->elem_len),
-		   (int)source->elem_len);
+		   "<= source->elem_len, "
+		   "%" PRIiPTR " + %" PRIiPTR " = %" PRIiPTR " <= %" PRIiPTR
+		   ").\n",
+		   (ptrdiff_t)displacement, (ptrdiff_t)result->elem_len,
+		   (ptrdiff_t)(displacement + result->elem_len),
+		   (ptrdiff_t)source->elem_len);
 	  return CFI_ERROR_OUT_OF_BOUNDS;
 	}
     }
@@ -792,7 +828,7 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
  	}
     }
       
-  /* If source is NULL, the result is a C Descriptor that describes a
+  /* If source is NULL, the result is a C descriptor that describes a
    * disassociated pointer. */
   if (source == NULL)
     {
@@ -801,40 +837,56 @@ 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->rank > 0
+	      && source->dim[source->rank - 1].extent == -1)
+	    {
+	      fprintf (stderr, "CFI_setpointer: The source 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 "
-		       "(result->elem_len = %d) and source (source->elem_len "
-		       "= %d) must be the same.\n", (int)result->elem_len,
-		       (int)source->elem_len);
+		       "(result->elem_len = %" PRIiPTR ") and source "
+		       "(source->elem_len = %" PRIiPTR ") "
+		       " must be the same.\n",
+		       (ptrdiff_t)result->elem_len,
+		       (ptrdiff_t)source->elem_len);
 	      return CFI_INVALID_ELEM_LEN;
 	    }
 
 	  if (result->rank != source->rank)
 	    {
-	      fprintf (stderr, "CFI_setpointer: Ranks of result (result->rank "
-		       "= %d) and source (source->rank = %d) must be the same."
-		       "\n", result->rank, source->rank);
+	      fprintf (stderr, "CFI_setpointer: Ranks of result "
+		       "(result->rank = %d) and source (source->rank = %d) "
+		       "must be the same.\n", result->rank, source->rank);
 	      return CFI_INVALID_RANK;
 	    }
 
 	  if (result->type != source->type)
 	    {
-	      fprintf (stderr, "CFI_setpointer: Types of result (result->type"
-		       "= %d) and source (source->type = %d) must be the same."
-		       "\n", result->type, source->type);
+	      fprintf (stderr, "CFI_setpointer: Types of result "
+		       "(result->type = %d) and source (source->type = %d) "
+		       "must be the same.\n", result->type, source->type);
 	      return CFI_INVALID_TYPE;
 	    }
 	}
 
-      /* 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;
Tobias Burnus July 26, 2021, 7:35 a.m. | #5
Hi Sandra,

On 25.07.21 06:11, Sandra Loosemore wrote:
>> Congratulation – we have found a bug in the spec, which is also

>> present in the current draft (21-007). I have now written to J3:

>> https://mailman.j3-fortran.org/pipermail/j3/2021-July/013189.html

>

> That discussion seems to have wandered off into some other direction

> so I'm not sure whether it really clarifies this problem.


I concur. I do hope that it will be at some point discussed and clarified.

But for now:

> For the purposes of this patch I have left in the test for elem_len >

> 0 in CFI_establish where the standard explicitly has that requirement

> and removed it from the other functions where I'd added it just to be

> consistent.

I think that makes sense.
> OK, I have done that throughout the file, and also made the wording

> change you asked for.  While I was at it, I went through all the

> diagnostic messages in the file and simplified the wording of a few

> other messages as well, fixed typos and inconsistent capitalization

> and missing punctuation and things like that.

Thanks!
> Here's a new patch.


LGTM.

Thanks,

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

Patch

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;