https://gcc.gnu.org/g:4ea50d08e12182ad5f281dc163ed54c40c7505c6

commit 4ea50d08e12182ad5f281dc163ed54c40c7505c6
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Aug 7 14:11:43 2025 +0200

    Extraction gfc_set_descriptor_from_scalar
    
    Correction gfc_get_scalar_to_descriptor_type

Diff:
---
 gcc/fortran/trans-descriptor.cc | 18 ++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 13 +------------
 3 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a8e7b0d9d19e..fd31cbe62a2d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1802,3 +1802,21 @@ gfc_set_gfc_from_cfi (stmtblock_t *block, stmtblock_t 
*block2, tree gfc_desc,
                       rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
                       gfc_finish_block (&loop_body));
 }
+
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
+                               tree scalar, gfc_expr *scalar_expr)
+{
+  tree 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));
+
+  tree tmp = gfc_class_data_get (scalar);
+  if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+    tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+  gfc_conv_descriptor_data_set (block, descr, tmp);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index eac7f92dc79c..b8c771c7bd66 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -120,6 +120,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *, 
tree, tree,
                           tree, gfc_symbol *);
 void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
                           gfc_symbol *, bool);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
 
 void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree 
descr);
 void gfc_init_static_descriptor (tree descr);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1b148e637884..9e09e81ad43a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1288,18 +1288,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, 
gfc_typespec class_ts,
       && e->rank != class_ts.u.derived->components->as->rank)
     {
       if (e->rank == 0)
-       {
-         tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE 
(parmse->expr),
-                                                        gfc_expr_attr (e));
-         gfc_conv_descriptor_dtype_set (&block, ctree,
-                                        gfc_get_dtype (type));
-
-         tmp = gfc_class_data_get (parmse->expr);
-         if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
-           tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-
-         gfc_conv_descriptor_data_set (&block, ctree, tmp);
-       }
+       gfc_set_descriptor_from_scalar (&block, ctree, parmse->expr, e);
       else
        gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
     }

Reply via email to