[gcc(refs/users/mikael/heads/refactor_descriptor_v206.01)] fortran: array descriptor: Move scalar descriptor init 3/3 [PR122521]

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

commit d4cacbd515f5166734c6feadc4b51fd96a2b9f99
Author: Mikael Morin <[email protected]>
Date:   Mon Aug 10 22:14:37 2026 +0200

    fortran: array descriptor: Move scalar descriptor init 3/3 [PR122521]
    
    Fortran-tested on aarch64-unknown-linux-gnu.  OK for mainline?
    
    -- >8 --
    
    Move the array descriptor initialization part of
    gfc_conv_scalar_to_descriptor to its own function in trans-descriptor.cc.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_conv_scalar_to_descriptor): Move scalar
            descriptor initialization code ...
            * trans-descriptor.cc (gfc_set_descriptor_from_scalar): ... here as
            a new function.
            * trans-descriptor.h (gfc_set_descriptor_from_scalar): New
            declaration.

Diff:
---
 gcc/fortran/trans-descriptor.cc | 22 ++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 14 +++-----------
 3 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 58d862edbdee..340da26d29a2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -874,6 +874,28 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
 }
 
 
+/* Add code to BLOCK initializing the scalar descriptor DESCR, so that it
+   represents the same data as the scalar expression SCALAR.  This is used to
+   implement the argument association between the actual argument SCALAR_EXPR
+   and an assumed-rank dummy argument.  */
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar)
+{
+  tree etype = TREE_TYPE (scalar);
+  if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
+    scalar = gfc_build_addr_expr (NULL_TREE, scalar);
+  else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+    etype = TREE_TYPE (etype);
+
+  gfc_conv_descriptor_dtype_set (block, descr,
+				 gfc_get_dtype_rank_type (0, etype));
+  gfc_conv_descriptor_data_set (block, descr, scalar);
+  gfc_conv_descriptor_span_set (block, descr,
+				gfc_conv_descriptor_elem_len_get (descr));
+}
+
+
 /* Add code to BLOCK initializing the scalar descriptor DESCR, so that it
    represents the same data as the middle-end scalar class descriptor SCALAR
    corresponding to the front-end scalar polymorphic expression SCALAR_EXPR.
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index bd93e462963e..2ca4e40b4c52 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -75,6 +75,7 @@ tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *,
 
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
 				     tree);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
 void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *);
 
 tree gfc_conv_descriptor_size (tree, int);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3dbf7f76da13..3d12e119dd09 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -87,10 +87,9 @@ gfc_get_character_len_in_bytes (tree type)
 tree
 gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 {
-  tree desc, type, etype;
+  tree desc, type;
 
   type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr);
-  etype = TREE_TYPE (scalar);
   desc = gfc_create_var (type, "desc");
   DECL_ARTIFICIAL (desc) = 1;
 
@@ -101,15 +100,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
       gfc_add_modify (&se->pre, tmp, scalar);
       scalar = tmp;
     }
-  if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
-    scalar = gfc_build_addr_expr (NULL_TREE, scalar);
-  else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
-    etype = TREE_TYPE (etype);
-  gfc_conv_descriptor_dtype_set (&se->pre, desc,
-				 gfc_get_dtype_rank_type (0, etype));
-  gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
-  gfc_conv_descriptor_span_set (&se->pre, desc,
-				gfc_conv_descriptor_elem_len_get (desc));
+
+  gfc_set_descriptor_from_scalar (&se->pre, desc, scalar);
 
   /* Copy pointer address back - but only if it could have changed and
      if the actual argument is a pointer and not, e.g., NULL().  */