[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_descriptor_variable

[Mikael Morin]

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

commit f26696adf4b66fdf0595dae7988273fae6e1eba4
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Tue Jul 15 18:28:30 2025 +0200

    Extraction gfc_init_descriptor_variable
    
    Correction nom block
    
    Correction libgomp.fortran/allocators-1.f90
    
    Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable
    
    Non renseignement dtype par défaut
    
    Correction initialisation write_destination
    
    Correction PR100094

Diff:
---
 gcc/fortran/trans-array.cc      | 24 ++++++------------------
 gcc/fortran/trans-descriptor.cc | 22 ++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  3 ++-
 3 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bd4ed33d0642..13df424eee09 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11875,34 +11875,22 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 
   /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
      pointers when -fcheck=pointer is specified.  */
-  if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save
-      && (sym->attr.allocatable
-	  || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER))))
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && (sym->attr.allocatable || sym->attr.pointer))
     {
-      gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
-      if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+      if (flag_coarray == GFC_FCOARRAY_LIB
+	  && sym->attr.codimension
+	  && !sym->attr.save)
 	{
 	  /* 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
 	     implementation.  */
 	  TREE_STATIC (descriptor) = 1;
-	  gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
 	}
+      gfc_init_descriptor_variable (&init, sym, descriptor);
     }
 
-  /* Set initial TKR for pointers and allocatables */
-  if (GFC_DESCRIPTOR_TYPE_P (type)
-      && (sym->attr.pointer || sym->attr.allocatable))
-    {
-      tree etype;
-
-      gcc_assert (sym->as && sym->as->rank>=0);
-      etype = gfc_get_element_type (type);
-      gfc_conv_descriptor_dtype_set (&init, descriptor,
-				     gfc_get_dtype_rank_type (sym->as->rank,
-							      etype));
-    }
   input_location = loc;
   gfc_init_block (&cleanup);
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 7030f0a8d6e9..6dfff1a3b5fe 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -840,3 +840,25 @@ gfc_init_static_descriptor (tree descr)
   tree type = TREE_TYPE (descr);
   DECL_INITIAL (descr) = gfc_build_null_descriptor (type);
 }
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+  /* NULLIFY the data pointer for non-saved allocatables, or for non-saved
+     pointers when -fcheck=pointer is specified.  */
+  if (!sym->attr.save
+      && (sym->attr.allocatable
+	  || (sym->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)
+	gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
+    }
+
+  gcc_assert (sym->as && sym->as->rank>=0);
+  tree etype = gfc_get_element_type (TREE_TYPE (descr));
+  gfc_conv_descriptor_dtype_set (block, descr,
+				 gfc_get_dtype_rank_type (sym->as->rank,
+							  etype));
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index eb48ae2a8935..36880bf3d88b 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -21,7 +21,6 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Build a null array descriptor constructor.  */
 void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
-void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
 void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *, gfc_expr *, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
 				    gfc_expr *, locus *);
@@ -99,4 +98,6 @@ void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
 void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
 void gfc_init_static_descriptor (tree descr);
 
+void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */