[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor

[Mikael Morin via Gcc-cvs]

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

commit bf296b890860d9ace062f68c7dd02e6391df79fc
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Jul 17 21:58:19 2025 +0200

    Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor
    
    Revert "Correction compilation"
    
    This reverts commit 5131afedc5568d33c68046a098a0143f9ae03eb9.
    
    Revert partiel

Diff:
---
 gcc/fortran/trans-descriptor.cc | 17 +++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 56 +++++++++++++++++++++++++++++++++++++++--
 3 files changed, 72 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index bda567cf91f2..1e0189ed7eaf 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -753,3 +753,20 @@ gfc_build_default_class_descriptor (const gfc_typespec 
&ts, tree class_type)
   return gfc_class_set_static_fields (class_type, vptr, tmp);
 }
 
+
+void
+gfc_set_scalar_descriptor (stmtblock_t *block, tree descr, tree value)
+{
+  tree etype = TREE_TYPE (value);
+
+  if (POINTER_TYPE_P (etype)
+      && TREE_TYPE (etype)
+      && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+    etype = TREE_TYPE (etype);
+  gfc_conv_descriptor_dtype_set (block, descr,
+                                gfc_get_dtype_rank_type (0, etype));
+  gfc_conv_descriptor_data_set (block, descr, value);
+  gfc_conv_descriptor_span_set (block, descr,
+                               gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 8c763ee654d0..7cde514bb297 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -96,5 +96,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, tree descr);
 void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
 void gfc_clear_descriptor (tree descr);
+void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a42c5aae52..40cb01b3c8e4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -105,6 +105,56 @@ get_scalar_to_descriptor_type (tree scalar, 
symbol_attribute attr)
                                    akind, !(attr.pointer || attr.target));
 }
 
+tree
+gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol *sym, tree scalar)
+{
+  symbol_attribute attr = sym->attr;
+
+  tree type = get_scalar_to_descriptor_type (scalar, attr);
+  tree desc = gfc_create_var (type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  if (CONSTANT_CLASS_P (scalar))
+    {
+      tree tmp;
+      tmp = gfc_create_var (TREE_TYPE (scalar), "scalar");
+      gfc_add_modify (&se->pre, tmp, scalar);
+      scalar = tmp;
+    }
+  if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
+    scalar = gfc_build_addr_expr (NULL_TREE, scalar);
+
+  gfc_set_scalar_descriptor (&se->pre, desc, scalar);
+
+  return desc;
+}
+
+
+tree
+gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol *sym, gfc_expr *expr)
+{
+  tree lower[GFC_MAX_DIMENSIONS], upper[GFC_MAX_DIMENSIONS];
+
+  for (int i = 0; i < expr->rank; i++)
+    {
+      lower[i] = NULL_TREE;
+      upper[i] = NULL_TREE;
+    }
+
+  tree elt_type = gfc_typenode_for_spec (&sym->ts);
+  tree desc_type = gfc_get_array_type_bounds (elt_type, expr->rank, 0,
+                                             lower, upper, 0,
+                                             GFC_ARRAY_UNKNOWN, false);
+
+  tree desc = gfc_create_var (desc_type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  gfc_clear_descriptor (&se->pre, sym, desc);
+
+  return desc;
+}
+
+
 tree
 gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 {
@@ -6637,8 +6687,10 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, 
gfc_symbol * fsym)
          if (fsym->as && fsym->as->type == AS_ASSUMED_RANK)
            {
              tree tmp = parmse->expr;
-             tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
-             gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
+             if (e->rank == 0)
+               tmp = gfc_conv_scalar_null_to_descriptor (parmse, fsym, tmp);
+             else
+               tmp = gfc_conv_null_array_descriptor (parmse, fsym, e);
              parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
            }
          else