https://gcc.gnu.org/g:4bfd0a376ddc50aaf04af11401c4e89a3baebb6e

commit 4bfd0a376ddc50aaf04af11401c4e89a3baebb6e
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Tue Dec 10 13:48:42 2024 +0100

    Initialisation descripteur champ par champ

Diff:
---
 gcc/fortran/trans-array.cc | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 38cea95840b6..091d47798b1e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -750,6 +750,23 @@ gfc_clear_descriptor (gfc_expr *var_ref, gfc_se &var)
 }
 
 
+void
+set_from_constructor_elts (stmtblock_t *block, tree data_ref,
+                          vec<constructor_elt, va_gc> *constructor_values)
+{
+  unsigned i;
+  constructor_elt *ce;
+  FOR_EACH_VEC_ELT (*constructor_values, i, ce)
+    {
+      tree field_decl = ce->index;
+      tree ref = fold_build3_loc (input_location, COMPONENT_REF,
+                                 TREE_TYPE (field_decl), data_ref,
+                                 field_decl, NULL_TREE);
+      gfc_add_modify (block, ref, ce->value);
+    }
+}
+
+
 void
 gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, tree descriptor)
 {
@@ -762,9 +779,14 @@ gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, 
tree descriptor)
 
   attr = gfc_symbol_attr (sym);
 
-  gfc_add_modify (block, descriptor,
-                 gfc_build_null_descriptor (TREE_TYPE (descriptor), sym->ts,
-                                            rank, attr));
+  if (TREE_STATIC (descriptor))
+    gfc_add_modify (block, descriptor,
+                   gfc_build_null_descriptor (TREE_TYPE (descriptor), sym->ts,
+                                              rank, attr));
+  else
+    set_from_constructor_elts (block, descriptor,
+                              get_null_descriptor_init (TREE_TYPE (descriptor),
+                                                        sym->ts, rank, attr));
 }
 
 
@@ -12237,8 +12259,6 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
   if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save
       && (sym->attr.allocatable || sym->attr.pointer))
     {
-      gfc_clear_descriptor (&init, sym, descriptor);
-
       /* Declare the variable static so its array descriptor stays present
         after leaving the scope.  It may still be accessed through another
         image.  This may happen, for example, with the caf_mpi
@@ -12247,6 +12267,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
          && sym->attr.codimension
          && sym->attr.allocatable)
        TREE_STATIC (descriptor) = 1;
+
+      gfc_clear_descriptor (&init, sym, descriptor);
     }
 
   input_location = loc;

Reply via email to