[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression allocate_with_source_15.f03

[Mikael Morin via Gcc-cvs]

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

commit a4bd082c5ed576bf21547f822a5a653c19c2aa38
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Tue Feb 4 12:19:20 2025 +0100

    Correction régression allocate_with_source_15.f03

Diff:
---
 gcc/fortran/trans-array.cc | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 60ce464ee032..1d3bb40a8383 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -681,7 +681,7 @@ public:
   virtual bool set_span () const { return false; }
   virtual tree get_data_value () const { return NULL_TREE; }
   virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
-  virtual tree get_length (gfc_typespec &ts) const { return get_size_info 
(ts); }
+  virtual tree get_length (gfc_typespec *ts) const { return get_size_info 
(*ts); }
 };
 
 class nullification : public modify_info
@@ -742,27 +742,29 @@ public:
   virtual gfc_typespec *get_type () const { return &ts; }
 };
 
-class scalar_value : public init_info
+
+class scalar_value : public modify_info
 {
 private:
+  bool initialisation;
   gfc_typespec *ts;
   tree value;
   bool use_tree_type_;
   tree get_elt_type () const;
 
-
 public:
   scalar_value(gfc_typespec &arg_ts, tree arg_value)
-    : ts(&arg_ts), value(arg_value), use_tree_type_ (false) { }
+    : initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_ 
(false) { }
   scalar_value(tree arg_value)
-    : ts(nullptr), value(arg_value), use_tree_type_ (true) { }
+    : initialisation(true), ts(nullptr), value(arg_value), use_tree_type_ 
(true) { }
+  virtual bool is_initialization () const { return initialisation; }
   virtual bool initialize_data () const { return true; }
   virtual tree get_data_value () const { return value; }
   virtual gfc_typespec *get_type () const { return ts; }
   virtual bool set_span () const { return true; }
   virtual bool use_tree_type () const { return use_tree_type_; }
   virtual bt get_type_type (const gfc_typespec &) const;
-  virtual tree get_length (gfc_typespec &ts) const;
+  virtual tree get_length (gfc_typespec *ts) const;
 };
 
 
@@ -799,7 +801,7 @@ scalar_value::get_type_type (const gfc_typespec & 
type_info) const
 }
 
 tree
-scalar_value::get_length (gfc_typespec & type_info) const
+scalar_value::get_length (gfc_typespec * type_info) const
 {
   bt n;
   tree size;
@@ -809,14 +811,14 @@ scalar_value::get_length (gfc_typespec & type_info) const
       gfc_get_type_info (etype, &n, &size);
     }
   else
-    size = init_info::get_length (type_info);
+    size = modify_info::get_length (type_info);
 
   return size;
 }
 
 
 static tree
-build_dtype (gfc_typespec &ts, int rank, const symbol_attribute &,
+build_dtype (gfc_typespec *ts, int rank, const symbol_attribute &,
             const init_info &init)
 {
   vec<constructor_elt, va_gc> *v = nullptr;
@@ -827,16 +829,17 @@ build_dtype (gfc_typespec &ts, int rank, const 
symbol_attribute &,
 
   gfc_typespec *type_info = init.get_type ();
   if (type_info == nullptr)
-    type_info = &ts;
+    type_info = ts;
 
   if (!(init.is_initialization ()
+       && type_info
        && (type_info->type == BT_CLASS
            || (type_info->type == BT_CHARACTER
                && type_info->deferred))))
     {
       tree elem_len_field = gfc_advance_chain (fields, GFC_DTYPE_ELEM_LEN);
       tree elem_len_val = fold_convert (TREE_TYPE (elem_len_field),
-                                       init.get_length (*type_info));
+                                       init.get_length (type_info));
       CONSTRUCTOR_APPEND_ELT (v, elem_len_field, elem_len_val);
     }
 
@@ -877,13 +880,14 @@ get_descriptor_init (tree type, gfc_typespec *ts, int 
rank,
     {
       tree data_field = gfc_advance_chain (fields, DATA_FIELD);
       tree data_value = init.get_data_value ();
+      data_value = fold_convert (TREE_TYPE (data_field), data_value);
       CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
     }
 
   if (init.is_initialization ())
     {
       tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
-      tree dtype_value = build_dtype (*ts, rank, *attr,
+      tree dtype_value = build_dtype (ts, rank, *attr,
                                      static_cast<const init_info &> (init));
       CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
     }
@@ -891,7 +895,8 @@ get_descriptor_init (tree type, gfc_typespec *ts, int rank,
   if (init.set_span ())
     {
       tree span_field = gfc_advance_chain (fields, SPAN_FIELD);
-      CONSTRUCTOR_APPEND_ELT (v, span_field, integer_zero_node);
+      tree span_value = build_int_cst (TREE_TYPE (span_field), 0);
+      CONSTRUCTOR_APPEND_ELT (v, span_field, span_value);
     }
 
   if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension)