From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
The function gfc_conv_class_to_class has some specific code to initialize an
array descriptor when it represents 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_class_to_class): Move descriptor
initialization...
* trans-descriptor.cc (gfc_set_descriptor_from_scalar_class):
... here as a new function.
* trans-descriptor.h (gfc_set_descriptor_from_scalar_class): New
declaration.
---
gcc/fortran/trans-descriptor.cc | 23 +++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 3 +++
gcc/fortran/trans-expr.cc | 14 +-------------
3 files changed, 27 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 9c273bf10ea..177469593b9 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -844,6 +844,29 @@ gfc_create_null_actual_descriptor (stmtblock_t *block,
gfc_typespec *ts,
}
+/* 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
+ to implement the argument association between the actual argument
SCALAR_EXPR
+ and an assumed-rank dummy argument. */
+
+void
+gfc_set_descriptor_from_scalar_class (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);
+}
+
+
/* For an array descriptor, get the total number of elements. This is just
the product of the extents along from_dim to to_dim. */
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index c7f3df02def..314e99819b4 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -73,6 +73,9 @@ 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_class (stmtblock_t *, tree, tree,
+ gfc_expr *);
+
tree gfc_conv_descriptor_size (tree, int);
tree gfc_conv_descriptor_cosize (tree, int, int);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b12500e48f4..25036e6ca7d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1373,19 +1373,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;
- 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_class (&block, ctree, parmse->expr, e);
else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
}
--
2.53.0
