[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Extraction fonction get_descr_dtype

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:9a3d1eb1a98bc8e765ee61a76f9538adee90d5b5

commit 9a3d1eb1a98bc8e765ee61a76f9538adee90d5b5
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Sat Mar 15 20:32:32 2025 +0100

    Extraction fonction get_descr_dtype

Diff:
---
 gcc/fortran/trans-descriptor.cc | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 405a1525411a..00d1ec9814bd 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1079,7 +1079,6 @@ public:
     : ts(&arg_ts), value(arg_value),  use_tree_type_ (false) { }
   scalar_value(tree arg_value)
     : ts(nullptr), value(arg_value), use_tree_type_ (true) { }
-  virtual bool is_initialization () const { return true; }
   virtual gfc_typespec *get_type () const { return ts; }
   virtual bool use_tree_type () const { return use_tree_type_; }
   virtual bt get_type_type (const gfc_typespec &) const;
@@ -1321,6 +1320,26 @@ build_dtype (gfc_typespec *ts, int rank, const 
symbol_attribute &,
 }
 
 
+static tree
+get_descr_dtype (const descr_change_info &change_info, gfc_typespec *ts,
+                int rank, const symbol_attribute &attr)
+{
+  if (change_info.type == UNKNOWN_CHANGE
+      || change_info.type == EXPLICIT_NULLIFICATION)
+    return NULL_TREE;
+
+  const init_info *init_info = nullptr;
+  if (change_info.type == INITIALISATION)
+    init_info = change_info.u.initialization_info;
+  else if (change_info.type == SCALAR_VALUE)
+    init_info = change_info.u.scalar_value.info;
+  else
+    gcc_unreachable ();
+
+  return build_dtype (ts, rank, attr, *init_info);
+}
+
+
 /* Build a null array descriptor constructor.  */
 
 vec<constructor_elt, va_gc> *
@@ -1330,8 +1349,6 @@ get_descriptor_init (tree type, gfc_typespec *ts, int 
rank,
 {
   vec<constructor_elt, va_gc> *v = nullptr;
 
-  const modify_info &init = *get_internal_info (change);
-
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
   gcc_assert (DATA_FIELD == 0);
   tree fields = TYPE_FIELDS (type);
@@ -1345,11 +1362,10 @@ get_descriptor_init (tree type, gfc_typespec *ts, int 
rank,
       CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
     }
 
-  if (init.is_initialization ())
+  tree dtype_value = get_descr_dtype (change, ts, rank, *attr);
+  if (dtype_value != NULL_TREE)
     {
       tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
-      tree dtype_value = build_dtype (ts, rank, *attr,
-                                     static_cast<const init_info &> (init));
       CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
     }