[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Correction ICEs ISO_Fortran_binding_10

[Mikael Morin]

https://gcc.gnu.org/g:a700cbcab0ae943f3d9d6c2da0434e4ec58081e8

commit a700cbcab0ae943f3d9d6c2da0434e4ec58081e8
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Thu Apr 10 11:53:42 2025 +0200

    Correction ICEs ISO_Fortran_binding_10

Diff:
---
 gcc/fortran/trans-array.cc      | 49 +++++++++++++++++++++++++++++++++++++++--
 gcc/fortran/trans-descriptor.cc |  5 ++---
 gcc/fortran/trans-types.cc      |  3 ++-
 gcc/fortran/trans.cc            | 16 ++++++--------
 4 files changed, 58 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6e7f51693eb3..aee9b388871c 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2094,6 +2094,15 @@ gfc_constant_array_constructor_p (gfc_constructor_base base)
 }
 
 
+static void
+append_constructor (vec<constructor_elt, va_gc> *v, tree t)
+{
+  unsigned len = vec_safe_length (v);
+  tree idx = build_int_cst (gfc_array_index_type, len);
+  CONSTRUCTOR_APPEND_ELT (v, idx, t);
+}
+
+
 /* Given EXPR, the constant array constructor specified by an EXPR_ARRAY,
    and the tree type of it's elements, TYPE, return a static constant
    variable that is compile-time initialized.  */
@@ -2122,8 +2131,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
       else if (POINTER_TYPE_P (type))
 	se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
 				       se.expr);
-      CONSTRUCTOR_APPEND_ELT (v, build_int_cst (gfc_array_index_type, nelem),
-                              se.expr);
+      append_constructor (v, se.expr);
       c = gfc_constructor_next (c);
       nelem++;
     }
@@ -2160,6 +2168,43 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
       gfc_free_expr (as.upper[i]);
     }
 
+  if (expr->shape && expr->rank > 1)
+    {
+      vec<constructor_elt, va_gc> *vsrc = v;
+
+      for (int r = 0; r < expr->rank - 1; r++)
+	{
+	  vec<constructor_elt, va_gc> *vdest = nullptr;
+	  unsigned sidx = 0;
+
+	  tree type = tmptype;
+	  for (int j = expr->rank - 1; j > r; j--)
+	    {
+	      gcc_assert (GFC_ARRAY_TYPE_P (type)); 
+	      type = TREE_TYPE (type);
+	    }
+
+	  int len = (int) mpz_get_si (expr->shape[r]);
+
+	  while (sidx != vec_safe_length (vsrc))
+	    {
+	      vec<constructor_elt, va_gc> *vtmp = nullptr;
+
+	      for (int i = 0; i < len; i++)
+		{
+		  append_constructor (vtmp, (*vsrc)[sidx].value);
+		  sidx++;
+		}
+
+	      append_constructor (vdest, build_constructor (type, vtmp));
+	    }
+
+	  vsrc = vdest;
+	}
+
+      v = vsrc;
+    }
+
   init = build_constructor (tmptype, v);
 
   TREE_CONSTANT (init) = 1;
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 66a1019207ad..f9cc1ae20066 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -166,9 +166,8 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
 #define OFFSET_FIELD 1
 #define DTYPE_FIELD 2
 #define SPAN_FIELD 3
-#define ALIGN_FIELD 4
-#define DIMENSION_FIELD 5
-#define CAF_TOKEN_FIELD 6
+#define DIMENSION_FIELD 4
+#define CAF_TOKEN_FIELD 5
 
 #define SPACING_SUBFIELD 0
 #define LBOUND_SUBFIELD 1
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index fd0ed47b4b33..6d5b6175cc03 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2195,7 +2195,8 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
   if (packed == 0)
     {
       stride = gfc_index_one_node;
-      spacing = TYPE_SIZE_UNIT (etype);
+      spacing = fold_convert_loc (input_location, gfc_array_index_type,
+				  TYPE_SIZE_UNIT (etype));
     }
   else
     {
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 33c66c666702..9ad826cf6d8c 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -423,15 +423,11 @@ gfc_build_array_ref (tree type, tree base, tree index, bool non_negative_offset,
 
   if (non_negative_offset)
     {
-      tree align = build_int_cst (gfc_array_index_type,
-				  TYPE_ALIGN_UNIT (type));
-      tree elt_unit_cnt = fold_build2_loc (input_location, EXACT_DIV_EXPR,
-					   gfc_array_index_type, spacing,
-					   align);
-      tree min_val = fold_build1_loc (input_location, NEGATE_EXPR,
-				      gfc_array_index_type, offset);
+      tree min_val = offset ? fold_build1_loc (input_location, NEGATE_EXPR,
+					       gfc_array_index_type, offset)
+			    : NULL_TREE;
       return build4_loc (input_location, ARRAY_REF, type, base, index,
-			 min_val, elt_unit_cnt);
+			 min_val, spacing);
     }
   /* Otherwise use pointer arithmetic.  */
   else
@@ -455,6 +451,8 @@ gfc_build_array_ref (tree type, tree base, tree index, bool non_negative_offset,
       tree offset_bytes = fold_build2_loc (input_location, MULT_EXPR,
 					   gfc_array_index_type,
 					   zero_based_index, spacing);
+      offset_bytes = fold_convert_loc (input_location, sizetype,
+				       offset_bytes);
 
       tree base_addr = gfc_build_addr_expr (pvoid_type_node, base);
 
@@ -486,7 +484,7 @@ gfc_build_array_ref (tree base, tree index, bool non_negative_offset,
       return base;
     }
 
-  return gfc_build_array_ref (TREE_TYPE (type), index, non_negative_offset,
+  return gfc_build_array_ref (TREE_TYPE (type), base, index, non_negative_offset,
 			      offset, spacing);
 }