[gcc(refs/users/mikael/heads/refactor_descriptor_v205.01)] fortran: array descriptor: Move null actual creation [PR122521]

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

commit a7169d1ed51d58fd04360cddcb7376931638b3a2
Author: Mikael Morin <[email protected]>
Date:   Sun Aug 2 11:05:05 2026 +0200

    fortran: array descriptor: Move null actual creation [PR122521]
    
    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
    expect from within the procedure.
    
    Finally, the scalar descriptor generation, as an argument passing
    implementation detail, was generating code restoring the scalar value 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 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.
            * trans-descriptor.h (gfc_create_null_actual_descriptor): New
            declaration.

Diff:
---
 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 85a9471bcf1d..9c273bf10ea9 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 80f5db72d842..c7f3df02def6 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 59ce9c64ad89..5e13d5950959 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);
 	}
     }