https://gcc.gnu.org/g:6d1a550acfb35381deea5afbd424a7e79852f5b1
commit 6d1a550acfb35381deea5afbd424a7e79852f5b1
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Dec 31 15:27:35 2024 +0100
Introduction gfc_copy_sequence_descriptor
Correction régression sizeof_6
Diff:
---
gcc/fortran/trans-array.cc | 39 ++++++++++++++-------------------------
gcc/fortran/trans-expr.cc | 44 ++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans.h | 1 +
3 files changed, 59 insertions(+), 25 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4c237b561aa6..5d56a12ebf71 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9901,32 +9901,21 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
if (maybe_shift && !keep_descriptor_lower_bound (expr))
conv_shift_descriptor (&block, se->expr, expr->rank);
+ bool assumed_rank_fsym;
+ if (fsym
+ && ((fsym->ts.type == BT_CLASS
+ && CLASS_DATA (fsym)->as
+ && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+ || (fsym->ts.type != BT_CLASS
+ && fsym->as
+ && fsym->as->type == AS_ASSUMED_RANK)))
+ assumed_rank_fsym = true;
+ else
+ assumed_rank_fsym = false;
+
tmp = gfc_class_data_get (ctree);
- if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
- && CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
- {
- tree arr = gfc_create_var (TREE_TYPE (tmp), "parm");
- gfc_conv_descriptor_data_set (&block, arr,
- gfc_conv_descriptor_data_get (
- se->expr));
- gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
- gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_size (se->expr, expr->rank));
- gfc_conv_descriptor_stride_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
- gfc_conv_descriptor_dtype (se->expr));
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
- gfc_conv_descriptor_span_set (&block, arr,
- gfc_conv_descriptor_span_get (arr));
- gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
- se->expr = arr;
- }
- gfc_class_array_data_assign (&block, tmp, se->expr, true);
+ gfc_copy_sequence_descriptor (block, tmp, se->expr,
+ assumed_rank_fsym);
/* Handle optional. */
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 003754cdad6f..5dff9692f0ba 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -846,6 +846,50 @@ descriptor_rank (tree descriptor)
}
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+ int lhs_rank = descriptor_rank (lhs_desc);
+ int rhs_rank = descriptor_rank (rhs_desc);
+ tree desc;
+
+ if (assumed_rank_lhs || lhs_rank == rhs_rank)
+ desc = rhs_desc;
+ else
+ {
+ tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+ gfc_conv_descriptor_data_set (&block, arr,
+ gfc_conv_descriptor_data_get (rhs_desc));
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+ tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+ gfc_conv_descriptor_stride_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ for (int i = 1; i < lhs_rank; i++)
+ {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+ }
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_char_type_node, lhs_rank));
+ gfc_conv_descriptor_span_set (&block, arr,
+ gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+ desc = arr;
+ }
+
+ gfc_class_array_data_assign (&block, lhs_desc, desc, true);
+}
+
+
void
gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
bool)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 449d2b3026c0..2ad3a98cf4f6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -465,6 +465,7 @@ void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *,
symbol_attribute, int);
bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
+void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree,
bool, bool, const char *, tree * = nullptr);
void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
