[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Contournement régression zero_sized_15

[Mikael Morin]

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

commit c0542d1d63b7008938d4e416a670ec9efd51f64e
Author: Mikael Morin <mikael@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 08a3ee37e6e9..50175dea2c7e 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2306,12 +2306,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)