From: Mikael Morin <[email protected]>
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.
---
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 c6fe64d69d0..2139cd9fc31 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -873,6 +873,28 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
}
+/* Add code to BLOCK initializing the zero-rank array descriptor DESCR, so that
+ it represents the same data as the scalar reference SCALAR. This is used to
+ implement the argument association between the actual argument SCALAR 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 zero-rank array descriptor DESCR, so that
it represents the same data as the class descriptor reference SCALAR
corresponding to the scalar polymorphic expression SCALAR_EXPR. This is
used
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index e4ff7318a97..3f611b1d76a 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 *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c24102df120..a1b739da634 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(). */
--
2.53.0
