[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_descriptor_set_dtype_if_unallocated

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:79ae59aa79beeffce378698091801eb0c0d1d99b

commit 79ae59aa79beeffce378698091801eb0c0d1d99b
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Sun Aug 10 11:03:57 2025 +0200

    Extraction gfc_descriptor_set_dtype_if_unallocated

Diff:
---
 gcc/fortran/trans-descriptor.cc | 19 +++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 20 ++------------------
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index afcea304fdbc..db69d88f4b8d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2877,3 +2877,22 @@ gfc_set_empty_descriptor_bounds (stmtblock_t *block, 
tree descr, int rank)
   gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
 }
 
+
+void
+gfc_descriptor_set_dtype_if_unallocated (stmtblock_t *block, tree desc,
+                                        int rank)
+{
+  stmtblock_t body;
+  gfc_init_block (&body);
+  tree tmp = gfc_conv_descriptor_data_get (desc);
+  tree cond = fold_build2_loc (input_location, EQ_EXPR,
+                              logical_type_node, tmp,
+                              build_int_cst (TREE_TYPE (tmp), 0));
+  tree type = gfc_get_element_type (TREE_TYPE (desc));
+  gfc_conv_descriptor_dtype_set (&body, desc, 
+                                gfc_get_dtype_rank_type (rank, type));
+  cond = build3_v (COND_EXPR, cond,
+                  gfc_finish_block (&body),
+                  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, cond);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index ae55628470dc..b4f833086420 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -95,6 +95,7 @@ tree gfc_create_null_actual_descriptor (stmtblock_t *, 
gfc_typespec *,
                                        symbol_attribute, int);
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
+void gfc_descriptor_set_dtype_if_unallocated (stmtblock_t *, tree, int);
 
 void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f99fddad1ba5..8d8b81238ed5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5846,18 +5846,13 @@ expr_may_alias_variables (gfc_expr *e, bool 
array_may_alias)
 static void
 set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
 {
-  tree tmp;
-  tree desc;
-  tree cond;
-  tree type;
-  stmtblock_t block;
 
   /* TODO Figure out how to handle optional dummies.  */
   if (e && e->expr_type == EXPR_VARIABLE
       && e->symtree->n.sym->attr.optional)
     return;
 
-  desc = parmse->expr;
+  tree desc = parmse->expr;
   if (desc == NULL_TREE)
     return;
 
@@ -5868,18 +5863,7 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
     return;
 
-  gfc_init_block (&block);
-  tmp = gfc_conv_descriptor_data_get (desc);
-  cond = fold_build2_loc (input_location, EQ_EXPR,
-                         logical_type_node, tmp,
-                         build_int_cst (TREE_TYPE (tmp), 0));
-  type = gfc_get_element_type (TREE_TYPE (desc));
-  gfc_conv_descriptor_dtype_set (&block, desc, 
-                                gfc_get_dtype_rank_type (e->rank, type));
-  cond = build3_v (COND_EXPR, cond,
-                  gfc_finish_block (&block),
-                  build_empty_stmt (input_location));
-  gfc_add_expr_to_block (&parmse->pre, cond);
+  gfc_descriptor_set_dtype_if_unallocated (&parmse->pre, desc, e->rank);
 }