https://gcc.gnu.org/g:871741486743f74a32d44f6f518c42eb3b150c03
commit 871741486743f74a32d44f6f518c42eb3b150c03
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri May 23 20:13:51 2025 +0200
Contournement régression zero_sized_15
Diff:
---
gcc/fortran/trans-array.cc | 33 ++++++++++++++++++++++++++-------
gcc/fortran/trans-types.cc | 28 +++++++++++++++++++++++++---
2 files changed, 51 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b28d65445bc6..43e5e1e756bc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2435,6 +2435,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
/* Complex character array constructors should have been taken care of
and not end up here. */
gcc_assert (ss_info->string_length);
+ ss_info->string_length = gfc_evaluate_now (ss_info->string_length,
+ &outer_loop->pre);
store_backend_decl (&expr->ts.u.cl, ss_info->string_length,
force_new_cl);
@@ -5518,10 +5520,15 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
- tmp_ss_info->data.temp.type
- = gfc_get_character_type_len_for_eltype
- (TREE_TYPE (tmp_ss_info->data.temp.type),
- tmp_ss_info->string_length);
+ {
+ tree len = tmp_ss_info->string_length;
+ len = gfc_evaluate_now (len, &outermost_loop (loop)->pre);
+ tmp_ss_info->string_length = len;
+ tmp_ss_info->data.temp.type
+ = gfc_get_character_type_len_for_eltype
+ (TREE_TYPE (tmp_ss_info->data.temp.type),
+ tmp_ss_info->string_length);
+ }
tmp = tmp_ss_info->data.temp.type;
memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
@@ -8084,9 +8091,21 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
{
- get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
- expr->ts.u.cl->backend_decl = tmp;
- se->string_length = tmp;
+ if (expr->ts.u.cl->length_from_typespec)
+ {
+ gfc_se len_se;
+ gfc_init_se (&len_se, NULL);
+ gfc_conv_expr_val (&len_se, expr->ts.u.cl->length);
+ gfc_add_block_to_block (&se->pre, &len_se.pre);
+ expr->ts.u.cl->backend_decl = len_se.expr;
+ se->string_length = len_se.expr;
+ }
+ else
+ {
+ get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
+ expr->ts.u.cl->backend_decl = tmp;
+ se->string_length = tmp;
+ }
}
/* Is this the result of the enclosing procedure? */
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 9568d8f821ab..c7433f11bed7 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2303,12 +2303,34 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
/* We define data as an array with the correct size if possible.
Much better than doing pointer arithmetic. */
+ bool known_zero_size = false;
if (stride)
- rtype = build_range_type (gfc_array_index_type, gfc_index_zero_node,
- int_const_binop (MINUS_EXPR, stride,
- build_int_cst (TREE_TYPE
(stride), 1)));
+ {
+ tree range_bound = int_const_binop (MINUS_EXPR, stride,
+ build_int_cst (TREE_TYPE (stride),
+ 1));
+ rtype = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+ range_bound);
+ if (integer_minus_onep (range_bound))
+ known_zero_size = true;
+ }
else
rtype = gfc_array_range_type;
+ if (known_zero_size
+ && TREE_CODE (etype) == ARRAY_TYPE
+ && TYPE_DOMAIN (etype)
+ && TYPE_MAX_VALUE (TYPE_DOMAIN (etype))
+ && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (etype))) != INTEGER_CST)
+ {
+ tree elt = TREE_TYPE (etype);
+ tree domain = TYPE_DOMAIN (etype);
+ tree min = TYPE_MIN_VALUE (domain);
+ domain = build_range_type (TREE_TYPE (domain), min, min);
+ tree new_etype = build_array_type (elt, domain);
+ TYPE_STRING_FLAG (new_etype) = TYPE_STRING_FLAG (etype);
+ layout_type (new_etype);
+ etype = new_etype;
+ }
arraytype = build_array_type (etype, rtype);
arraytype = build_pointer_type (arraytype);
if (restricted)
