https://gcc.gnu.org/g:6cec2604039bbf82409160b78fdbb9c435ba540c

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

    Extraction gfc_clear_descriptor
    
    Correction nom block

Diff:
---
 gcc/fortran/trans-array.cc      | 18 ++----------------
 gcc/fortran/trans-descriptor.cc | 24 ++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  2 ++
 3 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index acf643f6adbd..3d6f7ac786e3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11828,10 +11828,8 @@ 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))))
+      && (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)
        {
          /* Declare the variable static so its array descriptor stays present
@@ -11839,22 +11837,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, 
gfc_wrapped_block * block)
             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_clear_descriptor (&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 e5f0076ab855..3edc7a34809e 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -668,3 +668,27 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
 #undef STRIDE_SUBFIELD
 #undef LBOUND_SUBFIELD
 #undef UBOUND_SUBFIELD
+
+
+void
+gfc_clear_descriptor (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.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);
+    }
+
+  tree etype;
+
+  gcc_assert (sym->as && sym->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));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 3f602219c284..6fcf4937c166 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -94,4 +94,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type, 
tree *data_off,
                                     tree *stride_suboff, tree *lower_suboff,
                                     tree *upper_suboff);
 
+void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, tree descr);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */

Reply via email to