https://gcc.gnu.org/g:cbaf18c25835750f441ece64f011f36aff55f246
commit cbaf18c25835750f441ece64f011f36aff55f246
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Jan 21 20:05:36 2025 +0100
Revert "Suppression set_subarray_descriptor"
This reverts commit 02608142b0ba9f84cafdfefc2e944250db84780d.
Diff:
---
gcc/fortran/trans-expr.cc | 79 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 79 insertions(+)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7a384261dc06..65b6cd8a4642 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9418,6 +9418,83 @@ gfc_trans_subarray_assign (tree dest, gfc_component *
cm, gfc_expr * expr)
}
+static void
+set_subarray_descriptor (stmtblock_t *block, tree desc, tree value,
+ gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+ if (value_expr->expr_type != EXPR_VARIABLE)
+ gfc_conv_descriptor_data_set (block, value,
+ null_pointer_node);
+
+ /* Obtain the array spec of full array references. */
+ gfc_array_spec *as;
+ if (conv_arg)
+ as = gfc_get_full_arrayspec_from_expr (conv_arg);
+ else
+ as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+ /* Shift the lbound and ubound of temporaries to being unity,
+ rather than zero, based. Always calculate the offset. */
+ tree offset = gfc_conv_descriptor_offset_get (desc);
+ gfc_add_modify (block, offset, gfc_index_zero_node);
+ tree tmp2 = gfc_create_var (gfc_array_index_type, NULL);
+
+ for (int n = 0; n < value_expr->rank; n++)
+ {
+ tree span;
+ tree lbound;
+
+ /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+ TODO It looks as if gfc_conv_expr_descriptor should return
+ the correct bounds and that the following should not be
+ necessary. This would simplify gfc_conv_intrinsic_bound
+ as well. */
+ if (as && as->lower[n])
+ {
+ gfc_se lbse;
+ gfc_init_se (&lbse, NULL);
+ gfc_conv_expr (&lbse, as->lower[n]);
+ gfc_add_block_to_block (block, &lbse.pre);
+ lbound = gfc_evaluate_now (lbse.expr, block);
+ }
+ else if (as && conv_arg)
+ {
+ tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+ lbound = gfc_conv_descriptor_lbound_get (tmp,
+ gfc_rank_cst[n]);
+ }
+ else if (as)
+ lbound = gfc_conv_descriptor_lbound_get (desc,
+ gfc_rank_cst[n]);
+ else
+ lbound = gfc_index_one_node;
+
+ lbound = fold_convert (gfc_array_index_type, lbound);
+
+ /* Shift the bounds and set the offset accordingly. */
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ span, lbound);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[n], lbound);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_lbound_get (desc,
+ gfc_rank_cst[n]),
+ gfc_conv_descriptor_stride_get (desc,
+ gfc_rank_cst[n]));
+ gfc_add_modify (block, tmp2, tmp);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ offset, tmp2);
+ gfc_conv_descriptor_offset_set (block, desc, tmp);
+ }
+}
+
+
static tree
gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_expr * expr)
@@ -9494,6 +9571,8 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component
* cm,
&& expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
arg = expr->value.function.actual->expr;
+ set_subarray_descriptor (&block, dest, se.expr, expr, arg);
+
if (arg)
{
/* If a conversion expression has a null data pointer
