https://gcc.gnu.org/g:5772b2ab02ff539ddfa8c3ec02cd1184befed05c
commit 5772b2ab02ff539ddfa8c3ec02cd1184befed05c
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Jul 22 20:50:41 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 18 ++++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 42 +++++------------------------------------
gcc/fortran/trans-types.cc | 22 +++++++++++++++++++++
gcc/fortran/trans-types.h | 1 +
5 files changed, 47 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5fe8973b7b3..6995eb1da052 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1864,3 +1864,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 (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 b4fa7eed6a36..0e87eee39b38 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -127,5 +127,6 @@ 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 *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6f91013b8a7b..5c906403e524 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -91,33 +91,12 @@ gfc_get_character_len_in_bytes (tree type)
}
-/* Convert a scalar to an array descriptor. To be used for assumed-rank
- arrays. */
-
-static tree
-get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
-{
- 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;
-
- if (POINTER_TYPE_P (TREE_TYPE (scalar)))
- scalar = TREE_TYPE (scalar);
- return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
- akind, !(attr.pointer || attr.target));
-}
-
tree
gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol *sym, tree scalar)
{
symbol_attribute attr = sym->attr;
- tree type = get_scalar_to_descriptor_type (scalar, attr);
+ tree type = gfc_get_scalar_to_descriptor_type (scalar, attr);
tree desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -167,7 +146,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
{
tree desc, type, etype;
- type = get_scalar_to_descriptor_type (scalar, attr);
+ type = gfc_get_scalar_to_descriptor_type (scalar, attr);
etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -961,8 +940,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (fsym->ts.u.derived->components->as)
{
tree type;
- type = get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
+ type = gfc_get_scalar_to_descriptor_type (parmse->expr,
+ gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
gfc_get_dtype (type));
if (optional)
@@ -1347,18 +1326,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 = get_scalar_to_descriptor_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);
}
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index e324fb9c41ea..0c73e276482e 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2285,6 +2285,28 @@ gfc_get_array_type_bounds (tree etype, int dimen, int
codimen, tree * lbound,
return fat_type;
}
+/* Convert a scalar to an array descriptor. To be used for assumed-rank
+ arrays. */
+
+tree
+gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+{
+ 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;
+
+ if (POINTER_TYPE_P (TREE_TYPE (scalar)))
+ scalar = TREE_TYPE (scalar);
+ return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
+ akind, !(attr.pointer || attr.target));
+}
+
+
/* Build a pointer type. This function is called from gfc_sym_type(). */
static tree
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index dc75cd82a841..c9090e5a625c 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -102,6 +102,7 @@ tree gfc_get_element_type (tree);
tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
enum gfc_array_kind, bool);
tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
+tree gfc_get_scalar_to_descriptor_type (tree, symbol_attribute);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */
tree gfc_add_field_to_struct (tree, tree, tree, tree **);
