PR fortran/92470 Fixes for CFI_address

        libgfortran/
        PR fortran/92470
        * runtime/ISO_Fortran_binding.c (CFI_address): Handle non-zero
        lower_bound; update error message.
        (CFI_allocate): Fix comment typo.
        (CFI_establish): Fix identation, fix typos, don't check values of 'dv'
        argument.

        gcc/testsuite/
        PR fortran/92470
        * gfortran.dg/ISO_Fortran_binding_17.c: New.
        * gfortran.dg/ISO_Fortran_binding_17.f90: New.
        * gfortran.dg/ISO_Fortran_binding_1.c (elemental_mult_c, allocate_c,
        section_c, select_part_c): Update for CFI_{address} changes;
        add asserts.

From-SVN: r278101

2 files changed, 25 insertions, 24 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 075c986..1abdd6a 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-11-12  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/92470
+	* runtime/ISO_Fortran_binding.c (CFI_address): Handle non-zero
+	lower_bound; update error message.
+	(CFI_allocate): Fix comment typo.
+	(CFI_establish): Fix identation, fix typos, don't check values of 'dv'
+	argument.
+
 2019-11-11  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
 
 	PR fortran/92142
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index ae50057..7ae2a93 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -177,19 +177,21 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
 	 specified by subscripts. */
       for (i = 0; i < dv->rank; i++)
 	{
+	  CFI_index_t idx = subscripts[i] - dv->dim[i].lower_bound;
 	  if (unlikely (compile_options.bounds_check)
-	      && ((dv->dim[i].extent != -1
-		   && subscripts[i] >= dv->dim[i].extent)
-		  || subscripts[i] < 0))
+	      && ((dv->dim[i].extent != -1 && idx >= dv->dim[i].extent)
+		  || idx < 0))
 	    {
-	      fprintf (stderr, "CFI_address: subscripts[%d], is out of "
-		       "bounds. dv->dim[%d].extent = %d subscripts[%d] "
-		       "= %d.\n", i, i, (int)dv->dim[i].extent, i,
-		       (int)subscripts[i]);
+	      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);
               return NULL;
             }
 
-	  base_addr = base_addr + (CFI_index_t)(subscripts[i] * dv->dim[i].sm);
+	  base_addr = base_addr + (CFI_index_t)(idx * dv->dim[i].sm);
 	}
     }
 
@@ -228,7 +230,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
     }
 
   /* If the type is a character, the descriptor's element length is replaced
-   * by the elem_len argument. */
+     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;
@@ -237,7 +239,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
   size_t arr_len = 1;
 
   /* If rank is greater than 0, lower_bounds and upper_bounds are used. They're
-   * ignored otherwhise. */
+     ignored otherwise. */
   if (dv->rank > 0)
     {
       if (unlikely (compile_options.bounds_check)
@@ -325,20 +327,10 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
 	{
 	  fprintf (stderr, "CFI_establish: Rank must be between 0 and %d, "
 		   "0 < rank (0 !< %d).\n", CFI_MAX_RANK, (int)rank);
-      return CFI_INVALID_RANK;
-    }
-
-      /* C Descriptor must not be an allocated allocatable. */
-      if (dv->attribute == CFI_attribute_allocatable && dv->base_addr != NULL)
-	{
-	  fprintf (stderr, "CFI_establish: If the C Descriptor represents an "
-		   "allocatable variable (dv->attribute = %d), its base "
-		   "address must be NULL (dv->base_addr = NULL).\n",
-		   CFI_attribute_allocatable);
-	  return CFI_INVALID_DESCRIPTOR;
+	  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)
 	{
@@ -382,13 +374,13 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
   dv->type = type;
 
   /* Extents must not be NULL if rank is greater than zero and base_addr is not
-   * NULL */
+     NULL */
   if (rank > 0 && base_addr != NULL)
     {
       if (unlikely (compile_options.bounds_check) && extents == NULL)
         {
 	  fprintf (stderr, "CFI_establish: Extents must not be NULL "
-		   "(extents != NULL) if rank (= %d) > 0 nd base address"
+		   "(extents != NULL) if rank (= %d) > 0 and base address "
 		   "is not NULL (base_addr != NULL).\n", (int)rank);
 	  return CFI_INVALID_EXTENT;
 	}