From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
The function gfc_conv_derived_to_class contains code initializing an array
descriptor representing 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_derived_to_class): 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 | 29 +++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 17 ++---------------
3 files changed, 33 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4f4335b5332..c6fe64d69d0 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
#include "trans-types.h"
#include "trans-array.h"
+#include "trans-descriptor.h"
/* Array descriptor low level access routines.
@@ -844,6 +845,34 @@ 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 pointer-typed middle-end expression
SCALAR
+ corresponding to the scalar front-end expression SCALAR_EXPR. If
+ COND_PRESENCE is set, make the value assigned to the data field either
SCALAR
+ or nullptr depending on COND_PRESENCE; otherwise SCALAR unconditionally.
+ 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 (stmtblock_t *block, tree descr,
+ tree scalar, gfc_expr *scalar_expr,
+ tree cond_presence)
+{
+ 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));
+ gfc_copy_coarray_desc_part (block, descr, scalar);
+ if (cond_presence)
+ scalar = build3_loc (input_location, COND_EXPR,
+ TREE_TYPE (scalar),
+ cond_presence, scalar,
+ fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+ gfc_conv_descriptor_data_set (block, descr, scalar);
+}
+
+
/* 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 0c13266b771..e4ff7318a97 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -73,6 +73,8 @@ 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 (stmtblock_t *, tree, tree, gfc_expr *,
+ 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 172d5fa5b5f..c24102df120 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -899,21 +899,8 @@ 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)
- {
- tree expr_type = TREE_TYPE (parmse->expr);
- tree type = gfc_get_scalar_to_descriptor_type (expr_type,
- gfc_expr_attr (e));
- gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
- gfc_get_dtype (type));
- gfc_copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
- if (optional)
- parmse->expr = build3_loc (input_location, COND_EXPR,
- TREE_TYPE (parmse->expr),
- cond_optional, parmse->expr,
- fold_convert (TREE_TYPE
(parmse->expr),
- null_pointer_node));
- gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
- }
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
+ parmse->expr, e, cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
--
2.53.0
