[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Extraction gfc_init_descriptor_variable

https://gcc.gnu.org/g:35c2309864309dc40be186bb9e2aacf1b6576d3c

commit 35c2309864309dc40be186bb9e2aacf1b6576d3c
Author: Mikael Morin <[email protected]>
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  |  2 ++
 3 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8a9358cf5787..07a213022ae2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -12431,34 +12431,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 088ea82ff0b2..2fefc3207fef 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -905,3 +905,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 cd4820e9146c..81869093b076 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -79,4 +79,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 */