https://gcc.gnu.org/g:5bfa61a560b7a26a5462acc831e250c0f262be6e

commit 5bfa61a560b7a26a5462acc831e250c0f262be6e
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Aug 7 11:42:13 2025 +0200

    Refactoring gfc_nullify_descriptor/gfc_init_descriptor_variable

Diff:
---
 gcc/fortran/trans-descriptor.cc | 35 ++++++++++++++++++++++++-----------
 gcc/fortran/trans-expr.cc       | 11 +++++++++--
 gcc/fortran/trans-types.h       |  1 +
 gcc/fortran/trans.h             |  1 +
 4 files changed, 35 insertions(+), 13 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index d2b908c875b2..2ed8a6453949 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -597,12 +597,11 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree 
desc,
    unknown cases abort.  */
 
 tree
-gfc_get_dtype_rank_type (int rank, tree etype)
+gfc_get_dtype_rank_type_slen (int rank, tree etype, tree length)
 {
   tree ptype;
   tree size;
   int n;
-  tree tmp;
   tree dtype;
   tree field;
   vec<constructor_elt, va_gc> *v = NULL;
@@ -666,7 +665,7 @@ gfc_get_dtype_rank_type (int rank, tree etype)
     {
     case BT_CHARACTER:
       gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE);
-      size = gfc_get_character_len_in_bytes (ptype);
+      size = gfc_get_character_len_in_bytes (ptype, length);
       break;
     case BT_VOID:
       gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
@@ -677,14 +676,12 @@ gfc_get_dtype_rank_type (int rank, tree etype)
       break;
     }
 
-  tree dtype_type_node = get_dtype_type_node ();
-
   gcc_assert (size);
 
   STRIP_NOPS (size);
   size = fold_convert (size_type_node, size);
-  tmp = get_dtype_type_node ();
-  field = gfc_advance_chain (TYPE_FIELDS (tmp),
+  tree dtype_type_node = get_dtype_type_node ();
+  field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
                             GFC_DTYPE_ELEM_LEN);
   CONSTRUCTOR_APPEND_ELT (v, field,
                          fold_convert (TREE_TYPE (field), size));
@@ -704,11 +701,19 @@ gfc_get_dtype_rank_type (int rank, tree etype)
   CONSTRUCTOR_APPEND_ELT (v, field,
                          build_int_cst (TREE_TYPE (field), n));
 
-  dtype = build_constructor (tmp, v);
+  dtype = build_constructor (dtype_type_node, v);
 
   return dtype;
 }
 
+
+tree
+gfc_get_dtype_rank_type (int rank, tree etype)
+{
+  return gfc_get_dtype_rank_type_slen (rank, etype, NULL_TREE);
+}
+
+
 /* Build a null array descriptor constructor.  */
 
 tree
@@ -843,7 +848,8 @@ gfc_init_static_descriptor (tree descr)
 
 
 void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr 
*expr, tree descr)
+gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *sym, gfc_expr *expr,
+                       tree descr, tree string_length)
 {
   symbol_attribute attr = gfc_symbol_attr (sym);
 
@@ -875,8 +881,15 @@ gfc_init_descriptor_variable (stmtblock_t *block, 
gfc_symbol *sym, gfc_expr *exp
     rank = -1;
 
   tree etype = gfc_get_element_type (TREE_TYPE (descr));
-  gfc_conv_descriptor_dtype_set (block, descr,
-                                gfc_get_dtype_rank_type (rank, etype));
+  tree dtype = gfc_get_dtype_rank_type_slen (rank, etype, string_length);
+  gfc_conv_descriptor_dtype_set (block, descr, dtype);
+}
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
+                             gfc_expr *expr, tree descr)
+{
+  return gfc_nullify_descriptor (block, sym, expr, descr, NULL_TREE);
 }
 
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0ec661de4e31..b5143e535dfd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -66,7 +66,7 @@ gfc_get_character_len (tree type)
 /* Calculate the number of bytes in a string.  */
 
 tree
-gfc_get_character_len_in_bytes (tree type)
+gfc_get_character_len_in_bytes (tree type, tree slen)
 {
   tree tmp, len;
 
@@ -76,7 +76,7 @@ gfc_get_character_len_in_bytes (tree type)
   tmp = TYPE_SIZE_UNIT (TREE_TYPE (type));
   tmp = (tmp && !integer_zerop (tmp))
     ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE);
-  len = gfc_get_character_len (type);
+  len = slen ? slen : gfc_get_character_len (type);
   if (tmp && len && !integer_zerop (len))
     len = fold_build2_loc (input_location, MULT_EXPR,
                           gfc_charlen_type_node, len, tmp);
@@ -84,6 +84,13 @@ gfc_get_character_len_in_bytes (tree type)
 }
 
 
+tree
+gfc_get_character_len_in_bytes (tree type)
+{
+  return gfc_get_character_len_in_bytes (type, NULL_TREE);
+}
+
+
 /* Convert a scalar to an array descriptor. To be used for assumed-rank
    arrays.  */
 
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index aba841da9cb5..dc75cd82a841 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -116,6 +116,7 @@ bool gfc_return_by_reference (gfc_symbol *);
 bool gfc_is_nodesc_array (gfc_symbol *);
 
 /* Return the DTYPE for an array.  */
+tree gfc_get_dtype_rank_type_slen (int, tree, tree);
 tree gfc_get_dtype_rank_type (int, tree);
 tree gfc_get_dtype (tree, int *rank = NULL);
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 740c05015d66..2d4218439ad4 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -518,6 +518,7 @@ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 
 /* trans-expr.cc */
 tree gfc_get_character_len_in_bytes (tree);
+tree gfc_get_character_len_in_bytes (tree, tree);
 tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
 tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
 tree gfc_string_to_single_character (tree len, tree str, int kind);

Reply via email to