[PATCH 6/6] fortran: array descriptor: Move null actual creation [PR122521]

From: Mikael Morin <[email protected]>

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

-- >8 --

The creation of a descriptor corresponding to a null() actual argument is
repeated three times in conv_null_actual to handle three different cases.
Factor that code to a common function in to trans-descriptor.cc.

The factored code consisted of calling the scalar descriptor generator,
and then generating a modification of the descriptor rank.  This was
producing correct initialization code for the descriptor, but with a
wrong type and an incorrect zero GFC_TYPE_ARRAY_RANK attached to it.  So
this change additionnally inlines the scalar descriptor generation,
replacing the hardcoded zero rank with the true rank passed as argument, so
that the variable has the right type and is directly generated with the
correct rank.  With this, the descriptor is bigger because of a non-empty
array of useless (and uninitialized) dimensions, but it's the type that is
expected from within the procedure.

More, the scalar descriptor generation, as an argument passing
implementation detail, was generating code copying back to the original
variable on return.  This is not applicable to null() actual arguments and
this change removes it from the inlined code.  That part actually used to
cause a gimplification failure for copy back code that looked like this:
    &C.5048 = (void * *) desc.14.data;
Harald provided a workaround for this with his r15-6408-gd637e6d069ade7 [1]
null() work, that changed the intent attribute of an argument in one of the
three places modified here.  This change, having removed the offending code,
removes the workaround as well.

[1]: https://gcc.gnu.org/pipermail/gcc-patches/2024-December/671673.html

	PR fortran/122521

gcc/fortran/ChangeLog:

	* trans-expr.cc (conv_null_actual): Remove dummy symbol intent
	attribute modification.  Move the three times repeated descriptor
	initialization...
	* trans-descriptor.cc (gfc_create_null_actual_descriptor): ...
	here as a new function and inline the call to
	gfc_conv_scalar_to_descriptor.  Remove the inapplicable or
	redundant parts from the inlined code.  Create lower and upper
	bounds arrays and clear them before passing to the type creation
	function.
	* trans-descriptor.h (gfc_create_null_actual_descriptor): New
	declaration.
---
 gcc/fortran/trans-descriptor.cc | 39 +++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  2 ++
 gcc/fortran/trans-expr.cc       | 21 ++++++------------
 3 files changed, 48 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 85a9471bcf1..9c273bf10ea 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -805,6 +805,45 @@ gfc_create_unallocated_library_result_descriptor (stmtblock_t *block,
 }
 
 
+/* Create a new descriptor to represent a null actual argument of type TS and
+   rank RANK passed to a dummy argument having attributes ATTR.  Add
+   initialization code to BLOCK and return the descriptor declaration.  */
+
+tree
+gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts,
+				   symbol_attribute attr, int rank)
+{
+  tree etype = gfc_typenode_for_spec (ts);
+
+  enum gfc_array_kind akind;
+
+  if (attr.pointer)
+    akind = GFC_ARRAY_POINTER_CONT;
+  else if (attr.allocatable)
+    akind = GFC_ARRAY_ALLOCATABLE;
+  else
+    akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+  tree lower[GFC_MAX_DIMENSIONS];
+  tree upper[GFC_MAX_DIMENSIONS];
+  memset (&lower, 0, rank * sizeof (lower[0]));
+  memset (&upper, 0, rank * sizeof (upper[0]));
+
+  tree type = gfc_get_array_type_bounds (etype, rank, 0, lower, upper, 1,
+					 akind, !(attr.pointer || attr.target));
+  tree desc = gfc_create_var (type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+
+  gfc_conv_descriptor_dtype_set (block, desc,
+				 gfc_get_dtype_rank_type (rank, etype));
+  gfc_conv_descriptor_data_set (block, desc, null_pointer_node);
+  gfc_conv_descriptor_span_set (block, desc,
+				gfc_conv_descriptor_elem_len_get (desc));
+
+  return desc;
+}
+
+
 /* 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 80f5db72d84..c7f3df02def 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -70,6 +70,8 @@ void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
 				   tree descr);
 tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree,
 						       tree);
+tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *,
+					symbol_attribute, int);
 
 tree gfc_conv_descriptor_size (tree, int);
 tree gfc_conv_descriptor_cosize (tree, int, int);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 59ce9c64ad8..5e13d595095 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6874,8 +6874,8 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
 	  if (fsym->as && fsym->as->type == AS_ASSUMED_RANK)
 	    {
 	      tree tmp = parmse->expr;
-	      tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
-	      gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
+	      tmp = gfc_create_null_actual_descriptor (&parmse->pre, &e->ts,
+						       fsym->attr, e->rank);
 	      parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
 	    }
 	  else
@@ -6927,26 +6927,19 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym)
 	{
 	  tree tmp = parmse->expr;
 
-	  tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e));
-	  gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
-	  gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+	  tmp = gfc_create_null_actual_descriptor (&parmse->pre, &e->ts,
+						   fsym->attr, e->rank);
 	  parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
 	}
       else
 	/* MOLD is not present.  Use attributes from dummy argument, which is
 	   not allowed to be assumed-rank.  */
 	{
-	  int dummy_rank;
 	  tree tmp = parmse->expr;
 
-	  if ((fsym->attr.allocatable || fsym->attr.pointer)
-	      && fsym->attr.intent == INTENT_UNKNOWN)
-	    fsym->attr.intent = INTENT_IN;
-	  tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
-	  dummy_rank = fsym->as ? fsym->as->rank : 0;
-	  if (dummy_rank > 0)
-	    gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank);
-	  gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
+	  int dummy_rank = fsym->as ? fsym->as->rank : 0;
+	  tmp = gfc_create_null_actual_descriptor (&parmse->pre, &fsym->ts,
+						   fsym->attr, dummy_rank);
 	  parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
 	}
     }
-- 
2.53.0