libgfortran: Further fixes for GFC/CFI descriptor conversions.

This patch is for:
PR100907 - Bind(c): failure handling wide character
PR100911 - Bind(c): failure handling C_PTR
PR100914 - Bind(c): errors handling complex
PR100915 - Bind(c): failure handling C_FUNPTR
PR100917 - Bind(c): errors handling long double real

All of these problems are related to the GFC descriptors constructed
by the Fortran front end containing ambigous or incomplete
information.  This patch does not attempt to change the GFC data
structure or the front end, and only makes the runtime interpret it in
more reasonable ways.  It's not a complete fix for any of the listed
issues.

The Fortran front end does not distinguish between C_PTR and
C_FUNPTR, mapping both onto BT_VOID.  That is what this patch does also.

The other bugs are related to GFC descriptors only containing elem_len
and not kind.  For complex types, the elem_len needs to be divided by
2 and then mapped onto a real kind.  On x86 targets, the kind
corresponding to C long double is different than its elem_len; since
we cannot accurately disambiguate between a 16-byte kind 10 long
double from __float128, this patch arbitrarily prefers to interpret that as
the standard long double type rather than the GNU extension.

Similarly, for character types, the GFC descriptor cannot distinguish
between character(kind=c_char, len=4) and character(kind=ucs4, len=1).
But since the front end currently rejects anything other than len=1
(PR92482) this patch uses the latter interpretation.

2021-09-01  Sandra Loosemore  <sandra@codesourcery.com>
	    José Rui Faustino de Sousa  <jrfsousa@gmail.com>

gcc/testsuite/
	PR fortran/100911
	PR fortran/100915
	PR fortran/100916
	* gfortran.dg/PR100911.c: New file.
	* gfortran.dg/PR100911.f90: New file.
	* gfortran.dg/PR100914.c: New file.
	* gfortran.dg/PR100914.f90: New file.
	* gfortran.dg/PR100915.c: New file.
	* gfortran.dg/PR100915.f90: New file.

libgfortran/
	PR fortran/100907
	PR fortran/100911
	PR fortran/100914
	PR fortran/100915
	PR fortran/100917
	* ISO_Fortran_binding-1-tmpl.h (CFI_type_cfunptr): Make equivalent
	to CFI_type_cptr.
	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Fix
	handling of CFI_type_cptr and CFI_type_cfunptr.  Additional error
	checking and code cleanup.
	(gfc_desc_to_cfi_desc): Likewise.  Also correct kind mapping
	for character, complex, and long double types.

2 files changed, 103 insertions, 27 deletions

diff --git a/libgfortran/ISO_Fortran_binding-1-tmpl.h b/libgfortran/ISO_Fortran_binding-1-tmpl.h
index 8852c9924fe..b998d6ca8ee 100644
--- a/libgfortran/ISO_Fortran_binding-1-tmpl.h
+++ b/libgfortran/ISO_Fortran_binding-1-tmpl.h
@@ -152,10 +152,14 @@ extern int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []);
 #define CFI_type_Complex 4
 #define CFI_type_Character 5
 
-/* Types with no kind. */
+/* Types with no kind.  FIXME: GFC descriptors currently use BT_VOID for
+   both C_PTR and C_FUNPTR, so we have no choice but to make them
+   identical here too.  That can potentially break on targets where
+   function and data pointers have different sizes/representations.
+   See PR 100915.  */
 #define CFI_type_struct 6
 #define CFI_type_cptr 7
-#define CFI_type_cfunptr 8
+#define CFI_type_cfunptr CFI_type_cptr
 #define CFI_type_other -1
 
 /* Types with kind parameter.
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index f8b3ecd0046..0e1a419460a 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -37,15 +37,16 @@ export_proto(cfi_desc_to_gfc_desc);
 void
 cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
 {
+  signed char type;
+  size_t size;
   int n;
-  index_type kind;
   CFI_cdesc_t *s = *s_ptr;
 
   if (!s)
     return;
 
   /* Verify descriptor.  */
-  switch(s->attribute)
+  switch (s->attribute)
     {
     case CFI_attribute_pointer:
     case CFI_attribute_allocatable:
@@ -63,23 +64,33 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
       break;
     }
   GFC_DESCRIPTOR_DATA (d) = s->base_addr;
-  GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
-  kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift);
 
   /* Correct the unfortunate difference in order with types.  */
-  if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
-    GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED;
-  else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
-    GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER;
-
-  if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
-    GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
-  else if (GFC_DESCRIPTOR_TYPE (d) != BT_DERIVED)
-    GFC_DESCRIPTOR_SIZE (d) = kind;
-  else
-    GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+  type = (signed char)(s->type & CFI_type_mask);
+  switch (type)
+    {
+    case CFI_type_Character:
+      type = BT_CHARACTER;
+      break;
+    case CFI_type_struct:
+      type = BT_DERIVED;
+      break;
+    case CFI_type_cptr:
+      /* FIXME: PR 100915.  GFC descriptors do not distinguish between
+	 CFI_type_cptr and CFI_type_cfunptr.  */
+      type = BT_VOID;
+      break;
+    default:
+      break;
+    }
+
+  GFC_DESCRIPTOR_TYPE (d) = type;
+  GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
 
   d->dtype.version = 0;
