[PATCH 4/6] fortran: array descriptor: Move default descriptor initialization [PR122521]

From: Mikael Morin <[email protected]>

Fortran-tested on aarch64-unknown-linux-gnu.  OK for mainline?

-- >8 --

Array allocatable local variables have their descriptor data pointer set to
null on function entry to represent their unallocated initial status.  The
dtype of allocatable and pointer arrays is also set on entry.  Move the code
generating those default initializations of array descriptors to its own
function in trans-descriptor.cc.

	PR fortran/122521

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_trans_deferred_array): Move default descriptor
	initialization...
	* trans-descriptor.cc (gfc_init_descriptor_variable): ... here
	as a new function.
	* trans-descriptor.h (gfc_init_descriptor_variable): New
	declaration.
---
 gcc/fortran/trans-array.cc      | 24 ++++++------------------
 gcc/fortran/trans-descriptor.cc | 28 ++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  2 ++
 3 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 91fa43b2683..1b77e1ee66f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -12448,34 +12448,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 8cee990206e..aab7310265a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -746,6 +746,34 @@ gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
 }
 
 
+/* Add code to BLOCK initializing the array descriptor DESCR corresponding to
+   the array variable SYM.  This is only used for variables needing a default
+   initialization of their descriptor.  Typically allocatable (array) variables,
+   that have an initial status of unallocated, are among them; they need their
+   data pointer set to nullptr.  */
+
+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));
+}
+
+
 /* For an array descriptor, get the total number of elements.  This is just
    the product of the extents along from_dim to to_dim.  */
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 79786c32ecd..e9006a22971 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -66,6 +66,8 @@ tree gfc_build_null_descriptor (tree type);
 void gfc_nullify_descriptor (stmtblock_t *block, tree);
 void gfc_init_result_descriptor (stmtblock_t *block, tree descr);
 void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
+void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
+				   tree descr);
 
 tree gfc_conv_descriptor_size (tree, int);
 tree gfc_conv_descriptor_cosize (tree, int, int);
-- 
2.53.0