[gcc(refs/users/mikael/heads/refactor_descriptor_v07)] Utilisation gfc_clear_descriptor pour initialiser les résultats de type class

[Mikael Morin via Gcc-cvs]

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

commit b7606609c895ee2428a862bfa17e91a42146d0d7
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Tue Jul 15 19:13:46 2025 +0200

    Utilisation gfc_clear_descriptor pour initialiser les résultats de type 
class
    
    Prise en charge type polymorphe
    
    Correction gfc_clear_descriptor
    
    Utilisation gfc_symbol_attr

Diff:
---
 gcc/fortran/trans-decl.cc       |  4 +---
 gcc/fortran/trans-descriptor.cc | 19 +++++++++++++------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 2996dd72e6aa..f0c1f0947558 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4773,14 +4773,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
   else if (proc_sym == proc_sym->result && IS_CLASS_ARRAY (proc_sym))
     {
       /* Nullify explicit return class arrays on entry.  */
-      tree type;
       tmp = get_proc_result (proc_sym);
       if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
        {
          gfc_start_block (&init);
          tmp = gfc_class_data_get (tmp);
-         type = TREE_TYPE (gfc_conv_descriptor_data_get (tmp));
-         gfc_conv_descriptor_data_set (&init, tmp, build_int_cst (type, 0));
+         gfc_clear_descriptor (&init, proc_sym, tmp);
          gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
        }
     }
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 3edc7a34809e..2dbdc9dcd146 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -673,22 +673,29 @@ 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)
 {
+  symbol_attribute attr = gfc_symbol_attr (sym);
+
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
      pointers when -fcheck=pointer is specified.  */
-  if (sym->attr.allocatable
-      || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+  if (attr.allocatable
+      || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
     {
       gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
-      if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+      if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
        gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
     }
 
   tree etype;
 
-  gcc_assert (sym->as && sym->as->rank>=0);
+  gfc_array_spec *as;
+  if (sym->ts.type == BT_CLASS)
+    as = CLASS_DATA (sym)->as;
+  else
+    as = sym->as;
+
+  gcc_assert (as && as->rank >= 0);
   etype = gfc_get_element_type (TREE_TYPE (descr));
   gfc_conv_descriptor_dtype_set (block, descr,
-                                gfc_get_dtype_rank_type (sym->as->rank,
-                                                         etype));
+                                gfc_get_dtype_rank_type (as->rank, etype));
 }