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

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:08db3a3e53235c47e899fd858368a6b9333a8390

commit 08db3a3e53235c47e899fd858368a6b9333a8390
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Jul 31 20:35:45 2025 +0200

    Extraction gfc_set_null_descriptor
    
    Correction régression null_actual_7

Diff:
---
 gcc/fortran/trans-descriptor.cc | 10 ++++++++++
 gcc/fortran/trans-descriptor.h  |  4 +---
 gcc/fortran/trans-expr.cc       | 27 ++++++++++++++++++++++-----
 3 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e2eac3870f52..425e91798ec8 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1888,7 +1888,17 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree 
descr, tree scalar)
   gfc_conv_descriptor_data_set (block, descr, scalar);
   gfc_conv_descriptor_span_set (block, descr,
                                gfc_conv_descriptor_elem_len_get (descr));
+}
+
 
+void
+gfc_set_descriptor_null (stmtblock_t *block, tree descr, tree etype, int rank)
+{
+  gfc_conv_descriptor_dtype_set (block, descr,
+                                gfc_get_dtype_rank_type (rank, etype));
+  gfc_conv_descriptor_span_set (block, descr,
+                               gfc_conv_descriptor_elem_len_get (descr));
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
 }
 
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 4c72f89cb27e..38ad52ad5f9d 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -70,9 +70,6 @@ void gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree 
desc, tree value);
 void gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree 
value);
 void gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, tree value);
 void gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int value);
-void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, tree 
dim, tree value);
-void gfc_conv_descriptor_dimension_set (stmtblock_t *block, tree desc, int 
dim, tree value);
-void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim, 
tree value);
 void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
 
 tree gfc_build_null_descriptor (tree type);
@@ -124,6 +121,7 @@ void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, 
tree);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
                                     tree, tree);
+void gfc_set_descriptor_null (stmtblock_t *, tree, tree, int);
 void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int, gfc_ss *);
 void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
                                   tree [GFC_MAX_DIMENSIONS],
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 89ea5e8f0ed7..352fdb30083a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -170,6 +170,26 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, 
symbol_attribute attr)
 }
 
 
+tree
+gfc_conv_null_to_descriptor (gfc_se *se, tree etype, int rank)
+{
+  tree lbound[GFC_MAX_DIMENSIONS];
+  tree ubound[GFC_MAX_DIMENSIONS];
+
+  memset (lbound, 0, sizeof (lbound));
+  memset (ubound, 0, sizeof (ubound));
+
+  tree type = gfc_get_array_type_bounds (etype, rank, 0, lbound, ubound, 1,
+                                        GFC_ARRAY_POINTER_CONT, false);
+  tree desc = gfc_create_var (type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  gfc_set_descriptor_null (&se->pre, desc, etype, rank);
+
+  return desc;
+}
+
+
 /* Get the coarray token from the ultimate array or component ref.
    Returns a NULL_TREE, when the ref object is not allocatable or pointer.  */
 
@@ -6519,11 +6539,8 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, 
gfc_symbol * fsym)
           For an assumed-rank dummy we provide a descriptor that passes
           the correct rank.  */
        {
-         tree tmp = parmse->expr;
-
-         tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e));
-         gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
-         gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+         tree etype = gfc_typenode_for_spec (&e->ts);
+         tree tmp = gfc_conv_null_to_descriptor (parmse, etype, e->rank);
          parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
        }
       else