https://gcc.gnu.org/g:3918d574068d630196bc75b1a0641f8d994fb043
commit 3918d574068d630196bc75b1a0641f8d994fb043
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Jan 30 21:07:15 2025 +0100
Déplacement méthode set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-array.cc | 42 ++++++++++++++++++++++++++++++++++
gcc/fortran/trans-array.h | 2 ++
gcc/fortran/trans-expr.cc | 57 ++++++----------------------------------------
3 files changed, 51 insertions(+), 50 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4d08a862c5be..5a610511b8b9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1773,6 +1773,48 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
}
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
+ symbol_attribute scalar_attr, bool is_class,
+ tree cond_optional)
+{
+ tree type = get_scalar_to_descriptor_type (scalar, scalar_attr);
+ if (POINTER_TYPE_P (type))
+ type = TREE_TYPE (type);
+
+ tree etype = gfc_get_element_type (type);
+ tree dtype_val;
+ if (etype == void_type_node)
+ dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
+ else
+ dtype_val = gfc_get_dtype (type);
+
+ tree dtype_ref = gfc_conv_descriptor_dtype (desc);
+ gfc_add_modify (block, dtype_ref, dtype_val);
+
+ gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
+
+ tree tmp;
+ if (is_class)
+ tmp = gfc_class_data_get (scalar);
+ else
+ tmp = scalar;
+
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+ if (cond_optional)
+ {
+ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+ cond_optional, tmp,
+ fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+ }
+
+ gfc_conv_descriptor_data_set (block, desc, tmp);
+}
+
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
void
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 296a8052dd73..9df3a424c72f 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -147,6 +147,8 @@ void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol
*, gfc_expr *, tree);
void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
+ symbol_attribute, bool, tree);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 18d54d2a1f93..8dfb2b152c75 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -172,49 +172,6 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
}
-void
-set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
- symbol_attribute scalar_attr, bool is_class,
- tree cond_optional)
-{
- tree type = get_scalar_to_descriptor_type (scalar, scalar_attr);
- if (POINTER_TYPE_P (type))
- type = TREE_TYPE (type);
-
- tree etype = gfc_get_element_type (type);
- tree dtype_val;
- if (etype == void_type_node)
- dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
- else
- dtype_val = gfc_get_dtype (type);
-
- tree dtype_ref = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (block, dtype_ref, dtype_val);
-
- gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
-
- tree tmp;
- if (is_class)
- tmp = gfc_class_data_get (scalar);
- else
- tmp = scalar;
-
- if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-
- if (cond_optional)
- {
- tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
- cond_optional, tmp,
- fold_convert (TREE_TYPE (scalar),
- null_pointer_node));
- }
-
- gfc_conv_descriptor_data_set (block, desc, tmp);
-}
-
-
-
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
@@ -232,8 +189,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
scalar = tmp;
}
- set_descriptor_from_scalar (&se->pre, desc, scalar, attr,
- false, NULL_TREE);
+ gfc_set_descriptor_from_scalar (&se->pre, desc, scalar, attr,
+ false, NULL_TREE);
/* Copy pointer address back - but only if it could have changed and
if the actual argument is a pointer and not, e.g., NULL(). */
@@ -1082,9 +1039,9 @@ 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)
- set_descriptor_from_scalar (&parmse->pre, ctree,
- parmse->expr, gfc_expr_attr (e),
- false, cond_optional);
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
+ parmse->expr, gfc_expr_attr (e),
+ false, cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
@@ -1459,8 +1416,8 @@ 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)
- set_descriptor_from_scalar (&block, ctree, parmse->expr,
- gfc_expr_attr (e), true, NULL_TREE);
+ gfc_set_descriptor_from_scalar (&block, ctree, parmse->expr,
+ gfc_expr_attr (e), true, NULL_TREE);
else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
}