+
+  if (s->rank < 0 || s->rank > CFI_MAX_RANK)
+    internal_error (NULL, "Invalid rank in descriptor");
   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
 
   d->dtype.attribute = (signed short)s->attribute;
@@ -116,13 +127,14 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
 {
   int n;
   CFI_cdesc_t *d;
+  signed char type, kind;
 
   /* Play it safe with allocation of the flexible array member 'dim'
      by setting the length to CFI_MAX_RANK. This should not be necessary
      but valgrind complains accesses after the allocated block.  */
   if (*d_ptr == NULL)
-    d = malloc (sizeof (CFI_cdesc_t)
-		+ (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
+    d = calloc (1, (sizeof (CFI_cdesc_t)
+		    + (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t))));
   else
     d = *d_ptr;
 
@@ -145,20 +157,80 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
     }
   d->base_addr = GFC_DESCRIPTOR_DATA (s);
   d->elem_len = GFC_DESCRIPTOR_SIZE (s);
+  if (d->elem_len <= 0)
+    internal_error (NULL, "Invalid size in descriptor");
+
   d->version = CFI_VERSION;
+
   d->rank = (CFI_rank_t)GFC_DESCRIPTOR_RANK (s);
+  if (d->rank < 0 || d->rank > CFI_MAX_RANK)
+    internal_error (NULL, "Invalid rank in descriptor");
+
   d->attribute = (CFI_attribute_t)s->dtype.attribute;
 
-  if (GFC_DESCRIPTOR_TYPE (s) == BT_CHARACTER)
-    d->type = CFI_type_Character;
-  else if (GFC_DESCRIPTOR_TYPE (s) == BT_DERIVED)
-    d->type = CFI_type_struct;
-  else
-    d->type = (CFI_type_t)GFC_DESCRIPTOR_TYPE (s);
+  type = GFC_DESCRIPTOR_TYPE (s);
+  switch (type)
+    {
+    case BT_CHARACTER:
+      d->type = CFI_type_Character;
+      break;
+    case BT_DERIVED:
+      d->type = CFI_type_struct;
+      break;
+    case BT_VOID:
+      /* FIXME: PR 100915.  GFC descriptors do not distinguish between
+	 CFI_type_cptr and CFI_type_cfunptr.  */
+      d->type = CFI_type_cptr;
+      break;
+    default:
+      d->type = (CFI_type_t)type;
+      break;
+    }
 
-  if (GFC_DESCRIPTOR_TYPE (s) != BT_DERIVED)
+  switch (d->type)
+    {
+    case CFI_type_Integer:
+    case CFI_type_Logical:
+    case CFI_type_Real:
+      kind = (signed char)d->elem_len;
+      break;
+    case CFI_type_Complex:
+      kind = (signed char)(d->elem_len >> 1);
+      break;
+    case CFI_type_Character:
+      /* FIXME: we can't distinguish between kind/len because
+	 the GFC descriptor only encodes the elem_len..
+	 Until PR92482 is fixed, assume elem_len refers to the
+	 character size and not the string length.  */
+      kind = (signed char)d->elem_len;
+      break;
+    case CFI_type_struct:
+    case CFI_type_cptr:
+    case CFI_type_other:
+      /* FIXME: PR 100915.  GFC descriptors do not distinguish between
+	 CFI_type_cptr and CFI_type_cfunptr.  */
+      kind = 0;
+      break;
+    default:
+      internal_error (NULL, "Invalid type in descriptor");
+    }
+
+  if (kind < 0)
+    internal_error (NULL, "Invalid kind in descriptor");
+
+  /* FIXME: This is PR100917.  Because the GFC descriptor encodes only the
+     elem_len and not the kind, we get into trouble with long double kinds
+     that do not correspond directly to the elem_len, specifically the
+     kind 10 80-bit long double on x86 targets.  On x86_64, this has size
+     16 and cannot be differentiated from true __float128.  Prefer the
+     standard long double type over the GNU extension in that case.  */
+  if (d->type == CFI_type_Real && kind == sizeof (long double))
+    d->type = CFI_type_long_double;
+  else if (d->type == CFI_type_Complex && kind == sizeof (long double))
+    d->type = CFI_type_long_double_Complex;
+  else
     d->type = (CFI_type_t)(d->type
-		+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
+			   + ((CFI_type_t)kind << CFI_type_kind_shift));
 
   if (d->base_addr)
     /* Full pointer or allocatable arrays retain their lower_bounds.  */