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

[Mikael Morin via Gcc-cvs]

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

commit b30f21c046beb653e7f6acbf6565ae7546b46327
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Aug 7 14:05:44 2025 +0200

    Extraction gfc_conv_null_array_to_descriptor

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

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index afbe09555002..1693b21dbafa 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -787,3 +787,55 @@ gfc_set_descriptor_null (stmtblock_t *block, tree descr, 
tree etype, int rank)
   gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
 }
 
+
+tree
+gfc_conv_null_array_to_descriptor (stmtblock_t *block, gfc_symbol *fsym)
+{
+  symbol_attribute attr = gfc_symbol_attr (fsym);
+
+  tree lbound[GFC_MAX_DIMENSIONS], ubound[GFC_MAX_DIMENSIONS];
+  memset (&lbound, 0, sizeof (lbound));
+  memset (&ubound, 0, sizeof (ubound));
+
+  enum gfc_array_kind akind;
+
+  if (attr.pointer)
+    akind = GFC_ARRAY_POINTER_CONT;
+  else if (attr.allocatable)
+    akind = GFC_ARRAY_ALLOCATABLE;
+  else
+    akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+  tree etype = gfc_typenode_for_spec (&fsym->ts);
+  tree desc_type = gfc_get_array_type_bounds (etype, 1, 0, lbound, ubound, 1,
+                                   akind, !(attr.pointer || attr.target));
+
+  tree desc = gfc_create_var (desc_type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  int rank = fsym->as ? fsym->as->rank : 0;
+  gfc_conv_descriptor_dtype_set (block, desc,
+                                gfc_get_dtype_rank_type (rank, etype));
+  gfc_conv_descriptor_data_set (block, desc, null_pointer_node);
+  gfc_conv_descriptor_span_set (block, desc,
+                               gfc_conv_descriptor_elem_len_get (desc));
+
+  return desc;
+}
+
+
+tree
+gfc_conv_null_scalar_to_descriptor (stmtblock_t *block, gfc_symbol *fsym)
+{
+  tree etype = gfc_typenode_for_spec (&fsym->ts);
+  tree type = gfc_get_scalar_to_descriptor_type (etype, fsym->attr);
+  tree desc = gfc_create_var (type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  gfc_conv_descriptor_dtype_set (block, desc,
+                                gfc_get_dtype_rank_type (0, etype));
+  gfc_conv_descriptor_data_set (block, desc, null_pointer_node);
+  gfc_conv_descriptor_span_set (block, desc,
+                               gfc_conv_descriptor_elem_len_get (desc));
+  return desc;
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 893eaee126f9..82e43f106e52 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -100,5 +100,7 @@ void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, 
tree, tree);
 /* Build a null array descriptor constructor.  */
 void gfc_nullify_descriptor (stmtblock_t *block, tree);
 void gfc_set_descriptor_null (stmtblock_t *, tree, tree, int);
+tree gfc_conv_null_array_to_descriptor (stmtblock_t *, gfc_symbol *);
+tree gfc_conv_null_scalar_to_descriptor (stmtblock_t *, gfc_symbol *);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 50f13665777a..d301525415ca 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6718,11 +6718,11 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, 
gfc_symbol * fsym)
          if ((fsym->attr.allocatable || fsym->attr.pointer)
              && fsym->attr.intent == INTENT_UNKNOWN)
            fsym->attr.intent = INTENT_IN;
-         tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
          dummy_rank = fsym->as ? fsym->as->rank : 0;
-         if (dummy_rank > 0)
-           gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank);
-         gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+         if (dummy_rank == 0)
+           tmp = gfc_conv_null_scalar_to_descriptor (&parmse->pre, fsym);
+         else
+           tmp = gfc_conv_null_array_to_descriptor (&parmse->pre, fsym);
          parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
        }
     }