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

https://gcc.gnu.org/g:195c9183c49309032bbfd37b4c8df4ea6902bebe

commit 195c9183c49309032bbfd37b4c8df4ea6902bebe
Author: Mikael Morin <[email protected]>
Date:   Mon Aug 10 21:57:09 2026 +0200

    fortran: array descriptor: Move scalar descriptor init 2/3 [PR122521]
    
    Fortran-tested on aarch64-unknown-linux-gnu.  OK for mainline?
    
    -- >8 --
    
    The function gfc_conv_derived_to_class contains code initializing an array
    descriptor representing a scalar value.  Move that code to its own function
    in trans-descriptor.cc.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_conv_derived_to_class): 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 | 30 ++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  2 ++
 gcc/fortran/trans-expr.cc       | 17 ++---------------
 3 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index bc856bf42654..58d862edbdee 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-const.h"
 #include "trans-types.h"
 #include "trans-array.h"
+#include "trans-descriptor.h"
 
 
 /* Array descriptor low level access routines.
@@ -844,6 +845,35 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts,
 }
 
 
+/* Add code to BLOCK initializing the scalar descriptor DESCR, so that it
+   represents the same data as the middle-end scalar pointer expression SCALAR
+   corresponding to the front-end scalar expression SCALAR_EXPR.  If
+   COND_PRESENCE is set make the value assigned to the data field either SCALAR
+   or nullptr depending on COND_PRESENCE; otherwise SCALAR unconditionally.
+   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, gfc_expr *scalar_expr,
+				tree cond_presence)
+{
+  tree type;
+  type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar),
+					    gfc_expr_attr (scalar_expr));
+  gfc_conv_descriptor_dtype_set (block, descr,
+				 gfc_get_dtype (type));
+  gfc_copy_coarray_desc_part (block, descr, scalar);
+  if (cond_presence)
+    scalar = build3_loc (input_location, COND_EXPR,
+			 TREE_TYPE (scalar),
+			 cond_presence, scalar,
+			 fold_convert (TREE_TYPE (scalar),
+				       null_pointer_node));
+  gfc_conv_descriptor_data_set (block, descr, scalar);
+}
+
+
 /* 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 694f6e2897f3..bd93e462963e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -73,6 +73,8 @@ tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree,
 tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *,
 					symbol_attribute, int);
 
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
+				     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 a73e15a9167e..3dbf7f76da13 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -897,21 +897,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
 
 	  /* Scalar to an assumed-rank array.  */
 	  if (fsym->ts.u.derived->components->as)
-	    {
-	      tree type;
-	      type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (parmse->expr),
-							gfc_expr_attr (e));
-	      gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
-					     gfc_get_dtype (type));
-	      gfc_copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
-	      if (optional)
-		parmse->expr = build3_loc (input_location, COND_EXPR,
-					   TREE_TYPE (parmse->expr),
-					   cond_optional, parmse->expr,
-					   fold_convert (TREE_TYPE (parmse->expr),
-							 null_pointer_node));
-	      gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
-	    }
+	    gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
+					    parmse->expr, e, cond_optional);
           else
 	    {
 	      tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);