[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction allocate_with_source_16.f90

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:488b4bb00455438400780bad3a8c7c86a6597db0

commit 488b4bb00455438400780bad3a8c7c86a6597db0
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Tue Feb 4 16:18:27 2025 +0100

    Correction allocate_with_source_16.f90

Diff:
---
 gcc/fortran/trans-array.cc |  6 ++++--
 gcc/fortran/trans-expr.cc  | 42 +++++++++++++++++++++++-------------------
 gcc/fortran/trans.h        |  1 +
 3 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cfc9ab95d863..8b34ca189f1e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -810,8 +810,10 @@ scalar_value::get_length (gfc_typespec * type_info) const
       if (TREE_CODE (value) == COMPONENT_REF)
        {
          tree parent_obj = TREE_OPERAND (value, 0);
-         if (GFC_CLASS_TYPE_P (TREE_TYPE (parent_obj)))
-           return gfc_class_len_get (parent_obj);
+         tree len;
+         if (GFC_CLASS_TYPE_P (TREE_TYPE (parent_obj))
+             && gfc_class_len_get (parent_obj, &len))
+           return len;
        }
 
       tree etype = get_elt_type ();
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f514edd32bae..39bd7178c3c0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -310,8 +310,8 @@ gfc_class_vptr_get (tree decl)
 }
 
 
-tree
-gfc_class_len_get (tree decl)
+bool
+gfc_class_len_get (tree decl, tree * result)
 {
   tree len;
   /* For class arrays decl may be a temporary descriptor handle, the len is
@@ -323,9 +323,22 @@ gfc_class_len_get (tree decl)
     decl = build_fold_indirect_ref_loc (input_location, decl);
   len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl)),
                           CLASS_LEN_FIELD);
-  return fold_build3_loc (input_location, COMPONENT_REF,
-                         TREE_TYPE (len), decl, len,
-                         NULL_TREE);
+  if (len == NULL_TREE)
+    return false;
+
+  *result = fold_build3_loc (input_location, COMPONENT_REF,
+                            TREE_TYPE (len), decl, len,
+                            NULL_TREE);
+  return true;
+}
+
+
+tree
+gfc_class_len_get (tree decl)
+{
+  tree result;
+  gfc_class_len_get (decl, &result);
+  return result;
 }
 
 
@@ -335,20 +348,11 @@ gfc_class_len_get (tree decl)
 static tree
 gfc_class_len_or_zero_get (tree decl)
 {
-  tree len;
-  /* For class arrays decl may be a temporary descriptor handle, the vptr is
-     then available through the saved descriptor.  */
-  if (VAR_P (decl) && DECL_LANG_SPECIFIC (decl)
-      && GFC_DECL_SAVED_DESCRIPTOR (decl))
-    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
-  if (POINTER_TYPE_P (TREE_TYPE (decl)))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
-  len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl)),
-                          CLASS_LEN_FIELD);
-  return len != NULL_TREE ? fold_build3_loc (input_location, COMPONENT_REF,
-                                            TREE_TYPE (len), decl, len,
-                                            NULL_TREE)
-    : build_zero_cst (gfc_charlen_type_node);
+  tree result;
+  if (gfc_class_len_get (decl, &result))
+    return result;
+  else
+    return build_zero_cst (gfc_charlen_type_node);
 }
 
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e9a9c24db0cd..e2bfd0013a6e 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -430,6 +430,7 @@ gfc_wrapped_block;
 tree gfc_class_set_static_fields (tree, tree, tree);
 tree gfc_class_data_get (tree);
 tree gfc_class_vptr_get (tree);
+bool gfc_class_len_get (tree, tree *);
 tree gfc_class_len_get (tree);
 tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree);
 gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = 
false,