From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline?
-- >8 --
In the next patch, a chunk of code using the function copy_coarray_desc_part
will be moved to trans-descriptor.cc, requiring the function to be visible
outside of trans-expr.cc. Make it public now and move it to
trans-descriptor.cc.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-descriptor.h (gfc_copy_coarray_desc_part): New declaration.
* trans-descriptor.cc (gfc_copy_coarray_desc_part): New function,
moved from...
* trans-expr.cc (copy_coarray_desc_part): ... here.
(gfc_class_array_data_assign, gfc_conv_derived_to_class): Update
function name in callers.
---
gcc/fortran/trans-descriptor.cc | 40 +++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 36 ++---------------------------
3 files changed, 44 insertions(+), 34 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 177469593b9..4f4335b5332 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -951,6 +951,46 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc,
}
+/* Add code to BLOCK copying the cobounds from array descriptor SRC to array
+ descriptor DEST. The values are picked from SRC's type if they are
+ set there. Otherwise the runtime values are used with references to SRC's
+ fields. The type of DEST is not enriched with the cobounds; only
+ assignments setting DEST's fields at runtime are generated. If SRC is not a
+ coarray, no code is generated. */
+
+void
+gfc_copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src)
+{
+ tree src_type = TREE_TYPE (src);
+ if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank)
+ {
+ struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type);
+ for (int c = 0; c < lang_specific->corank; ++c)
+ {
+ int dim = lang_specific->rank + c;
+ tree codim = gfc_rank_cst[dim];
+
+ if (lang_specific->lbound[dim])
+ gfc_conv_descriptor_lbound_set (block, dest, codim,
+ lang_specific->lbound[dim]);
+ else
+ gfc_conv_descriptor_lbound_set (
+ block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim));
+ if (dim + 1 < lang_specific->corank)
+ {
+ if (lang_specific->ubound[dim])
+ gfc_conv_descriptor_ubound_set (block, dest, codim,
+ lang_specific->ubound[dim]);
+ else
+ gfc_conv_descriptor_ubound_set (
+ block, dest, codim,
+ gfc_conv_descriptor_ubound_get (src, codim));
+ }
+ }
+ }
+}
+
+
void
gfc_copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank)
{
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 314e99819b4..0c13266b771 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -82,6 +82,8 @@ tree gfc_conv_descriptor_cosize (tree, int, int);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+void gfc_copy_coarray_desc_part (stmtblock_t *, tree, tree);
+
void gfc_copy_descriptor (stmtblock_t *, tree, tree, int);
void gfc_grow_array (stmtblock_t *, tree, tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 25036e6ca7d..172d5fa5b5f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -761,38 +761,6 @@ gfc_get_vptr_from_expr (tree expr)
return NULL_TREE;
}
-static void
-copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src)
-{
- tree src_type = TREE_TYPE (src);
- if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank)
- {
- struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type);
- for (int c = 0; c < lang_specific->corank; ++c)
- {
- int dim = lang_specific->rank + c;
- tree codim = gfc_rank_cst[dim];
-
- if (lang_specific->lbound[dim])
- gfc_conv_descriptor_lbound_set (block, dest, codim,
- lang_specific->lbound[dim]);
- else
- gfc_conv_descriptor_lbound_set (
- block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim));
- if (dim + 1 < lang_specific->corank)
- {
- if (lang_specific->ubound[dim])
- gfc_conv_descriptor_ubound_set (block, dest, codim,
- lang_specific->ubound[dim]);
- else
- gfc_conv_descriptor_ubound_set (
- block, dest, codim,
- gfc_conv_descriptor_ubound_get (src, codim));
- }
- }
- }
-}
-
void
gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
bool lhs_type)
@@ -821,7 +789,7 @@ gfc_class_array_data_assign (stmtblock_t *block, tree
lhs_desc, tree rhs_desc,
gfc_add_modify (block, lhs_dim, rhs_dim);
/* The corank dimensions are not copied by the ARRAY_RANGE_REF. */
- copy_coarray_desc_part (block, lhs_desc, rhs_desc);
+ gfc_copy_coarray_desc_part (block, lhs_desc, rhs_desc);
}
/* Takes a derived type expression and returns the address of a temporary
@@ -937,7 +905,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
gfc_get_dtype (type));
- copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
+ gfc_copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
if (optional)
parmse->expr = build3_loc (input_location, COND_EXPR,
TREE_TYPE (parmse->expr),
--
2.53.0
