[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:2baf7b97b7546cb90f52b8b7151cdfa6668712fb

commit 2baf7b97b7546cb90f52b8b7151cdfa6668712fb
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 | 20 ++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 20 ++------------------
 3 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index ce039581346d..3d7d3924109c 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -805,3 +805,23 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, 
gfc_typespec *ts,
 
   return desc;
 }
+
+
+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 bd205c13b99c..85a3a5838776 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -101,5 +101,6 @@ 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);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 579c226e5fb4..285aeeffc7a8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5965,18 +5965,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;
 
@@ -5987,18 +5982,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);
 }