https://gcc.gnu.org/g:f06001181094a5e060a5c7d6858a5114cf4d0950
commit f06001181094a5e060a5c7d6858a5114cf4d0950
Author: Mikael Morin <mik...@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 4c8136ba6a1d..00e262f7d02e 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 69021347d9fa..f559b2bd384f 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2192,7 +2192,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 152e19f536ac..c77bd72b3fb2 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);
}
